Solved

Coloring a metafile   ( delphi 7)

Posted on 2004-10-14
9
1,083 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
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

 
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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Suggested Solutions

Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
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 …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

708 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

18 Experts available now in Live!

Get 1:1 Help Now