Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 290
  • Last Modified:

Metafile

How can i draw several shapes (20) in a metafile without to spend a lot of diskspace?
For example:

with Tmetafilecanvas.create(mymetafile,0) do
try
 draw(0,0,mymetafile);
 brush.color := clRed;
 ellipse(0,0,100,100);
finally;
 free;
end;
...

with Tmetafilecanvas.create(mymetafile,0) do
try
 draw(0,0,mymetafile);
 brush.color:= clGreen;
 ellipse(100,100,200,200);
finally;
 free;
end;

I would like repeat the same structure 20 times.

If i do it, so must i spend nearly 2 mb memory
0
olcay
Asked:
olcay
  • 8
  • 8
  • 5
1 Solution
 
vladikaCommented:
I wrote

procedure TForm1.Button1Click(Sender: TObject);
var MF: TMetafile;
    I: Integer;
begin
  MF := TMetafile.Create;
  try
    for I := 1 to 20 do
      with Tmetafilecanvas.create(MF,0) do
      try
        draw(0,0,MF);
        ellipse(0,0,100,100);
      finally;
        free;
      end;
    MF.SaveToFile('c:\mf.emf');
  finally
    MF.Free;
  end;
end;

. and spent only 11204 bytes of disk memoty

0
 
olcayAuthor Commented:
Hi Vladika,

thank you very much for your quickly answer to my question about metafiles. I tested the same metafile example from you and got the cruel result:
                                                      I have spent 20.833 MB of memory-space.

My programming environment is :      Delphi 3.0 (professional)
                     Operating system:      WinNT4.0 (Service pack 3)

Can you write me please, what programming environment and operating system did you use to test the metafile example from you?

Bye Olcay
0
 
olcayAuthor Commented:
Edited text of question
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
vladikaCommented:
Hi Olcay

I use Delphi 3 (Client/Server) and Windows 95

If you want you can send me your program by email
and I test it on my computer.
EMail: demon@dezcom.mephi.ru
or Dmitri_Ulitski@dialogbank.com

Vladika

0
 
JaccoCommented:
Here is your solution:

procedure TForm1.Button1Click(Sender: TObject);
var
  MF: TMetafile;
  I: Integer;
const
  colors : array[0..5] of TColor = (clBlue,clRed,clGreen,clYellow,clBlack,clPurple);
begin
  MF := TMetafile.Create;
  try
    with Tmetafilecanvas.create(MF,0) do begin
      try
        for i:=0 to 100 do begin
          Brush.Color := colors[Random(5)];
          Pen.Color := colors[Random(5)];
          case Random(3) of
            0 : begin
              Ellipse(Random(500),Random(500),Random(500),Random(500));
            end;
            1 : begin
              Rectangle(Random(500),Random(500),Random(500),Random(500));
            end;
            2 : begin
              MoveTo(Random(500),Random(500));
              LineTo(Random(500),Random(500));
            end;
          end;
        end;
      finally;
        Free;
      end;
    end;
    MF.SaveToFile('c:\mf.wmf');
  finally
    MF.Free;
  end;
end;

The Draw(0,0,MF) was slowing everything down and was not needed since to MetaFileCanvas was created already with the context of the MetaFile. Further more the Canvas needs not to be recreated for every ellipse! Only once.

This code works and is fast !

Good luck with your app

Regards Jacco

BTW: I added some fancy stuff for random generated images. Have fun!
0
 
olcayAuthor Commented:
Hi Jacco,

thank you very much for your solution. Your solution is excellent to draw shapes in a metafile,
when the metafile routine:

TMetafile.Create(mf,0) do
try
 ...

finally;
 Free;
end;

called only one time. This is not my problem.

Assume i would like to draw shapes in the same metafile,
several times like in a graphic application. For this purpose,
i implemented a second example, see it please below.

Thank you very much for your support.

Regards Olcay



Example 2:

procedure TForm1.Button1Click(Sender: TObject);
var haf,i: Integer;
    rct:  TRect;
    BeginClr, EndClr: TColor;
    BClr, EClr: TColor;
    KernPG1:   ARRAY[0..27] of TPoint;
    KernPG2:   ARRAY[0..3]  of TPoint;
    KernBotPG: ARRAY[0..15] of TPoint;
    CuFoilPG:  ARRAY[0..3]  of TPoint;
    ViaPL:     ARRAY[0..4]  of TPoint;
    BViaPL:    ARRAY[0..5]  of TPoint;
    BViaBPL:   ARRAY[0..5]  of TPoint;

    MyMetaFile : TMetaFile;
    breite, hoehe: integer;
    Pos_X,Pos_Y: integer;

    FromR, FromG, FromB: Integer; {For color gradient}
    DiffR, DiffG, DiffB: Integer;
    R, G, B: Byte;{Color for Canvas.Brush}

