marcocantu.com - Code Repository

Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 20 - Project Olecont

Project Structure

Olecont.dpr
OleForm.pas
OleForm.dfm

Olecont.dpr

program Olecont;

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

{$R *.RES}

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

OleForm.pas

unit OleForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ExtCtrls, StdCtrls, OleCtnrs, Buttons;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    SaveAs1: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Edit1: TMenuItem;
    Object1: TMenuItem;
    N3: TMenuItem;
    PasteSpecial1: TMenuItem;
    Paste1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    ToolbarPanel: TPanel;
    NewSpeedButton: TSpeedButton;
    CutSpeedButton: TSpeedButton;
    CopySpeedButton: TSpeedButton;
    PasteSpeedButton: TSpeedButton;
    AboutSpeedButton: TSpeedButton;
    MainPanel: TPanel;
    OleContainer1: TOleContainer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure Exit1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure PasteSpecial1Click(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Object1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
  private
    { Private declarations }
    procedure UpdateUI;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.New1Click(Sender: TObject);
begin
  if OleContainer1.InsertObjectDialog then
    OleContainer1.DoVerb (
      OleContainer1.PrimaryVerb);
  UpdateUI;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  MessageDlg ('Sample OLE container' +
    #13'From the book "Mastering Delphi"',
    mtInformation, [mbOk], 0);
end;

procedure TForm1.Paste1Click(Sender: TObject);
begin
  OleContainer1.Paste;
  UpdateUI;
end;

procedure TForm1.PasteSpecial1Click(Sender: TObject);
begin
  OleContainer1.PasteSpecialDialog;
  UpdateUI;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
  UpdateUI;
end;

procedure TForm1.UpdateUI;
begin
  Cut1.Enabled := OleContainer1.State <> osEmpty;
  Copy1.Enabled := OleContainer1.State <> osEmpty;
  Object1.Enabled := OleContainer1.State <> osEmpty;
  Paste1.Enabled := OleContainer1.CanPaste;
  PasteSpecial1.Enabled := OleContainer1.CanPaste;
  PasteSpeedButton.Enabled := Paste1.Enabled;
  CutSpeedButton.Enabled := Cut1.Enabled;
  CopySpeedButton.Enabled := Copy1.Enabled;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  OleContainer1.Copy;
  UpdateUI;
end;

procedure TForm1.Cut1Click(Sender: TObject);
begin
  OleContainer1.Copy;
  OleContainer1.Destroy;
  UpdateUI;
end;

procedure TForm1.Object1Click(Sender: TObject);
begin
  OleContainer1.ObjectPropertiesDialog;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    OleContainer1.LoadFromFile (OpenDialog1.FileName);
  UpdateUI;
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    OleContainer1.SaveToFile (SaveDialog1.FileName);
end;


end.

OleForm.dfm

object Form1: TForm1
  Left = 191
  Top = 107
  Width = 464
  Height = 337
  Caption = 'Minimal OLE Container'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object ToolbarPanel: TPanel
    Left = 0
    Top = 35
    Width = 456
    Height = 33
    Align = alTop
    TabOrder = 0
    object NewSpeedButton: TSpeedButton
      Left = 8
      Top = 3
      Width = 25
      Height = 25
      HelpType = htKeyword
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333B333
        333B33FF33337F3333F73BB3777BB7777BB3377FFFF77FFFF77333B000000000
        0B3333777777777777333330FFFFFFFF07333337F33333337F333330FFFFFFFF
        07333337F33333337F333330FFFFFFFF07333337F33333337F333330FFFFFFFF
        07333FF7F33333337FFFBBB0FFFFFFFF0BB37777F3333333777F3BB0FFFFFFFF
        0BBB3777F3333FFF77773330FFFF000003333337F333777773333330FFFF0FF0
        33333337F3337F37F3333330FFFF0F0B33333337F3337F77FF333330FFFF003B
        B3333337FFFF77377FF333B000000333BB33337777777F3377FF3BB3333BB333
        3BB33773333773333773B333333B3333333B7333333733333337}
      NumGlyphs = 2
      OnClick = New1Click
    end
    object CutSpeedButton: TSpeedButton
      Left = 40
      Top = 3
      Width = 25
      Height = 25
      HelpType = htKeyword
      Enabled = False
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
        3333333333333333FF3333333333333003333333333333377F33333333333307
        733333FFF333337773333C003333307733333777FF333777FFFFC0CC03330770
        000077777FF377777777C033C03077FFFFF077FF77F777FFFFF7CC00000F7777
        777077777777777777773CCCCC00000000003777777777777777333330030FFF
        FFF03333F77F7F3FF3F7333C0C030F00F0F03337777F7F77373733C03C030FFF
        FFF03377F77F7F3F333733C03C030F0FFFF03377F7737F733FF733C000330FFF
        0000337777F37F3F7777333CCC330F0F0FF0333777337F737F37333333330FFF
        0F03333333337FFF7F7333333333000000333333333377777733}
      NumGlyphs = 2
      OnClick = Cut1Click
    end
    object CopySpeedButton: TSpeedButton
      Left = 64
      Top = 3
      Width = 25
      Height = 25
      HelpType = htKeyword
      Enabled = False
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF003333330B7FFF
        FFB0333333777F3333773333330B7FFFFFB0333333777F3333773333330B7FFF
        FFB0333333777F3333773333330B7FFFFFB03FFFFF777FFFFF77000000000077
        007077777777777777770FFFFFFFF00077B07F33333337FFFF770FFFFFFFF000
        7BB07F3FF3FFF77FF7770F00F000F00090077F77377737777F770FFFFFFFF039
        99337F3FFFF3F7F777FF0F0000F0F09999937F7777373777777F0FFFFFFFF999
        99997F3FF3FFF77777770F00F000003999337F773777773777F30FFFF0FF0339
        99337F3FF7F3733777F30F08F0F0337999337F7737F73F7777330FFFF0039999
        93337FFFF7737777733300000033333333337777773333333333}
      NumGlyphs = 2
      OnClick = Copy1Click
    end
    object PasteSpeedButton: TSpeedButton
      Left = 88
      Top = 3
      Width = 25
      Height = 25
      HelpType = htKeyword
      Enabled = False
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF003333330FFFFF
        FFF03333337F3FFFF3F73333330F0000F0F03333337F777737373333330FFFFF
        FFF033FFFF7FFF33FFF77000000007F00000377777777FF777770BBBBBBBB0F0
        FF037777777777F7F3730B77777BB0F0F0337777777777F7F7330B7FFFFFB0F0
        0333777F333377F77F330B7FFFFFB0009333777F333377777FF30B7FFFFFB039
        9933777F333377F777FF0B7FFFFFB0999993777F33337777777F0B7FFFFFB999
        9999777F3333777777770B7FFFFFB0399933777FFFFF77F777F3070077007039
        99337777777777F777F30B770077B039993377FFFFFF77F777330BB7007BB999
        93337777FF777777733370000000073333333777777773333333}
      NumGlyphs = 2
      OnClick = Paste1Click
    end
    object AboutSpeedButton: TSpeedButton
      Left = 120
      Top = 3
      Width = 25
      Height = 25
      HelpType = htKeyword
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
        3333333333FFFFF3333333333F797F3333333333F737373FF333333BFB999BFB
        33333337737773773F3333BFBF797FBFB33333733337333373F33BFBFBFBFBFB
        FB3337F33333F33337F33FBFBFB9BFBFBF3337333337F333373FFBFBFBF97BFB
        FBF37F333337FF33337FBFBFBFB99FBFBFB37F3333377FF3337FFBFBFBFB99FB
        FBF37F33333377FF337FBFBF77BF799FBFB37F333FF3377F337FFBFB99FB799B
        FBF373F377F3377F33733FBF997F799FBF3337F377FFF77337F33BFBF99999FB
        FB33373F37777733373333BFBF999FBFB3333373FF77733F7333333BFBFBFBFB
        3333333773FFFF77333333333FBFBF3333333333377777333333}
      NumGlyphs = 2
      OnClick = About1Click
    end
  end
  object MainPanel: TPanel
    Left = 0
    Top = 68
    Width = 456
    Height = 223
    Align = alClient
    TabOrder = 1
    object OleContainer1: TOleContainer
      Left = 1
      Top = 1
      Width = 454
      Height = 221
      Align = alClient
      BorderStyle = bsNone
      Caption = 'OleContainer1'
      Ctl3D = False
      ParentCtl3D = False
      TabOrder = 0
    end
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 456
    Height = 35
    Align = alTop
    Locked = True
    TabOrder = 2
    object BitBtn1: TBitBtn
      Left = 6
      Top = 5
      Width = 75
      Height = 25
      Caption = '&New...'
      TabOrder = 0
      OnClick = New1Click
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333B333
        333B33FF33337F3333F73BB3777BB7777BB3377FFFF77FFFF77333B000000000
        0B3333777777777777333330FFFFFFFF07333337F33333337F333330FFFFFFFF
        07333337F33333337F333330FFFFFFFF07333337F33333337F333330FFFFFFFF
        07333FF7F33333337FFFBBB0FFFFFFFF0BB37777F3333333777F3BB0FFFFFFFF
        0BBB3777F3333FFF77773330FFFF000003333337F333777773333330FFFF0FF0
        33333337F3337F37F3333330FFFF0F0B33333337F3337F77FF333330FFFF003B
        B3333337FFFF77377FF333B000000333BB33337777777F3377FF3BB3333BB333
        3BB33773333773333773B333333B3333333B7333333733333337}
      NumGlyphs = 2
    end
    object BitBtn2: TBitBtn
      Left = 86
      Top = 5
      Width = 75
      Height = 25
      Caption = '&Open...'
      TabOrder = 1
      OnClick = Open1Click
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333B333
        333B33FF33337F3333F73BB3777BB7777BB3377FFFF77FFFF77333B000000000
        0B3333777777777777333330FFFFFFFF07333337F33333337F333330FFFFFFFF
        07333337F3FF3FFF7F333330F00F000F07333337F77377737F333330FFFFFFFF
        07333FF7F3FFFF3F7FFFBBB0F0000F0F0BB37777F7777373777F3BB0FFFFFFFF
        0BBB3777F3FF3FFF77773330F00F000003333337F773777773333330FFFF0FF0
        33333337F3FF7F37F3333330F08F0F0B33333337F7737F77FF333330FFFF003B
        B3333337FFFF77377FF333B000000333BB33337777777F3377FF3BB3333BB333
        3BB33773333773333773B333333B3333333B7333333733333337}
      NumGlyphs = 2
    end
    object BitBtn3: TBitBtn
      Left = 168
      Top = 5
      Width = 75
      Height = 25
      Caption = '&Save as...'
      TabOrder = 2
      OnClick = SaveAs1Click
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333330070
        7700333333337777777733333333008088003333333377F73377333333330088
        88003333333377FFFF7733333333000000003FFFFFFF77777777000000000000
        000077777777777777770FFFFFFF0FFFFFF07F3333337F3333370FFFFFFF0FFF
        FFF07F3FF3FF7FFFFFF70F00F0080CCC9CC07F773773777777770FFFFFFFF039
        99337F3FFFF3F7F777F30F0000F0F09999937F7777373777777F0FFFFFFFF999
        99997F3FF3FFF77777770F00F000003999337F773777773777F30FFFF0FF0339
        99337F3FF7F3733777F30F08F0F0337999337F7737F73F7777330FFFF0039999
        93337FFFF7737777733300000033333333337777773333333333}
      NumGlyphs = 2
    end
  end
  object MainMenu1: TMainMenu
    Left = 400
    Top = 8
    object File1: TMenuItem
      Caption = '&File'
      object New1: TMenuItem
        Caption = '&New...'
        OnClick = New1Click
      end
      object Open1: TMenuItem
        Caption = '&Open...'
        OnClick = Open1Click
      end
      object SaveAs1: TMenuItem
        Caption = 'Save &As...'
        OnClick = SaveAs1Click
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Exit1: TMenuItem
        Caption = 'E&xit'
        OnClick = Exit1Click
      end
    end
    object Edit1: TMenuItem
      Caption = '&Edit'
      GroupIndex = 1
      OnClick = Edit1Click
      object Cut1: TMenuItem
        Caption = 'Cu&t'
        ShortCut = 16472
        OnClick = Cut1Click
      end
      object Copy1: TMenuItem
        Caption = '&Copy'
        ShortCut = 16451
        OnClick = Copy1Click
      end
      object Paste1: TMenuItem
        Caption = '&Paste'
        ShortCut = 16470
        OnClick = Paste1Click
      end
      object PasteSpecial1: TMenuItem
        Caption = 'Paste &Special...'
        OnClick = PasteSpecial1Click
      end
      object N3: TMenuItem
        Caption = '-'
      end
      object Object1: TMenuItem
        Caption = '&Object Properties...'
        OnClick = Object1Click
      end
    end
    object Help1: TMenuItem
      Caption = '&Help'
      GroupIndex = 5
      object About1: TMenuItem
        Caption = '&About...'
        OnClick = About1Click
      end
    end
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Demo OLE Files (*.dol)|*.dol|Any file (*.*)|*.*'
    Left = 400
    Top = 57
  end
  object SaveDialog1: TSaveDialog
    Filter = 'Demo OLE Files (*.dol)|*.dol|Any file (*.*)|*.*'
    Left = 400
    Top = 113
  end
end