Solved

Coloring a metafile   ( delphi 7)

Posted on 2004-10-14
9
1,090 Views
Last Modified: 2008-02-01
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
Comment
Question by:fara200
  • 5
  • 2
9 Comments
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12314048
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
 

Author Comment

by:fara200
ID: 12316468
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
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12316760
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 6

Expert Comment

by:vadim_ti
ID: 12316820
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
 

Author Comment

by:fara200
ID: 12320777
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
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12322084
with my file and your programm i have 10000 executions in 19sec:297 msec
without any problem
send your metafile
0
 
LVL 6

Accepted Solution

by:
vadim_ti earned 500 total points
ID: 12322741
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Magic Software info 18 125
VB6 Compile Compatibility Issue 4 90
simplest php form 3 63
Full Screen problem when auto scale IFRAME 2 65
RIA (Rich Internet Application) tools are interactive internet applications which have many of the characteristics of desktop applications. The RIA tools typically deliver output either by the way of a site-specific browser or via browser plug-in. T…
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…

896 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

13 Experts available now in Live!

Get 1:1 Help Now