begin
 MyMetafile := TMetafile.Create;

 BeginClr := clRed;
 EndClr := clWhite;
 BClr := clBlack;
 EClr := clWhite;

 {Three ground colors}
 FromR := BeginClr and $000000ff;
 FromG := (BeginClr shr 8) and $000000ff;
 FromB := (BeginClr shr 16) and $000000ff;
 DiffR := (EndClr and $000000ff) - FromR;
 DiffG := ((EndClr shr 8) and $000000ff) - FromG;
 DiffB := ((EndClr shr 16) and $000000ff) - FromB;


 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 100;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Brush.Color:= clRed;
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);

  Polygon(CuFoilPG);
 finally
  Free;
 end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 107;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 130;

  KernPG1[0].x := 0;
  KernPG1[0].y := 0;
  KernPG1[1].x := breite div 7;
  KernPG1[1].y := 0;
  KernPG1[2].x := breite div 7;
  KernPG1[2].y := hoehe div 5;
  KernPG1[3].x := 2*breite div 7;
  KernPG1[3].y := hoehe div 5;
  KernPG1[4].x := 2*breite div 7;
  KernPG1[4].y := 0;
  KernPG1[5].x := 3*breite div 7;
  KernPG1[5].y := 0;
  KernPG1[6].x := 3*breite div 7;
  KernPG1[6].y := hoehe div 5;
  KernPG1[7].x := 4*breite div 7;
  KernPG1[7].y := hoehe div 5;
  KernPG1[8].x := 4*breite div 7;
  KernPG1[8].y := 0;
  KernPG1[9].x := 5*breite div 7;
  KernPG1[9].y := 0;
  KernPG1[10].x := 5*breite div 7;
  KernPG1[10].y := hoehe div 5;
  KernPG1[11].x := 6*breite div 7;
  KernPG1[11].y := hoehe div 5;
  KernPG1[12].x := 6*breite div 7;
  KernPG1[12].y := 0;
  KernPG1[13].x := 7*breite div 7;
  KernPG1[13].y := 0;
  KernPG1[14].x := 7*breite div 7;
  KernPG1[14].y := hoehe;
  KernPG1[15].x := 6*breite div 7;
  KernPG1[15].y := hoehe;
  KernPG1[16].x := 6*breite div 7;
  KernPG1[16].y := 4*hoehe div 5;
  KernPG1[17].x := 5*breite div 7;
  KernPG1[17].y := 4*hoehe div 5;
  KernPG1[18].x := 5*breite div 7;
  KernPG1[18].y := hoehe;
  KernPG1[19].x := 4*breite div 7;
  KernPG1[19].y := hoehe;
  KernPG1[20].x := 4*breite div 7;
  KernPG1[20].y := 4*hoehe div 5;
  KernPG1[21].x := 3*breite div 7;
  KernPG1[21].y := 4*hoehe div 5;
  KernPG1[22].x := 3*breite div 7;
  KernPG1[22].y := hoehe;
  KernPG1[23].x := 2*breite div 7;
  KernPG1[23].y := hoehe;
  KernPG1[24].x := 2*breite div 7;
  KernPG1[24].y := 4*hoehe div 5;
  KernPG1[25].x := breite div 7;
  KernPG1[25].y := 4*hoehe div 5;
  KernPG1[26].x := breite div 7;
  KernPG1[26].y := hoehe;
  KernPG1[27].x := 0;
  KernPG1[27].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernPG1);
  Brush.Handle:= CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clBlue);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 153;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 175;

  KernPG1[0].x := 0;
  KernPG1[0].y := 0;
  KernPG1[1].x := breite div 7;
  KernPG1[1].y := 0;
  KernPG1[2].x := breite div 7;
  KernPG1[2].y := hoehe div 5;
  KernPG1[3].x := 2*breite div 7;
  KernPG1[3].y := hoehe div 5;
  KernPG1[4].x := 2*breite div 7;
  KernPG1[4].y := 0;
  KernPG1[5].x := 3*breite div 7;
  KernPG1[5].y := 0;
  KernPG1[6].x := 3*breite div 7;
  KernPG1[6].y := hoehe div 5;
  KernPG1[7].x := 4*breite div 7;
  KernPG1[7].y := hoehe div 5;
  KernPG1[8].x := 4*breite div 7;
  KernPG1[8].y := 0;
  KernPG1[9].x := 5*breite div 7;
  KernPG1[9].y := 0;
  KernPG1[10].x := 5*breite div 7;
  KernPG1[10].y := hoehe div 5;
  KernPG1[11].x := 6*breite div 7;
  KernPG1[11].y := hoehe div 5;
  KernPG1[12].x := 6*breite div 7;
  KernPG1[12].y := 0;
  KernPG1[13].x := 7*breite div 7;
  KernPG1[13].y := 0;
  KernPG1[14].x := 7*breite div 7;
  KernPG1[14].y := hoehe;
  KernPG1[15].x := 6*breite div 7;
  KernPG1[15].y := hoehe;
  KernPG1[16].x := 6*breite div 7;
  KernPG1[16].y := 4*hoehe div 5;
  KernPG1[17].x := 5*breite div 7;
  KernPG1[17].y := 4*hoehe div 5;
  KernPG1[18].x := 5*breite div 7;
  KernPG1[18].y := hoehe;
  KernPG1[19].x := 4*breite div 7;
  KernPG1[19].y := hoehe;
  KernPG1[20].x := 4*breite div 7;
  KernPG1[20].y := 4*hoehe div 5;
  KernPG1[21].x := 3*breite div 7;
  KernPG1[21].y := 4*hoehe div 5;
  KernPG1[22].x := 3*breite div 7;
  KernPG1[22].y := hoehe;
  KernPG1[23].x := 2*breite div 7;
  KernPG1[23].y := hoehe;
  KernPG1[24].x := 2*breite div 7;
  KernPG1[24].y := 4*hoehe div 5;
  KernPG1[25].x := breite div 7;
  KernPG1[25].y := 4*hoehe div 5;
  KernPG1[26].x := breite div 7;
  KernPG1[26].y := hoehe;
  KernPG1[27].x := 0;
  KernPG1[27].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernPG1);
  Brush.Handle:= CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clAqua);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 198;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 218;

  KernBotPG[0].x := 0;
  KernBotPG[0].y := hoehe div 5;
  KernBotPG[1].x := 7*breite div 7;
  KernBotPG[1].y := hoehe div 5;
  KernBotPG[2].x := 7*breite div 7;
  KernBotPG[2].y := hoehe;
  KernBotPG[3].x := 6*breite div 7;
  KernBotPG[3].y := hoehe;
  KernBotPG[4].x := 6*breite div 7;
  KernBotPG[4].y := 4*hoehe div 5;
  KernBotPG[5].x := 5*breite div 7;
  KernBotPG[5].y := 4*hoehe div 5;
  KernBotPG[6].x := 5*breite div 7;
  KernBotPG[6].y := hoehe;
  KernBotPG[7].x := 4*breite div 7;
  KernBotPG[7].y := hoehe;
  KernBotPG[8].x := 4*breite div 7;
  KernBotPG[8].y := 4*hoehe div 5;
  KernBotPG[9].x := 3*breite div 7;
  KernBotPG[9].y := 4*hoehe div 5;
  KernBotPG[10].x := 3*breite div 7;
  KernBotPG[10].y := hoehe;
  KernBotPG[11].x := 2*breite div 7;
  KernBotPG[11].y := hoehe;
  KernBotPG[12].x := 2*breite div 7;
  KernBotPG[12].y := 4*hoehe div 5;
  KernBotPG[13].x := breite div 7;
  KernBotPG[13].y := 4*hoehe div 5;
  KernBotPG[14].x := breite div 7;
  KernBotPG[14].y := hoehe;
  KernBotPG[15].x := 0;
  KernBotPG[15].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernBotPG);
  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clAqua);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 240;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 260;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clBlue);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 280;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);
  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 303;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  Brush.Color:= clRed;
  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 20;
  hoehe := 208;
  Pos_X := 104;
  Pos_Y := 100;
  Haf := breite Div 2;


  ViaPL[0].x := 0;
  ViaPL[0].y := 0;
  ViaPL[1].x := breite;
  ViaPL[1].y := 0;
  ViaPL[2].x := breite;
  ViaPL[2].y := hoehe;
  ViaPL[3].x := 0;
  ViaPL[3].y := hoehe;
  ViaPL[4].x := 0;
  ViaPL[4].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct:= Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(ViaPL);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 20;
  hoehe := 50;
  Pos_X := 161;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 20;
  hoehe := 80;
  Pos_X := 218;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 20;
  hoehe := 75;
  Pos_X := 161;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);
  finally
  Free;
  end;

 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  draw(0,0,MyMetafile);

  breite := 20;
  hoehe := 117;
  Pos_X := 218;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  ViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);
  finally
  Free;
  end;

 Form1.Canvas.Draw(0,0,MyMetafile);
 MyMetafile.SaveToFile('c:\temp\MetaTest1.wmf');
 MyMetafile.Free;
