Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Перемещение формы с определенным шагом

Автор: Elfebet 19.12.2006, 17:44

вот как я делаю

Код


const Step:Integer=30;
var
  Form1: TForm1;
  sMove:Boolean;
  OldX, OldY, OldTop, OldLeft : Integer;

implementation
{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  OldX := X;
  OldY := Y;
  OldTop:=Top;
  OldLeft:=Left;
  sMove := True;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  sMove:=False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 sMove:=False;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 if sMove then begin
   OldTop:=OldTop + Y - OldY;
   OldLeft:=OldLeft + X - OldX;
   if (Abs(OldLeft - Left)>Step) or (Abs(OldTop - Top)>Step) then begin
     Top:=OldTop;
     Left:=OldLeft;
   end;
 end;
end;

но при перемещении формы он начинает сильно блымать (типа сразу перемещается туда и сюда), как мне сделать чтоб оно перемещалось нормально с определенным шагом?

Автор: dimazu 19.12.2006, 18:25

"Блымает"

, по-моему, из-за вот этого:

Код


 if (Abs(OldLeft - Left)>Step) or (Abs(OldTop - Top)>Step) then begin

Закомменть эту строку и проверь.

Автор: Elfebet 19.12.2006, 18:35

Цитата

"Блымает" , по-моему, из-за вот этого:
if (Abs(OldLeft - Left)>Step) or (Abs(OldTop - Top)>Step) then begin
Закомменть эту строку и проверь.

так это строка специально сдесь стоит, суть в том чтобы форму перемещать с определенным шагом.

Автор: Sunvas 19.12.2006, 19:13

Все исправил. Все работает:

Код


const Step:Integer=30;
var    
  Form1: TForm1;
  sMove:Boolean=false;
  OldX, OldY, OldTop, OldLeft : integer;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var p:tpoint;
begin
getcursorpos(p);
  OldX := p.X;
  OldY := p.Y;
  OldTop:=Top;
  OldLeft:=Left;
  sMove := True;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var p:tpoint;
begin
 if sMove then
 begin
  getcursorpos(p);
  if abs(p.x-oldx)>step then begin left:=oldleft+(p.x-oldx); oldleft:=left; oldx:=p.X end;
  if abs(p.Y-oldy)>step then begin top:=oldtop+(p.Y-oldy); oldtop:=top; oldy:=p.Y;  end;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
sMove:=False;
end;

Если хочешь знать в чем была твоя ошибка - стучи в асю.

Автор: dimazu 19.12.2006, 19:29

Я не проверял, но по логике тебе надо сравнивать
х и у, а не топ/боттом, типа вот так:

Код


 if sMove then
  begin
   OldTop:=OldTop + Y - OldY;
   OldLeft:=OldLeft + X - OldX;
   if (Abs(OldX - X)>Step) or (Abs(OldY - Y)>Step) then
   begin
     Top:=OldTop;
     Left:=OldLeft;
     Self.SetBounds (Self.Left, Self.Top , Self.Width,  Self.Height);
   end;
  end;

Но дрыгаться все равно будет, правда "блымать" перестанет. smile

ЗЫ.Пока писал, уже ответили smile

Автор: Sunvas 19.12.2006, 19:36

Цитата(dimazu @ 19.12.2006, 19:29

)

Self.SetBounds (Self.Left, Self.Top , Self.Width, Self.Height);

Смысл ставить эту функцию, после того, как мы присвоили left и top?
Из Делфи:

Код


procedure TControl.SetLeft(Value: Integer);
begin
  SetBounds(Value, FTop, FWidth, FHeight);
  Include(FScalingFlags, sfLeft);
end;

Автор: dimazu 19.12.2006, 19:49

Да, автоматом всегда ее пишу, я только на строку с ифом смотрел...
Надо бы вот так, но описка вышла smile

Код


if (Abs(OldX - X)>Step) or (Abs(OldY - Y)>Step) then
//   begin
//     Top:=OldTop;
 //    Left:=OldLeft;
     Self.SetBounds (OldLeft, OldTop , Self.Width,  Self.Height);
 //  end;