Solved

Working with .WMF files in Delphi

Posted on 1997-08-14
2
1,783 Views
Last Modified: 2008-03-17
I think that using .WMF files is the best way to view, scale
print preview. But Delphi can't draw to TImage control when it's contents is metafile.
Does anybody knows how to operate with metafiles during run-time in Delphi (creating, drawing, ....)?
0
Comment
Question by:ASerg
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 

Accepted Solution

by:
boabyte earned 100 total points
ID: 1341434
Gday,
Below is some code which I found when wanting to do the
same thing. Takes a little to get going but its worth
the effort. The code was written by Martin Lapidus.
{
>I need to draw to a Windows metafile. Delphi does not directly support this,
>so I plan to use API calls to create the metafile. Creating a Metafile returns
>a THandle which can be cast to a DC.

>In delphi, how can I use the THandle to get/create a Canvas for drawing?

I've asked a similar question a few days ago but got no response, so
I figured it out myself. Here's the code. (hope it's what you need).
}
unit Metaform;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Image1: TImage;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TMetafileCanvas = class(TCanvas)
  private
    FClipboardHandle: THandle;
    FMetafileHandle: HMetafile;
    FRect: TRect;
  protected
    procedure CreateHandle; override;
    function GetMetafileHandle: HMetafile;
  public
    constructor Create;
    destructor Destroy; override;
    property Rect: TRect read FRect write FRect;
    property MetafileHandle: HMetafile read GetMetafileHandle;
  end;

constructor TMetafileCanvas.Create;
begin
  inherited Create;
  FClipboardHandle := GlobalAlloc(
    GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;

destructor TMetafileCanvas.Destroy;
begin
  DeleteMetafile(CloseMetafile(Handle));
  if Bool(FClipboardHandle) then GlobalFree(FClipboardHandle);
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  inherited Destroy;
end;

procedure TMetafileCanvas.CreateHandle;
var
  MetafileDC: HDC;
begin
  { Create a metafile DC in memory }
  MetafileDC := CreateMetaFile(nil);
  if Bool(MetafileDC) then
  begin
    { Map the top,left corner of the displayed rectangle to the
top,left of the
      device context. Leave a border of 10 logical units around the
picture. }
    with FRect do SetWindowOrg(MetafileDC, Left - 10, Top - 10);
    { Set the extent of the picture with a border of 10 logical units.
}
    with FRect do SetWindowExt(MetafileDC, Right - Left + 20, Bottom -
Top + 20);
    { Play any valid metafile contents to it. }
    if Bool(FMetafileHandle) then
    begin
      PlayMetafile(MetafileDC, FMetafileHandle);
    end;
  end;
  Handle := MetafileDC;
end;

function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
  MetafilePict: PMetafilePict;
  IC: HDC;
  ExtRect: TRect;
begin
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  FMetafileHandle := CloseMetafile(Handle);
  Handle := 0;
  { Prepair metafile for clipboard display. }
  MetafilePict := GlobalLock(FClipboardHandle);
  MetafilePict^.mm := mm_AnIsoTropic;
  IC := CreateIC('DISPLAY', nil, nil, nil);
  SetMapMode(IC, mm_HiMetric);
  ExtRect := FRect;
  DPtoLP(IC, ExtRect, 2);
  DeleteDC(IC);
  MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
  MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
  MetafilePict^.HMF :=  FMetafileHandle;
  GlobalUnlock(FClipboardHandle);
  { I'm giving you this handle, but please do NOT eat it. }
  Result := FClipboardHandle;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  MetafileCanvas : TMetafileCanvas;
begin
  MetafileCanvas := TMetafileCanvas.Create;
  MetafileCanvas.Rect := Rect(0,0,500,500);
  MetafileCanvas.Ellipse(10,10,400,400);
  Image1.Picture.Metafile.LoadFromClipboardFormat(
    cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
  MetafileCanvas.Free;
end;

end.
0
 

Author Comment

by:ASerg
ID: 1341435
Thanx !
Need to try this.
I know that TMetafileCanvas class presents in Borland C++
Builder, may be in Delphi 2 or 3.

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
There's a multitude of different network monitoring solutions out there, and you're probably wondering what makes NetCrunch so special. It's completely agentless, but does let you create an agent, if you desire. It offers powerful scalability …
Michael from AdRem Software explains how to view the most utilized and worst performing nodes in your network, by accessing the Top Charts view in NetCrunch network monitor (https://www.adremsoft.com/). Top Charts is a view in which you can set seve…

696 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