end;


0
 
olcayAuthor Commented:
Adjusted points to 220
0
 
JaccoCommented:
I updated your code:

What I did was Creating the canvas only one time!

Without being recreated and redrawn.

100 times faster :)

If this is not what you are looking for please explain further.

Regards Jacco

*** start of code ***

procedure TForm1.Button1Click(Sender: TObject);
var haf,i: Integer;
    rct:  TRect;
    BeginClr, EndClr: TColor;
    BClr, EClr: TColor;
    KernPG1:   ARRAY[0..27] of TPoint;
    KernPG2:   ARRAY[0..3]  of TPoint;
    KernBotPG: ARRAY[0..15] of TPoint;
    CuFoilPG:  ARRAY[0..3]  of TPoint;
    ViaPL:     ARRAY[0..4]  of TPoint;
    BViaPL:    ARRAY[0..5]  of TPoint;
    BViaBPL:   ARRAY[0..5]  of TPoint;

    MyMetaFile : TMetaFile;
    breite, hoehe: integer;
    Pos_X,Pos_Y: integer;

    FromR, FromG, FromB: Integer; {For color gradient}
    DiffR, DiffG, DiffB: Integer;
    R, G, B: Byte;{Color for Canvas.Brush}

begin
 MyMetafile := TMetafile.Create;

 BeginClr := clRed;
 EndClr := clWhite;
 BClr := clBlack;
 EClr := clWhite;

 {Three ground colors}
 FromR := BeginClr and $000000ff;
 FromG := (BeginClr shr 8) and $000000ff;
 FromB := (BeginClr shr 16) and $000000ff;
 DiffR := (EndClr and $000000ff) - FromR;
 DiffG := ((EndClr shr 8) and $000000ff) - FromG;
 DiffB := ((EndClr shr 16) and $000000ff) - FromB;


 with TMetafileCanvas.Create(MyMetaFile,0) do
 try
  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 100;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Brush.Color:= clRed;
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);

  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);

  Polygon(CuFoilPG);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 107;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 130;

  KernPG1[0].x := 0;
  KernPG1[0].y := 0;
  KernPG1[1].x := breite div 7;
  KernPG1[1].y := 0;
  KernPG1[2].x := breite div 7;
  KernPG1[2].y := hoehe div 5;
  KernPG1[3].x := 2*breite div 7;
  KernPG1[3].y := hoehe div 5;
  KernPG1[4].x := 2*breite div 7;
  KernPG1[4].y := 0;
  KernPG1[5].x := 3*breite div 7;
  KernPG1[5].y := 0;
  KernPG1[6].x := 3*breite div 7;
  KernPG1[6].y := hoehe div 5;
  KernPG1[7].x := 4*breite div 7;
  KernPG1[7].y := hoehe div 5;
  KernPG1[8].x := 4*breite div 7;
  KernPG1[8].y := 0;
  KernPG1[9].x := 5*breite div 7;
  KernPG1[9].y := 0;
  KernPG1[10].x := 5*breite div 7;
  KernPG1[10].y := hoehe div 5;
  KernPG1[11].x := 6*breite div 7;
  KernPG1[11].y := hoehe div 5;
  KernPG1[12].x := 6*breite div 7;
  KernPG1[12].y := 0;
  KernPG1[13].x := 7*breite div 7;
  KernPG1[13].y := 0;
  KernPG1[14].x := 7*breite div 7;
  KernPG1[14].y := hoehe;
  KernPG1[15].x := 6*breite div 7;
  KernPG1[15].y := hoehe;
  KernPG1[16].x := 6*breite div 7;
  KernPG1[16].y := 4*hoehe div 5;
  KernPG1[17].x := 5*breite div 7;
  KernPG1[17].y := 4*hoehe div 5;
  KernPG1[18].x := 5*breite div 7;
  KernPG1[18].y := hoehe;
  KernPG1[19].x := 4*breite div 7;
  KernPG1[19].y := hoehe;
  KernPG1[20].x := 4*breite div 7;
  KernPG1[20].y := 4*hoehe div 5;
  KernPG1[21].x := 3*breite div 7;
  KernPG1[21].y := 4*hoehe div 5;
  KernPG1[22].x := 3*breite div 7;
  KernPG1[22].y := hoehe;
  KernPG1[23].x := 2*breite div 7;
  KernPG1[23].y := hoehe;
  KernPG1[24].x := 2*breite div 7;
  KernPG1[24].y := 4*hoehe div 5;
  KernPG1[25].x := breite div 7;
  KernPG1[25].y := 4*hoehe div 5;
  KernPG1[26].x := breite div 7;
  KernPG1[26].y := hoehe;
  KernPG1[27].x := 0;
  KernPG1[27].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernPG1);
  Brush.Handle:= CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clBlue);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 153;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 175;

  KernPG1[0].x := 0;
  KernPG1[0].y := 0;
  KernPG1[1].x := breite div 7;
  KernPG1[1].y := 0;
  KernPG1[2].x := breite div 7;
  KernPG1[2].y := hoehe div 5;
  KernPG1[3].x := 2*breite div 7;
  KernPG1[3].y := hoehe div 5;
  KernPG1[4].x := 2*breite div 7;
  KernPG1[4].y := 0;
  KernPG1[5].x := 3*breite div 7;
  KernPG1[5].y := 0;
  KernPG1[6].x := 3*breite div 7;
  KernPG1[6].y := hoehe div 5;
  KernPG1[7].x := 4*breite div 7;
  KernPG1[7].y := hoehe div 5;
  KernPG1[8].x := 4*breite div 7;
  KernPG1[8].y := 0;
  KernPG1[9].x := 5*breite div 7;
  KernPG1[9].y := 0;
  KernPG1[10].x := 5*breite div 7;
  KernPG1[10].y := hoehe div 5;
  KernPG1[11].x := 6*breite div 7;
  KernPG1[11].y := hoehe div 5;
  KernPG1[12].x := 6*breite div 7;
  KernPG1[12].y := 0;
  KernPG1[13].x := 7*breite div 7;
  KernPG1[13].y := 0;
  KernPG1[14].x := 7*breite div 7;
  KernPG1[14].y := hoehe;
  KernPG1[15].x := 6*breite div 7;
  KernPG1[15].y := hoehe;
  KernPG1[16].x := 6*breite div 7;
  KernPG1[16].y := 4*hoehe div 5;
  KernPG1[17].x := 5*breite div 7;
  KernPG1[17].y := 4*hoehe div 5;
  KernPG1[18].x := 5*breite div 7;
  KernPG1[18].y := hoehe;
  KernPG1[19].x := 4*breite div 7;
  KernPG1[19].y := hoehe;
  KernPG1[20].x := 4*breite div 7;
  KernPG1[20].y := 4*hoehe div 5;
  KernPG1[21].x := 3*breite div 7;
  KernPG1[21].y := 4*hoehe div 5;
  KernPG1[22].x := 3*breite div 7;
  KernPG1[22].y := hoehe;
  KernPG1[23].x := 2*breite div 7;
  KernPG1[23].y := hoehe;
  KernPG1[24].x := 2*breite div 7;
  KernPG1[24].y := 4*hoehe div 5;
  KernPG1[25].x := breite div 7;
  KernPG1[25].y := 4*hoehe div 5;
  KernPG1[26].x := breite div 7;
  KernPG1[26].y := hoehe;
  KernPG1[27].x := 0;
  KernPG1[27].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernPG1);
  Brush.Handle:= CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clAqua);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 198;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 218;

  KernBotPG[0].x := 0;
  KernBotPG[0].y := hoehe div 5;
  KernBotPG[1].x := 7*breite div 7;
  KernBotPG[1].y := hoehe div 5;
  KernBotPG[2].x := 7*breite div 7;
  KernBotPG[2].y := hoehe;
  KernBotPG[3].x := 6*breite div 7;
  KernBotPG[3].y := hoehe;
  KernBotPG[4].x := 6*breite div 7;
  KernBotPG[4].y := 4*hoehe div 5;
  KernBotPG[5].x := 5*breite div 7;
  KernBotPG[5].y := 4*hoehe div 5;
  KernBotPG[6].x := 5*breite div 7;
  KernBotPG[6].y := hoehe;
  KernBotPG[7].x := 4*breite div 7;
  KernBotPG[7].y := hoehe;
  KernBotPG[8].x := 4*breite div 7;
  KernBotPG[8].y := 4*hoehe div 5;
  KernBotPG[9].x := 3*breite div 7;
  KernBotPG[9].y := 4*hoehe div 5;
  KernBotPG[10].x := 3*breite div 7;
  KernBotPG[10].y := hoehe;
  KernBotPG[11].x := 2*breite div 7;
  KernBotPG[11].y := hoehe;
  KernBotPG[12].x := 2*breite div 7;
  KernBotPG[12].y := 4*hoehe div 5;
  KernBotPG[13].x := breite div 7;
  KernBotPG[13].y := 4*hoehe div 5;
  KernBotPG[14].x := breite div 7;
  KernBotPG[14].y := hoehe;
  KernBotPG[15].x := 0;
  KernBotPG[15].y := hoehe;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Color:= clRed;
  Polygon(KernBotPG);
  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clAqua);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 240;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 260;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clBlue);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 20;
  Pos_X := 100;
  Pos_Y := 280;

  KernPG2[0].x := 0;
  KernPG2[0].y := hoehe div 5;
  KernPG2[1].x := breite;
  KernPG2[1].y := hoehe div 5;
  KernPG2[2].x := breite;
  KernPG2[2].y := 4*hoehe div 5;
  KernPG2[3].x := 0;
  KernPG2[3].y := 4*hoehe div 5;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  Brush.Handle := CreateHatchBrush(HS_DIAGCROSS,clBlack);
  SetBkColor(handle,clPurple);
  Polygon(KernPG2);

  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 303;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  Brush.Color:= clRed;
  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);

  breite := 20;
  hoehe := 208;
  Pos_X := 104;
  Pos_Y := 100;
  Haf := breite Div 2;


  ViaPL[0].x := 0;
  ViaPL[0].y := 0;
  ViaPL[1].x := breite;
  ViaPL[1].y := 0;
  ViaPL[2].x := breite;
  ViaPL[2].y := hoehe;
  ViaPL[3].x := 0;
  ViaPL[3].y := hoehe;
  ViaPL[4].x := 0;
  ViaPL[4].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct:= Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(ViaPL);

  breite := 20;
  hoehe := 50;
  Pos_X := 161;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);

  breite := 20;
  hoehe := 80;
  Pos_X := 218;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);

  breite := 20;
  hoehe := 75;
  Pos_X := 161;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);

  breite := 20;
  hoehe := 117;
  Pos_X := 218;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  ViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);

  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);
  finally
  Free;
  end;

 Form1.Canvas.Draw(0,0,MyMetafile);
 MyMetafile.SaveToFile('c:\temp\MetaTest1.wmf');
 MyMetafile.Free;
