Вариант:| Код |
procedure TForm1.Button1Click(Sender: TObject);
var Rgn:HRGN;
s:TMetafile;
begin
s:=TMetaFile.Create;
s.Width:=500;
s.Height:=500;
Rgn:=CreateRectRgn(-10,-10,250,250);
with TMetafileCanvas.Create(s,0) do
try
SetViewportOrgEx(Handle,-10,-10,nil);
SelectClipRgn(Handle,Rgn);
Brush.Color:=clWhite;
Rectangle(0,0,100,100);
Ellipse(100,100,200,200);
Ellipse(200,200,300,300);
Ellipse(300,300,400,400);
Rectangle(400,400,500,500);
SelectClipRgn(Handle,0);
finally
Free;
DeleteObject(Rgn);
end;
Image1.Picture.Metafile:=s;
end;
|
Вариант:| Код |
procedure TForm1.Button2Click(Sender: TObject);
var s,d:TMetafile;
i:integer;
begin
Image1.AutoSize:=true;
s:=TMetaFile.Create;
s.Width:=500;
s.Height:=500;
with TMetafileCanvas.Create(s,0) do
try
Brush.Color := clWhite;
Rectangle(0,0,100,100);
Ellipse(100,100,200,200);
Ellipse(200,200,300,300);
Ellipse(300,300,400,400);
Rectangle(400,400,500,500);
finally
Free;
end;
d:=TMetafile.Create;
d.Width:=250;
d.Height:=250;
i:=0;
repeat
with TMetafileCanvas.Create(d,0) do
try
d.Clear;
SetViewportOrgEx(Handle,-i,-i,nil);
PlayEnhMetaFile(Handle,s.Handle,Rect(0,0,s.Width,s.Height));
finally
Free;
end;
Image1.Picture.Metafile:=d;
Application.ProcessMessages;
sleep(10);
inc(i);
until (i=250);
end;
|
И т.д. и т.п. |