06-12-2009, 09:39 AM
كود :
procedure TForm1.animin(Sender: TObject);
procedure delay(msec: Longint);
var
start, stop: Longint;
begin
start := GetTickCount;
repeat
stop := GetTickCount;
Application.ProcessMessages;
until (stop - start) >= msec;
end;
var
maxx, maxy: Integer;
MyHand: HWND;
MyDc: HDC;
MyCanvas: TCanvas;
hal, hat, hak, haa: Integer;
begin
maxx := (Sender as TForm).Width;
maxy := (Sender as TForm).Height;
hal := 2;
hat := 2;
MyHand := GetDesktopWindow;
MyDc := GetWindowDC(MyHand);
MyCanvas := TCanvas.Create;
MyCanvas.Handle := MyDC;
MyCanvas.Brush.Color := (Sender as TForm).Color;
repeat
if hat + (maxy div 24) >= maxy then
begin
hat := maxy
end
else
begin
hat := hat + (maxy div 24);
end;
if hal + (maxx div 24) >= maxx then
begin
hal := maxx
end
else
begin
hal := hal + (maxx div 24);
end;
hak := (Sender as TForm).Left + ((Sender as TForm).Width div 2) - (hal div 2);
haa := (Sender as TForm).Top + ((Sender as TForm).Height div 2) - (hat div 2);
MyCanvas.Rectangle(hak, haa, hak + hal, haa + hat);
delay(10);
until (hal = maxx) and (hat = maxy);
(Sender as TForm).Show;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
animin(form2);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
animin(form3);
end;