首页  编辑  

创建和保存WMF文件

Tags: /超级猛料/Picture.图形图像编程/图片处理/   Date Created:

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;