Improve company productivity with a Business Account.Sign Up

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

Coloring a metafile ( delphi 7)

Hi , I need some help !(working with delphi 7)
 I need to build a fast routine that can change directly the color of a metafile( then pen color)  loaded in memory,  each time I wanted to draw it on a canvas.
(the original metafile contains a graphic drawn with black pin color)

The procedure below does  the job very well  by accessing the structure table of the metafile and then changing the pen color....

Being Excited in trying that , I decided to mesure the speed  of my  new solution .

So I put the procedure into a loop of ( 5000 times) ,  but  after some 3000 execution  the program rized an exception : some thing like   " invalid meta file"

I think there is a problem of  loosing memory each time "procedure drawmetafile" is executed !! may be  something should be freed some where ....

Could you please help me comleting the 5000 execution without problems?!

 

{************ PROCEDURE DRAWMETAFILE***************}

{meta is created and loaded once in the oncreated event of the main form}
procedure drawmetafile(meta:tmetafile;canvas:tcanvas;x,y:integer;apencol:tcolor);
var
  MyRect: TRect;
  meta:tmetafile;
begin
 pencol:=apencol;
 SetRect(MyRect,x,y,x+meta.width,y+meta.height);
 

 if not EnumEnhMetaFile  (Canvas.Handle,Meta.Handle,@EnumCallBack,@MyRect,MyRect) then
  ShowMessage('Failed');}
 end;

{************END OF  PROCEDURE DRAWMETAFILE***************}

 

                         {FUNCTION USED NBY PROCEDURE}
function EnumCallBack(HDC: integer;var pHTable: THandleTable;var pEMFR: TEnhMetaRecord;nObj: integer;lpData: pointer): integer; stdcall;
var
  MyPen: Integer;
  mybrush:integer;
begin
  Case pEMFR.iType of
    EMR_CREATEPEN :
           begin
            MyPen:=CreatePen(PS_SOLID,10,pencol);
            DeleteObject(SelectObject(HDC,MyPen));
           end;

    else PlayEnhMetaFileRecord(HDC,phTable,pEMFR,nObj);
  end;
  result:=1;
end;

0
fara200
Asked:
fara200
  • 5
  • 2
1 Solution
 
vadim_tiCommented:
one thing is sure not good

meta is created and loaded once in the oncreated event of the main form}
procedure drawmetafile(meta:tmetafile;canvas:tcanvas;x,y:integer;apencol:tcolor);
var
  MyRect: TRect;
  meta:tmetafile;
begin
 pencol:=apencol;
 SetRect(MyRect,x,y,x+meta.width,y+meta.height);
 

 if not EnumEnhMetaFile  (Canvas.Handle,Meta.Handle,@EnumCallBack,@MyRect,MyRect) then
  ShowMessage('Failed');}
 end;


you have local variable meta and parameter meta, try to delete local meta
0
 
fara200Author Commented:
Thank you for answering me..

*The  line "meta:tmetafile" does not appear in my original code . It was added here by   mistake!
* the variable  " pen:tcolor"    is a global variable ......
* the " meta:tmetafile"   variable was created here :
    procedure Tmain.FormCreate(Sender: TObject);
     begin
      meta:=tmetafile.create;
     meta.LoadFromFile('c:\word.wmf');
     counter:=0;
    end;


So what the problem could be?

0
 
vadim_tiCommented:
hi, i run your code
in my case it run 5000 without a problem but do not change color
may be send your metafile to
vadim_ti@yahoo.com
0
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

 
vadim_tiCommented:
ok, changed your enumfunction to

function EnumCallBack(HDC: integer;var pHTable: THandleTable;var pEMFR: TEnhMetaRecord;nObj: integer;lpData: pointer): integer; stdcall;
var
  MyPen: Integer;
  mybrush:integer;
  del:boolean;
begin
  del := false;
  mypen := 0; mybrush := 0;
  try
    Case pEMFR.iType of
      EMR_CREATEPEN :  MyPen:=CreatePen(PS_SOLID,10,pencol);
      EMR_CREATEBRUSHINDIRECT :  MyPen:=CreateSolidBrush(pencol);

      else
        PlayEnhMetaFileRecord(HDC, phTable, pEMFR, nObj);
    end;
    result:=1;
  finally
    if mypen <> 0 then
      DeleteObject(SelectObject(HDC, MyPen));
    if mybrush <> 0 then
      DeleteObject(SelectObject(HDC, MyBrush));
  end
end;

now it runs 5000 times and change color (i think in my mf were brush command only)
may be a problem is in another segment of your code, please post full unit source
0
 
fara200Author Commented:
I believe that you should have the same problem as me if you try to  call the drawmetafile procedure  more than  5000 times. for certain metafiles I had to make 9000 calls until the " Problem" could apear .(using  your code)
I still believe that a very little amount of memory is lost after each call.