end;

*** end of code ***
0
 
JaccoCommented:
Oh yeah:

The problem why it is so slow was the following:

you did:
Draw an item
Create new canvas from metafile (item is already there)
Draw(0,0,MF) draw the item again!
Draw new item
Create new canvas from metafile (items are already there)
Draw(0,0,MF) draw 2xItem1 and 1xItem2

after 8 iterations you get

Draw(0,0,MF) 256xItem1 128xItem2 64xItem3 32xItem4 16xItem5 8xItem6 4xItem7 2xItem8 1xItem9

This is to much !!!!

You don't see this in the result because the items are all the same.

Good luck
Regards Jacco




0
 
vladikaCommented:
2Jacco

> Create new canvas from metafile (item is already there)
> Draw(0,0,MF) draw the item again!

I think you are wrong

Create new canvas from metafile (NO item)
After Draw(0,0,MF) old items appears

See example in graphics.pas
 
0
 
olcayAuthor Commented:
Hi Jacco,

thank you for your quikly answer.

Would you please see the following example below.

Thank you very much for your support.

Regards Olcay  
 


Example 3:


unit Metafile5;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
   { Private-Deklarationen }
   Meta  : TMetaFile;
   breite, hoehe: integer;
   Pos_X,Pos_Y: integer;
   haf: integer;
   rct:  TRect;
   BeginClr, EndClr: TColor;
   BClr, EClr: TColor;

   FromR, FromG, FromB: Integer; {Farbverlaeufe Darstellen}
   DiffR, DiffG, DiffB: Integer;
   R, G, B: Byte;{Farbwerte fuer Canvas.Brush}

   CuFoilPG:  ARRAY[0..3]  of TPoint;
   ViaPL:     ARRAY[0..4]  of TPoint;
   BViaPL:    ARRAY[0..5]  of TPoint;
   BViaBPL:   ARRAY[0..5]  of TPoint;
  public
    { Public-Deklarationen }
  end;

