Home: Code Repository: Mastering Delphi 5

Project WMFDEMO

Project Structure

WMFDEMO.DPR
WMFFORM.PAS
WMFFORM.DFM

program WmfDemo;

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

{$R *.RES}

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

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.

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