Solved

Metafile

Posted on 1998-07-03
21
281 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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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
 

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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
error 1.1 400 Bad request idhttp delphi 18 147
Intraweb download file link ? 1 154
Create a path if not exists 7 89
How to make Sign in, using Clientdataset? 1 28
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

856 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