var
 Form1: TForm1;


implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 BeginClr := clRed;
 EndClr := clWhite;
 BClr := clBlack;
 EClr := clWhite;

 FromR := BeginClr and $000000ff;
 FromG := (BeginClr shr 8) and $000000ff;
 FromB := (BeginClr shr 16) and $000000ff;
 DiffR := (EndClr and $000000ff) - FromR;
 DiffG := ((EndClr shr 8) and $000000ff) - FromG;
 DiffB := ((EndClr shr 16) and $000000ff) - FromB;
 Meta := TMetaFile.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 100;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  Brush.Color:= clRed;
  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
 finally
  Free;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 200;
  hoehe := 5;
  Pos_X := 100;
  Pos_Y := 303;

  CuFoilPG[0].x := 0;
  CuFoilPG[0].y := 0;
  CuFoilPG[1].x := breite div 7;
  CuFoilPG[1].y := 0;
  CuFoilPG[2].x := breite div 7;
  CuFoilPG[2].y := hoehe;
  CuFoilPG[3].x := 0;
  CuFoilPG[3].y := hoehe;

  Brush.Color:= clRed;
  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+2*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+4*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
  SetWindowOrgEx(handle,-(Pos_X+6*breite div 7),-Pos_Y,nil);
  Polygon(CuFoilPG);
 finally
 Free;
 end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var i: Integer;
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 20;
  hoehe := 208;
  Pos_X := 104;
  Pos_Y := 100;
  Haf := breite Div 2;

  ViaPL[0].x := 0;
  ViaPL[0].y := 0;
  ViaPL[1].x := breite;
  ViaPL[1].y := 0;
  ViaPL[2].x := breite;
  ViaPL[2].y := hoehe;
  ViaPL[3].x := 0;
  ViaPL[3].y := hoehe;
  ViaPL[4].x := 0;
  ViaPL[4].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  rct:= Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(ViaPL);
 finally
 Free;
 end;

