Мерцание при перемещении

← →
Radgar (2008-05-27 10:45) [0]

Здравствуйте, у меня на форме есть несколько компонент, мне нужно их перемещать во время рвботы одной процедуры (т.е. без таймера). Пробовал использовать Form.Refresh, но тогда все компоненты на форме начинают ужасно мерцать. Посоветуйте, пожалуйста, что делать. Заранее благодарю.

← →
Ega23 © (2008-05-27 10:57) [1]

DoubleBuffered := True пробовал?

← →
Юрий Зотов © (2008-05-27 11:50) [2]

А зачем Refresh? Разве недостаточно просто менять Top и Left (а еще лучше - вызывать SetBounds)?

← →
Radgar (2008-05-27 12:36) [3]

2 Юрий Зотов
Забыл сказать, что компоненты надо перемещать плавно, а когда я делаю перемещение в одной процедуре, форма изменяется только после её завершения.

← →
Ega23 © (2008-05-27 12:46) [4]

> а когда я делаю перемещение в одной процедуре, форма изменяется
> только после её завершения.

Внутри цикла Application.ProcessMessages поставь.

← →
TForumHelp © (2008-05-27 18:16) [5]

{
type
TForm1 = class(TForm)
...
procedure MoveMyControls();
procedure Button1Click(Sender: TObject);
}

var
Form1: TForm1;
mx: Integer;
done: Boolean;

procedure Delay(MSecs : Longint);

implementation

procedure Delay(MSecs : Longint);
var
FirstTickCount, Now : Longint;
begin
FirstTickCount := GetTickCount;
repeat
Application.ProcessMessages;
Now := GetTickCount;
until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;

procedure TForm1.MoveMyControls();
begin
done := False;
mx := Button1.Left + 200;//переместимся на 200
while not done do begin
Application.ProcessMessages;
If Button1.Left <= mx then begin
Button1.Left := Button1.Left + 1;//увеличиваем позицию "X" на 1
End else done := True;
Delay(100); //ждем 100 миллисекунд
//можешь поставить меньше или больше
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MoveMyControls();
end;

← →
Ega23 © (2008-05-27 18:18) [6]

procedure TForm1.MoveMyControls();

тут, вроде, Application.ProcessMessages; не нужен...

ну в принципе да, если он есть в > procedure Delay(MSecs : Longint);!

доделаный вариант:
type TForm1 = class(TForm) ... procedure MoveMyControls(); procedure Button1Click(Sender: TObject); .... End; var Form1: TForm1; mx: Integer; done: Boolean; procedure Delay(MSecs : Longint); implementation procedure Delay(MSecs : Longint); var FirstTickCount, Now : Longint; begin FirstTickCount := GetTickCount; repeat Application.ProcessMessages; Now := GetTickCount; until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount); end; procedure TForm1.MoveMyControls(); begin done := False; mx := Button1.Left + 200; while not done do begin If Button1.Left <= mx then Button1.Left := Button1.Left + 1; end else done := True; Delay(10); end; end; procedure TForm1.Button1Click(Sender: TObject); begin MoveMyControls(); end;

извините, доделанНый, а то учителя русского языка начнут возмущаться))

Мерцание при перемещении Найти похожие ветки