Текущий архив: 2008.06.22;
Скачать: CL | DM;

Вниз

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

← →
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; не нужен...

---

← →
TForumHelp ©   (2008-05-27 18:55) [7]

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

---

← →
TForumHelp ©   (2008-05-27 19:08) [8]

доделаный вариант:

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;


---

← →
TForumHelp ©   (2008-05-27 19:09) [9]

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

---

Страницы: 1 вся ветка

Текущий архив: 2008.06.22;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.017 c