Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 09 - Project QBicons

Project Structure

QBicons.dpr
program QBicons;

uses
  QForms,
  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, Qt, Classes, QGraphics, QControls,
  QForms, QDialogs, QMenus, QStdCtrls, QTypes;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    BorderIcons1: TMenuItem;
    SystemMenu1: TMenuItem;
    MinimizeBox1: TMenuItem;
    MaximizeBox1: TMenuItem;
    Help1: TMenuItem;
    btnHelp: TButton;
    procedure SetIcons(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    function FormHelp(HelpType: THelpType; HelpContext: THelpContext;
      const HelpKeyword, HelpFile: String; var Handled: Boolean): Boolean;
  private
    { Private declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.xfm}

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;

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

function TForm1.FormHelp(HelpType: THelpType; HelpContext: THelpContext;
  const HelpKeyword, HelpFile: String; var Handled: Boolean): Boolean;
begin
  Caption := 'Help requested at ' + TimeToStr (now);
  Result := False;
end;

end.
BIconsF.xfm
object Form1: TForm1
  HelpContext = 101
  Left = 229
  Top = 115
  Width = 435
  Height = 300
  VertScrollBar.Range = 41
  HorzScrollBar.Range = 289
  ActiveControl = btnHelp
  Caption = 'Toggle Border Icons'
  Color = clButton
  Font.Color = clText
  Font.Height = 11
  Font.Name = 'MS Sans Serif'
  Font.Pitch = fpVariable
  Font.Style = []
  Font.Weight = 40
  HelpFile = 'bicons.hlp'
  Menu = MainMenu1
  ParentFont = False
  OnHelp = FormHelp
  PixelsPerInch = 96
  TextHeight = 13
  TextWidth = 6
  object btnHelp: TButton
    HelpContext = 102
    Left = 112
    Top = 16
    Width = 177
    Height = 25
    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