Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project WMFDEMO

Project Structure


WMFDEMO.DPR

program WmfDemo;

uses
  Forms,
  WmfForm in 'WmfForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

WMFFORM.PAS

unit WmfForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    BtnCreate: TButton;
    PaintBox1: TPaintBox;
    BtnLoad: TButton;
    PaintBox2: TPaintBox;
    cbStretched: TCheckBox;
    procedure BtnCreateClick(Sender: TObject);
    procedure BtnLoadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Wmf: TMetafile;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtnCreateClick(Sender: TObject);
var
  WmfCanvas: TMetafileCanvas;
  X, Y: Integer;
begin
  // create the virtual canvas
  WmfCanvas := TMetafileCanvas.CreateWithComment(
    Wmf, 0, 'Marco', 'Demo metafile');

  try
    // clear the background
    WmfCanvas.Brush.Color := clWhite;
    WmfCanvas.FillRect (WmfCanvas.ClipRect);

    // draws 400 lines
    for X := 1 to 20 do
      for Y := 1 to 20 do
      begin
        WmfCanvas.MoveTo (15 * (X + Random (3)), 15 * (Y + Random (3)));
        WmfCanvas.LineTo (45 * Y, 45 * X);
      end;
  finally
    // end the drawing operation
    WmfCanvas.Free;
  end;

  // show the current drawing and save it
  PaintBox1.Canvas.Draw (0, 0, Wmf);
  Wmf.SaveToFile (ExtractFilePath (
    Application.ExeName) + 'test.emf');
end;

procedure TForm1.BtnLoadClick(Sender: TObject);
begin
  // load the metafile
  Wmf.LoadFromFile (ExtractFilePath (
    Application.ExeName) + 'test.emf');

  // draw or stretch it
  if cbStretched.Checked then
    PaintBox2.Canvas.StretchDraw (PaintBox2.Canvas.ClipRect, Wmf)
  else
    PaintBox2.Canvas.Draw (0, 0, Wmf);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Wmf := TMetafile.Create;
  Wmf.Enhanced := True;
  Randomize;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Wmf.Free;
end;

end.

WMFFORM.DFM

object Form1: TForm1
  Left = 191
  Top = 108
  Width = 723
  Height = 493
  Caption = 'WmfDemo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 8
    Top = 40
    Width = 345
    Height = 417
  end
  object PaintBox2: TPaintBox
    Left = 360
    Top = 40
    Width = 345
    Height = 417
  end
  object BtnCreate: TButton
    Left = 88
    Top = 8
    Width = 265
    Height = 25
    Caption = 'Create, Play, and Save'
    TabOrder = 0
    OnClick = BtnCreateClick
  end
  object BtnLoad: TButton
    Left = 360
    Top = 8
    Width = 233
    Height = 25
    Caption = 'Load and Play'
    TabOrder = 1
    OnClick = BtnLoadClick
  end
  object cbStretched: TCheckBox
    Left = 600
    Top = 11
    Width = 81
    Height = 17
    Caption = 'Streched'
    Checked = True
    State = cbChecked
    TabOrder = 2
  end
end