创建和保存WMF文件

CONST W = 1000; H = 500; R2 = 353; procedure TForm1.Button1Click(Sender: TObject);
VAR CDC : hDC;
procedure spiral(CV: TCanvas; Colr: TColor; AngInc: Double;
RInc: Integer; Sgn1, Sgn2: Integer);
VAR Theta: Double;
begin
Sgn1 := Sgn1 DIV Abs(Sgn1);
Sgn2 := Sgn2 DIV Abs(Sgn2);
CV.pen.Color := Colr;
Theta := 0;
CV.MoveTo(H,H);
WHILE Theta < pred(H DIV RInc) DO
BEGIN
Theta := Theta + AngInc;
CV.LineTo(H+Sgn1*Round(RInc*Theta*Cos(Sgn2*Theta)),
H+Sgn1*Round(RInc*Theta*Sin(Sgn2*Theta)));
END;
end;
begin
DeleteFile('EXAMPLE.WMF');
WITH TBitmap.Create DO
try
CDC := CreateMetafile(NIL);
Canvas.Handle := CDC;
SetMapMode(Canvas.Handle, MM_ANISOTROPIC);
SetWindowExt(Canvas.Handle, W, W);
WITH Canvas DO
BEGIN
{==== replace with your own image-creation code ===}
Brush.Color := clWhite;
pen.Width := 10;
pen.Style := psInsideFrame;
pen.Color := clBlack;
Ellipse(0,0,W,W);
Spiral(Canvas, clRed, pi/4, 18, 1, 1);
Spiral(Canvas, clBlue, pi/4, 18, -1, 1);
Pen.Color := clBlack;
PolyLine([Point(H,0), Point(H,H), Point(H-R2, H+R2),
Point(H,H), Point(H,W), Point(H,H),
Point(H+R2,H+R2)]);
{====== end image-creation code =====}
END;
WITH TMetafile.Create DO
try
Handle := CloseMetafile(CDC);
Inch := W;
Height := 128;
Width := 128;
SaveToFile('EXAMPLE.WMF');
finally
Free;
end;
finally
Free;
end;
end;