Solved

Metafile

Posted on 1998-07-03
21
278 Views
Last Modified: 2010-04-04
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
Comment
Question by:olcay
  • 8
  • 8
  • 5
21 Comments
 
LVL 3

Expert Comment

by:vladika
ID: 1357045
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
 

Author Comment

by:olcay
ID: 1357046
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
 

Author Comment

by:olcay
ID: 1357047
Edited text of question
0
 
LVL 3

Expert Comment

by:vladika
ID: 1357048
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
 
LVL 10

Expert Comment

by:Jacco
ID: 1357049
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
 

Author Comment

by:olcay
ID: 1357050
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
 

Author Comment

by:olcay
ID: 1357051
Adjusted points to 220
0
 
LVL 10

Accepted Solution

by:
Jacco earned 220 total points
ID: 1357052
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
 
LVL 10

Expert Comment

by:Jacco
ID: 1357053
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
 
LVL 3

Expert Comment

by:vladika
ID: 1357054
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:olcay
ID: 1357055
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
 

Author Comment

by:olcay
ID: 1357056
Hi Jacco and Vladika,

thank you very much for your support.

regards Olcay
0
 
LVL 3

Expert Comment

by:vladika
ID: 1357057
And where is solution ?

0
 
LVL 3

Expert Comment

by:vladika
ID: 1357058
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
 
LVL 10

Expert Comment

by:Jacco
ID: 1357059
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
 
LVL 3

Expert Comment

by:vladika
ID: 1357060
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
 

Author Comment

by:olcay
ID: 1357061
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
 
LVL 3

Expert Comment

by:vladika
ID: 1357062
And I talk about it.

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

Why? Don't know.

0
 
LVL 10

Expert Comment

by:Jacco
ID: 1357063
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
 
LVL 3

Expert Comment

by:vladika
ID: 1357064
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
 

Author Comment

by:olcay
ID: 1357065
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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now