in case Iam wrong , here is the main unit  of my test program .it should  load a metafile from the location 'c:\word.wmf'. the form1 linked to it should contain   button1 and label1 components.
I hope you returne soon to me !


{***********************}
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  pencol,brushcol:tcolor;
  Form1: TForm1;
  meta:tmetafile;
  function EnumCallBack(HDC: integer;var pHTable: THandleTable;var pEMFR: TEnhMetaRecord;nObj: integer;lpData: pointer): integer; stdcall;
implementation

{$R *.dfm}
procedure drawmetafile(meta:tmetafile;canvas:tcanvas;x,y:integer;apencol,abrushcol:tcolor);
var
  MyRect: TRect;
begin
  pencol:=apencol;
  brushcol:=abrushcol;
  SetRect(MyRect,x,y,x+meta.width,y+meta.height);
  if not EnumEnhMetaFile(Canvas.Handle,Meta.Handle,@EnumCallBack,@MyRect,MyRect) then
   begin
    ShowMessage('Failed');
   end;
end;

function EnumCallBack(HDC: integer;var pHTable: THandleTable;var pEMFR: TEnhMetaRecord;nObj: integer;lpData: pointer): integer; stdcall;
var
  MyPen: Integer;
  mybrush:integer;
  del:boolean;
begin
  del := false;
  mypen := 0; mybrush := 0;
  try
    Case pEMFR.iType of
      EMR_CREATEPEN :  MyPen:=CreatePen(PS_SOLID,10,pencol);
      EMR_CREATEBRUSHINDIRECT:Mybrush:=CreateSolidBrush(brushcol);

    else
      PlayEnhMetaFileRecord(HDC, phTable, pEMFR, nObj);
  end;
  result:=1;
  finally
    if mypen <> 0 then
      DeleteObject(SelectObject(HDC, MyPen));
    if mybrush <> 0 then
      DeleteObject(SelectObject(HDC, MyBrush));
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  time1: TDateTime;
  deltatime:tdatetime;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  i:integer;
  x,y:integer;
 begin
  randomize;
  time1:=time;
  for i:=1 to 5000 do
  begin
   x:=random(clientwidth-meta.width);
   y:=random(clientheight-meta.height);
   caption:=inttostr(i);
   drawmetafile(meta,canvas,x,y,clgreen,clred);
   application.processmessages
  end;
  {action ends}
  deltatime:=time-time1;
  DecodeTime(deltatime, Hour, Min, Sec, MSec);
  caption:=caption+' EXECUTION Time ='+inttostr(sec)+' sec :'+inttostr(msec)+' msec';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
   meta:=tmetafile.create;
   meta.LoadFromFile('c:\word.wmf');
end;
end.
{********************}

0
 
vadim_tiCommented:
with my file and your programm i have 10000 executions in 19sec:297 msec
without any problem
send your metafile
0
 
vadim_tiCommented:
ok, i think i know what is a problem
you cannot delete selected object
 try this version


var
  pencol:tcolor;
  MyPen: HPEN;
  mybrush:HBRUSH;

function EnumCallBack(HDC: integer;var pHTable: THandleTable;var pEMFR: TEnhMetaRecord;nObj: integer;lpData: pointer): integer; stdcall;
begin
    Case pEMFR.iType of
      EMR_CREATEPEN :
        if myPen = 0 then begin
          MyPen:=CreatePen(PS_SOLID,10,pencol);
          SelectObject(HDC, MyPen);
        end;
      EMR_CREATEBRUSHINDIRECT :
        if mybrush = 0 then begin
          mybrush:=CreateSolidBrush(pencol);
          SelectObject(HDC, MyBrush);
        end;

      else
        PlayEnhMetaFileRecord(HDC, phTable, pEMFR, nObj);
    end;
    result:=1;
end;


procedure drawm(meta:tmetafile;canvas:tcanvas;x,y:integer;apencol:tcolor);
var
  MyRect: TRect;
begin
 pencol:=apencol;
 SetRect(MyRect,x,y,x+meta.width,y+meta.height);

 try
   if not EnumEnhMetaFile  (Canvas.Handle,Meta.Handle,@EnumCallBack,@MyRect,MyRect) then
    ShowMessage('Failed');
 finally
    if mypen <> 0 then begin
      SelectObject(Canvas.Handle,GetStockObject(DC_PEN));
      DeleteObject(MyPen);
      myPen := 0;
    end;
    if mybrush <> 0 then begin
      SelectObject(Canvas.Handle,GetStockObject(DC_BRUSH));
      DeleteObject(MyBrush);
      myBrush := 0;
    end;
 end;
end;

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

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