end;

procedure TForm1.Button4Click(Sender: TObject);
var i: Integer;
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 20;
  hoehe := 50;
  Pos_X := 161;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);
 finally
 Free;
 end;

end;

procedure TForm1.Button5Click(Sender: TObject);
var i: Integer;
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 20;
  hoehe := 80;
  Pos_X := 218;
  Pos_Y := 100;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  rct   := Rect(0,0,breite,hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=(hoehe - haf+1)+i;
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaPL);
 finally
 Free;
 end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var i: Integer;
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 20;
  hoehe := 75;
  Pos_X := 161;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  BViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);
 finally
 Free;
 end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var i: Integer;
begin
 With TMetaFileCanvas.Create(Meta, 0) do
 try
  Draw(0,0,Meta);

  breite := 20;
  hoehe := 117;
  Pos_X := 218;
  Pos_Y := 308;
  Haf := breite Div 2;

  BViaPL[0].x := 0;
  BViaPL[0].y := 0;
  BViaPL[1].x := breite;
  BViaPL[1].y := 0;
  BViaPL[2].x := breite;
  ViaPL[2].y := hoehe-haf;
  BViaPL[3].x := breite div 2;
  BViaPL[3].y := hoehe;
  BViaPL[4].x := 0;
  BViaPL[4].y := hoehe-haf;
  BViaPL[5].x := 0;
  BViaPL[5].y := 0;

  BViaBPL[0].x := 0;
  BViaBPL[0].y := 0;
  BViaBPL[1].x := breite;
  BViaBPL[1].y := 0;
  BViaBPL[2].x := breite;
  BViaBPL[2].y := -(hoehe-haf);
  BViaBPL[3].x := breite div 2;
  BViaBPL[3].y := -hoehe;
  BViaBPL[4].x := 0;
  BViaBPL[4].y := -(hoehe-haf);
  BViaBPL[5].x := 0;
  BViaBPL[5].y := 0;

  SetWindowOrgEx(handle,-Pos_X,-Pos_Y,nil);
  rct   := Rect(0,0,breite,-hoehe);
  for I := 0 to (Haf) do
  begin
   rct.Left  := MulDiv (I, Haf, Haf);
   rct.Right := MulDiv(I+1, Haf, Haf);
   rct.Bottom :=-((hoehe - haf+1)+i);
   R := FromR + MulDiv(I, DiffR, Haf);
   G := FromG + MulDiv(I, DiffG, Haf);
   B := FromB + MulDiv(I, DiffB, Haf);
   Brush.Color := RGB(R, G, B);
   FillRect(rct);
   rct.Left := breite - (MulDiv (I, Haf, Haf));
   rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
   FillRect(rct);
  end;
  polyline(BViaBPL);
 finally
 Free;
 end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  Form1.Canvas.Draw(0,0,Meta);
 Meta.SaveToFile('c:\temp\MetaTest1.wmf');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Meta.Free;
end;

end.

0
 
olcayAuthor Commented:
Hi Jacco and Vladika,

thank you very much for your support.

regards Olcay
0
 
vladikaCommented:
And where is solution ?

0
 
vladikaCommented:
We have problem using Draw(0, 0, Meta) MANY times.

> Creating the canvas only ONE time
It is not solution.

For example when we modify existing metafile
we must use Draw(0, 0, Meta) even if one time.

0
 
JaccoCommented:
vladika:

creating the canvas several times is not your solution. If you want to draw into an exitsing file create the canvas and call draw once!! Then do your drawing and save the result. Freeing ther canvas draws it into the metafile.

I adjusted your code somewhat maybe you find something usefull in it.



*** start of code ***

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TArrow = array[0..5] of TPoint;
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
   { Private-Deklarationen }
   Meta  : TMetaFile;
   MetaCanvas : TMetaFileCanvas;
   breite, hoehe: integer;
   Pos_X,Pos_Y: integer;
   haf: integer;
   rct:  TRect;
   BeginClr, EndClr: TColor;
   BClr, EClr: TColor;

   FromR, FromG, FromB: Integer; {Farbverlaeufe Darstellen}
   DiffR, DiffG, DiffB: Integer;
   R, G, B: Byte;{Farbwerte fuer Canvas.Brush}

   procedure DrawCuFoil(r : TRect; o : TPoint);
   procedure FountainFill(rct : TRect; o : TPoint);
   procedure FountainArrow(rct : TRect; Bottom : Boolean);
   function MakeArrow(rct : TRect; Bottom : Boolean) : TArrow;
   procedure DrawArrow(rct : TRect; Bottom : Boolean; o : TPoint);
  public
    { Public-Deklarationen }
  end;

var
 Form1: TForm1;


implementation

{$R *.DFM}

procedure TForm1.DrawCuFoil(r : TRect; o : TPoint);
begin
  with MetaCanvas do begin
    SetWindowOrgEx(Handle,o.X,o.Y,nil);
    Rectangle(r.Left,r.Top,r.Right,r.Bottom);
  end;
end;

procedure TForm1.FountainFill(rct : TRect; o : TPoint);
var
  i :  Integer;
  rt : TRect;
