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 SYSMENU

Project Structure


SYSMENU.DPR

program sysmenu;

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

{$R *.RES}

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

SYSFORM.PAS

unit sysform;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    Undo1: TMenuItem;
    N1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure WMSysCommand (var Msg: TWMSysCommand);
      message wm_SysCommand;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  idSysAbout = 100;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // add a separator and a menu item to the system menu
  AppendMenu (GetSystemMenu (Handle, FALSE),
    MF_SEPARATOR, 0, '');
  AppendMenu (GetSystemMenu (Handle, FALSE),
    MF_STRING, idSysAbout, '&About...');
end;

procedure TForm1.WMSysCommand (var Msg: TWMSysCommand);
var
  Item: TMenuItem;
begin
  // handle a specific command
  if Msg.CmdType = idSysAbout then
    ShowMessage ('Mastering Delphi: SysMenu example');

  // activate standard menu handling code
  Item := MainMenu1.FindItem (Msg.CmdType, fkCommand);
  if Item <> nil then
    Item.Click;

  // default system menu commands
  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  // add a separator
  AppendMenu (GetSystemMenu (Handle, FALSE), MF_SEPARATOR, 0, '');
  // add the main menu to the system menu
  with MainMenu1 do
    for I := 0 to Items.Count - 1 do
      AppendMenu (GetSystemMenu (Self.Handle, FALSE),
        mf_Popup, Items[I].Handle, PChar (Items[I].Caption));
  // disable the button
  Button1.Enabled := False;
end;

procedure TForm1.New1Click(Sender: TObject);
begin
  ShowMessage ('File New menu command');
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  ShowMessage ('File Open menu command');
end;

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

procedure TForm1.Undo1Click(Sender: TObject);
begin
  ShowMessage ('Edit Undo menu command');
end;

procedure TForm1.Cut1Click(Sender: TObject);
begin
  ShowMessage ('Edit Cut menu command');
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  ShowMessage ('Edit Copy menu command');
end;

procedure TForm1.Paste1Click(Sender: TObject);
begin
  ShowMessage ('Edit Paste menu command');
end;

procedure TForm1.About1Click(Sender: TObject);
begin
    ShowMessage ('Mastering Delphi: SysMenu example');
end;

end.

SYSFORM.DFM

object Form1: TForm1
  Left = 245
  Top = 138
  Width = 292
  Height = 119
  Caption = 'SysMenu'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 78
    Top = 34
    Width = 129
    Height = 25
    Caption = 'Copy to System Menu'
    TabOrder = 0
    OnClick = Button1Click
  end
  object MainMenu1: TMainMenu
    Left = 16
    Top = 8
    object File1: TMenuItem
      Caption = '&File'
      object New1: TMenuItem
        Caption = '&New'
        OnClick = New1Click
      end
      object Open1: TMenuItem
        Caption = '&Open...'
        OnClick = Open1Click
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Exit1: TMenuItem
        Caption = '&Exit'
        OnClick = Exit1Click
      end
    end
    object Edit1: TMenuItem
      Caption = '&Edit'
      object Undo1: TMenuItem
        Caption = '&Undo'
        OnClick = Undo1Click
      end
      object N1: TMenuItem
        Caption = '-'
      end
      object Cut1: TMenuItem
        Caption = 'Cu&t'
        OnClick = Cut1Click
      end
      object Copy1: TMenuItem
        Caption = '&Copy'
        OnClick = Copy1Click
      end
      object Paste1: TMenuItem
        Caption = '&Paste'
        OnClick = Paste1Click
      end
    end
    object Help1: TMenuItem
      Caption = 'Help'
      object About1: TMenuItem
        Caption = '&About...'
        OnClick = About1Click
      end
    end
  end
end