Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project BICONS

Project Structure


BICONS.DPR

program Bicons;

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

{$R *.RES}

begin
  Application.HelpFile := 'BIcons.hlp';
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

BICONSF.PAS

unit BIconsF;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    BorderIcons1: TMenuItem;
    SystemMenu1: TMenuItem;
    MinimizeBox1: TMenuItem;
    MaximizeBox1: TMenuItem;
    Help1: TMenuItem;
    btnHelp: TButton;
    procedure SetIcons(Sender: TObject);
    function FormHelp(Command: Word; Data: Integer;
      var CallHelp: Boolean): Boolean;
    procedure btnHelpClick(Sender: TObject);
  private
    { Private declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SetIcons(Sender: TObject);
var
  BorIco: TBorderIcons;
begin
  (Sender as TMenuItem).Checked :=
    not (Sender as TMenuItem).Checked;
  if SystemMenu1.Checked then
    BorIco := [biSystemMenu]
  else
    BorIco := [];
  if MaximizeBox1.Checked then
    Include (BorIco, biMaximize);
  if MinimizeBox1.Checked then
    Include (BorIco, biMinimize);
  if Help1.Checked then
    Include (BorIco, biHelp);
  BorderIcons := BorIco;
end;

function TForm1.FormHelp(Command: Word; Data: Integer;
  var CallHelp: Boolean): Boolean;
begin
  Caption := 'Help requested at ' + TimeToStr (now);
  Result := False;
end;

procedure TForm1.btnHelpClick(Sender: TObject);
begin
  BorderIcons := [biSystemMenu, biHelp];
  SystemMenu1.Checked := True;
  MinimizeBox1.Checked := False;
  MaximizeBox1.Checked := False;
  Help1.Checked := True;
end;

end.

BICONSF.DFM

object Form1: TForm1
  Left = 229
  Top = 115
  Width = 435
  Height = 300
  HelpContext = 101
  BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
  Caption = 'Toggle Border Icons'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  HelpFile = 'bicons.hlp'
  Menu = MainMenu1
  OldCreateOrder = True
  OnHelp = FormHelp
  PixelsPerInch = 96
  TextHeight = 13
  object btnHelp: TButton
    Left = 112
    Top = 16
    Width = 177
    Height = 25
    HelpContext = 102
    Caption = 'Show &Help Button'
    TabOrder = 0
    OnClick = btnHelpClick
  end
  object MainMenu1: TMainMenu
    Left = 24
    Top = 8
    object BorderIcons1: TMenuItem
      Caption = '&Border Icons'
      HelpContext = 10
      object SystemMenu1: TMenuItem
        Caption = '&System Menu'
        Checked = True
        OnClick = SetIcons
      end
      object MinimizeBox1: TMenuItem
        Caption = '&Minimize Box'
        Checked = True
        OnClick = SetIcons
      end
      object MaximizeBox1: TMenuItem
        Caption = 'M&aximize Box'
        Checked = True
        OnClick = SetIcons
      end
      object Help1: TMenuItem
        Caption = '&Help'
        OnClick = SetIcons
      end
    end
  end
end