begin
  rt:=rct;
  with MetaCanvas do begin
    SetWindowOrgEx(handle,o.X,o.Y,nil);
    Brush.Style := bsSolid;
    for i := 0 to Haf do begin
      rct.Left  := MulDiv (I, Haf, Haf);
      rct.Right := MulDiv(I+1, Haf, Haf);
      R := FromR + MulDiv(I, DiffR, Haf);
      G := FromG + MulDiv(I, DiffG, Haf);
      B := FromB + MulDiv(I, DiffB, Haf);
      Brush.Color := RGB(R, G, B);
      FillRect(rct);
      rct.Left := breite - (MulDiv (I, Haf, Haf));
      rct.Right := breite - (MulDiv (I + 1, Haf, Haf));
      FillRect(rct);
    end;
    Brush.Style:=bsClear;
    Rectangle(rt.Left,rt.Top,rt.Right,rt.Bottom);
  end;
end;

procedure TForm1.FountainArrow(rct : TRect; Bottom : Boolean);
var
  i,s : Integer;
begin
  if Bottom then s:=1 else s:=-1;
  with MetaCanvas do begin
    for i := 0 to (Haf) do begin
      rct.Left  := MulDiv (i, Haf, Haf);
      rct.Right := MulDiv(i+1, Haf, Haf);
      rct.Bottom :=s*((hoehe - haf+1)+i);
      R := FromR + MulDiv(i, DiffR, Haf);
      G := FromG + MulDiv(i, DiffG, Haf);
      B := FromB + MulDiv(i, DiffB, Haf);
      Brush.Color := RGB(R, G, B);
      FillRect(rct);
      rct.Left := breite - (MulDiv (i, Haf, Haf));
      rct.Right := breite - (MulDiv (i + 1, Haf, Haf));
      FillRect(rct);
    end;
  end;
end;

function TForm1.MakeArrow(rct : TRect; Bottom : Boolean) : TArrow;
var
  s : Integer;
begin
  if Bottom then s:=1 else s:=-1;
  Result[0]:=rct.TopLeft;
  Result[1].X:=rct.Right;
  Result[1].Y:=0;
  Result[2].X:=rct.Right;
  Result[2].Y:=(rct.Bottom-s*haf);
  Result[3].X:=rct.Left + (rct.Right-rct.Left) div 2;
  Result[3].Y:=rct.Bottom;
  Result[4].X:=rct.Left;
  Result[4].Y:=(rct.Bottom-s*haf);
  Result[5]:=rct.TopLeft;
end;

procedure TForm1.DrawArrow(rct : TRect; Bottom : Boolean; o : TPoint);
var
  a : TArrow;
begin
  with MetaCanvas do begin
    SetWindowOrgEx(handle,o.X,o.Y,nil);
    FountainArrow(rct,Bottom);
    a:=MakeArrow(rct,Bottom);
    PolyLine(a);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BeginClr := clRed;
  EndClr := clWhite;
  BClr := clBlack;
  EClr := clWhite;

  FromR := BeginClr and $000000ff;
  FromG := (BeginClr shr 8) and $000000ff;
  FromB := (BeginClr shr 16) and $000000ff;
  DiffR := (EndClr and $000000ff) - FromR;
  DiffG := ((EndClr shr 8) and $000000ff) - FromG;
  DiffB := ((EndClr shr 16) and $000000ff) - FromB;
  Meta := TMetaFile.Create;
  MetaCanvas:=TMetaFileCanvas.Create(Meta,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  iCount : Integer;
  r : TRect;
begin
  with MetaCanvas do begin
    breite := 200;
    hoehe := 5;
    Pos_X := 100;
    Pos_Y := 100;
    Brush.Color := clRed;
    r:=Rect(0,0,breite div 7,hoehe);
    for iCount:=0 to 3 do
      DrawCuFoil(r,Point(-(Pos_X+iCount*2*breite div 7),-Pos_Y));
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  iCount : Integer;
  r : TRect;
begin
  With MetaCanvas do begin
    breite := 200;
    hoehe := 5;
    Pos_X := 100;
    Pos_Y := 303;
    Brush.Color := clRed;
    r:=Rect(0,0,breite div 7,hoehe);
    for iCount:=0 to 3 do
      DrawCuFoil(r,Point(-(Pos_X+iCount*2*breite div 7),-Pos_Y));
  end;
end;


procedure TForm1.Button3Click(Sender: TObject);
var
  i: Integer;
begin
  with MetaCanvas do begin
    breite := 20;
    hoehe := 208;
    Pos_X := 104;
    Pos_Y := 100;
    Haf := breite Div 2;
    FountainFill(Rect(0,0,breite,hoehe),Point(-Pos_X,-Pos_Y));
  end;
end;


procedure TForm1.Button4Click(Sender: TObject);
var
  i: Integer;
begin
  with MetaCanvas do begin
    breite := 20;
    hoehe := 50;
    Pos_X := 161;
    Pos_Y := 100;
    Haf := breite Div 2;
    DrawArrow(Rect(0,0,breite,hoehe),True,Point(-Pos_X,-Pos_Y));
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  i : Integer;
begin
  with MetaCanvas do begin
    breite := 20;
    hoehe := 80;
    Pos_X := 218;
    Pos_Y := 100;
    Haf := breite Div 2;
    DrawArrow(Rect(0,0,breite,hoehe),True,Point(-Pos_X,-Pos_Y));
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  i: Integer;
begin
  with MetaCanvas do begin
    breite := 20;
    hoehe := 75;
    Pos_X := 161;
    Pos_Y := 308;
    Haf := breite Div 2;
    DrawArrow(Rect(0,0,breite,-hoehe),False,Point(-Pos_X,-Pos_Y));
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  i : Integer;
begin
  With MetaCanvas do begin
    breite := 20;
    hoehe := 117;
    Pos_X := 218;
    Pos_Y := 308;
    Haf := breite Div 2;
    DrawArrow(Rect(0,0,breite,-hoehe),False,Point(-Pos_X,-Pos_Y));
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  MetaCanvas.Free;  // the metacanvas must be freed before draing appears !!
  Form1.Canvas.Draw(0,0,Meta);
  Meta.SaveToFile('c:\temp\MetaTest1.wmf');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Meta.Free;
end;

end.

*** end of code ***
0
 
vladikaCommented:
Jacco:

Ok.

1) Start Application
    Open exisiting metafile.
    Draw previous metafile once (call Draw(0, 0, Meta))
    Modify metafile (Button1 Click)
    Save modified metafile
    Close Application
2) Start Application
    Open same metafile.
    Draw previous metafile once (call Draw(0, 0, Meta))
    Modify metafile (Button2 Click)
    Save modified metafile
    Close Application
...........................
N) Start Application
    Open same metafile.
    Draw previous metafile once (call Draw(0, 0, Meta))
    Modify metafile (ButtonN Click)
    Save modified metafile
    Close Application

So we call Draw(0, 0, Meta) many times.

Problem: When we use Draw(0, 0, Meta) under NT many times
we have enormous metafile!!!

How can we call Draw(0, 0, Meta) many times and have small metafile???

0
 
olcayAuthor Commented:
Hi Jacco and Vladika,

if you call  the Help for TMetaFileCanvas in Delphi3 you will see in the 'Original-Help' an examlpe.

This example shows the same way to save objects in existing metafile with  draw(mf,0).

Regards Olcay


Here is the example:

(Delphi3 in German)
////////////////////////////////////////////////////////////////////

Mit dem TMetafileCanvas-Objekt können Anwendungen ein Metadatei-Bild von Grund auf erstellen.

Unit

graphics

Beschreibung

Das Objekt TMetafileCanvas wird als Oberfläche für das Zeichnen eines Metadatei-Bildes verwendet.
Sobald die Zeichenfläche freigegeben wird, überträgt das Objekt das Bild in eine Metadatei,
auf die der Konstruktor der Zeichenfläche zugreifen kann. Nachdem das Bild auf der Zeichenfläche dargestellt und diese freigegeben wurde,
steht das Bild im Metadatei-Objekt bereit. Ein Beispiel:

MyMetafile := TMetafile.Create;

with TMetafileCanvas.Create(MyMetafile, 0) do
try
Brush.Color := clRed;
Ellipse(0,0,100,100);
.
finally
Free;
end;

Form1.Canvas.Draw(0,0,MyMetafile); {ein roter Kreis}

Wenn zu einem bestehenden Metadatei-Bild etwas hinzugefügt werden soll,
erzeugen Sie eine Metadatei-Zeichenfläche und stellen die Quell-Metadatei auf der Metadatei-Zeichenfläche dar:

{Fortsetzung des obigen Beispiels. MyMetafile enthält deshalb bereits ein Bild.}

with TMetafileCanvas.Create(MyMetafile, 0) do
try
Draw(0,0,MyMetafile);
Brush.Color := clBlue;
Ellipse(100,100,200,200);
.
finally
Free;
end;

Form1.Canvas.Draw(0,0,MyMetafile); {ein roter Kreis und ein blauer Kreis}
////////////////////////////////////////////////////////////////////

0
 
vladikaCommented:
And I talk about it.

It MUST work, but DOES NOT work correctly under NT.

Why? Don't know.

0
 
JaccoCommented:
I have seen this problem.  I will try to make an example that doesn't show this behaviour. A small example with some circle. I definitely think that the objects are stored multiple times when you call the Draw(0,0,MF) many times.

BTW oclay have you checked the code above?

Oh yeah, and I think the Delphi Help file is wrong on the TMetaFileCanvas part. The file size is the proof.

But let me see!

Regards Jacco
0
 
vladikaCommented:
I check Metafile structure after call Draw() many times

I notice that Metafile structure after call Draw() many times under NT
(in the metafile which Olcay sent me)  is
EMR_HEADER
. other instruction

EMR_SETWORLDTRANSFROM             // many many many times !!!
EMR_MODIFYWORLDTRANSFROM

. other instruction
EMR_EOF


0
 
olcayAuthor Commented:
Hi Jacco,

your example from Wednesday ( July 08 1998 - 02:17AM) is ingenious!
I can solve therewith a big problem.

The only problem is when i close and open the same application, so is the
existing metafile newly created  ( see TForm1.FormCreate ) and the contents deleted.
But, i think i can solve this problem by calling draw(0,0,Meta) only one time when a existing metafile is opened.

Thank you very much for your support.

Regards Olcay


Short summary of your example:

var   Meta  : TMetaFile;
          MetaCanvas : TMetaFileCanvas;


procedure TForm1.FormCreate(Sender: TObject);
begin
   Meta := TMetaFile.Create;
   MetaCanvas:=TMetaFileCanvas.Create(Meta,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   With MetaCanvas do begin
      ...    
   end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
   With MetaCanvas do begin
      ...    
   end;
end;

.

procedure TForm1.Button7Click(Sender: TObject);
begin
   With MetaCanvas do begin
      ...    
   end;
end;

procedure TForm2.Button8Click(Sender: TObject);
begin
  MetaCanvas.Free;  // the metacanvas must be freed before draing appears !!
  Form1.Canvas.Draw(0,0,Meta);
  Meta.SaveToFile('c:\temp\MetaTest1.wmf');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Meta.Free;
end;
       
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 8
  • 8
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now