marcocantu.com - Code Repository

Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 09 - Project QDlgApply

Project Structure

QDlgApply.dpr
Main.pas
StyleD.pas
ListD.pas
Main.dfm
StyleD.dfm
ListD.dfm

QDlgApply.dpr

program QDlgApply;

uses
  QForms,
  Main in 'Main.pas' {Form1},
  StyleD in 'StyleD.pas' {StyleDial},
  ListD in 'ListD.pas' {ListDial};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TStyleDial, StyleDial);
  Application.CreateForm(TListDial, ListDial);
  Application.Run;
end.

Main.pas

unit Main;

interface

uses Qt, Classes, QGraphics, QForms, QControls,
     StyleD, ListD, QStdCtrls, QExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    StyleButton: TButton;
    Bevel1: TBevel;
    procedure LabelDoubleClick(Sender: TObject);
    procedure LabelClick(Sender: TObject);
    procedure StyleButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.xfm}

procedure TForm1.LabelDoubleClick(Sender: TObject);
begin
  with ListDial.Listbox1 do
  begin
    // select current the name in the listbox
    ItemIndex := Items.IndexOf ((Sender as TLabel).Caption);
    // show the modal dialog box, checking the return value
    if (ListDial.ShowModal = mrOk) and (ItemIndex >= 0) then
      // if OK, then copy the selected item of the list to the label
      (Sender as TLabel).Caption := Items [ItemIndex];
  end;
end;

procedure TForm1.LabelClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ComponentCount - 1 do
   if (Components[I] is TLabel) and
       (Components[I].Tag = 1) then
     TLabel (Components[I]).Font.Color := clBlack;

  // set the color of the clicked label to red
  (Sender as TLabel).Font.Color := clRed;
end;

procedure TForm1.StyleButtonClick(Sender: TObject);
begin
  // run modeless dialog
  StyleDial.Show;
end;

end.

StyleD.pas

unit StyleD;

interface

uses
  SysUtils, Qt, Classes, QGraphics, QForms,
  QControls, QButtons, QStdCtrls;

type
  TStyleDial = class(TForm)
    ApplyBitBtn: TBitBtn;
    CloseBitBtn: TBitBtn;
    ItalicCheckBox: TCheckBox;
    BoldCheckBox: TCheckBox;
    UnderlineCheckBox: TCheckBox;
    LabelSample: TLabel;
    procedure ApplyBitBtnClick(Sender: TObject);
    procedure CloseBitBtnClick(Sender: TObject);
    procedure ItalicCheckBoxClick(Sender: TObject);
    procedure BoldCheckBoxClick(Sender: TObject);
    procedure UnderlineCheckBoxClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  StyleDial: TStyleDial;

implementation

{$R *.xfm}

{allow access to the main form}
uses Main;

procedure TStyleDial.ApplyBitBtnClick(Sender: TObject);
var
  I: Integer;
begin
  {copy the style from the sample label of the dialog box
  to the five labels of the main form}
  for I := 1 to 5 do
    (Form1.FindComponent ('Label' + IntToStr (I)) as TLabel).
       Font.Style := LabelSample.Font.Style;
end;

procedure TStyleDial.CloseBitBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TStyleDial.ItalicCheckBoxClick(Sender: TObject);
begin
  if ItalicCheckBox.Checked then
    LabelSample.Font.Style := LabelSample.Font.Style + [fsItalic]
  else
    LabelSample.Font.Style := LabelSample.Font.Style - [fsItalic];
end;

procedure TStyleDial.BoldCheckBoxClick(Sender: TObject);
begin
  if BoldCheckBox.Checked then
    LabelSample.Font.Style := LabelSample.Font.Style + [fsBold]
  else
    LabelSample.Font.Style := LabelSample.Font.Style - [fsBold];
end;

procedure TStyleDial.UnderlineCheckBoxClick(Sender: TObject);
begin
  if UnderlineCheckBox.Checked then
    LabelSample.Font.Style := LabelSample.Font.Style + [fsUnderline]
  else
    LabelSample.Font.Style := LabelSample.Font.Style - [fsUnderline];
end;

end.

ListD.pas

unit ListD;

interface

uses Qt, Classes, QGraphics, QForms,
  QControls, QButtons, QStdCtrls;

type
  TListDial = class(TForm)
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ListDial: TListDial;

implementation

{$R *.xfm}

end.

Main.xfm

object Form1: TForm1
  Left = 151
  Top = 137
  Width = 350
  Height = 237
  VertScrollBar.Range = 184
  HorzScrollBar.Range = 337
  ActiveControl = StyleButton
  Caption = 'DlgApply (Modal & modeless dialogs)'
  Color = clButton
  Font.Color = clBlack
  Font.Height = 11
  Font.Name = 'MS Sans Serif'
  Font.Pitch = fpVariable
  Font.Style = []
  Font.Weight = 40
  ParentFont = False
  PixelsPerInch = 96
  TextHeight = 13
  TextWidth = 6
  object Bevel1: TBevel
    Left = 168
    Top = 57
    Width = 169
    Height = 97
  end
  object Label1: TLabel
    Tag = 1
    Left = 27
    Top = 26
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Color = clBlack
    Font.Height = 19
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label2: TLabel
    Tag = 1
    Left = 27
    Top = 60
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Color = clBlack
    Font.Height = 19
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label3: TLabel
    Tag = 1
    Left = 27
    Top = 94
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Color = clBlack
    Font.Height = 19
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label4: TLabel
    Tag = 1
    Left = 27
    Top = 128
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Color = clBlack
    Font.Height = 19
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label5: TLabel
    Tag = 1
    Left = 27
    Top = 162
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Color = clBlack
    Font.Height = 19
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label6: TLabel
    Left = 176
    Top = 65
    Width = 153
    Height = 48
    Alignment = taCenter
    AutoSize = False
    Caption =
       'Double-click on a name to change it or click on the button below' +
      ' to modify text style'
    WordWrap = True
  end
  object StyleButton: TButton
    Left = 220
    Top = 117
    Width = 65
    Height = 21
    Caption = '&Style...'
    TabOrder = 0
    OnClick = StyleButtonClick
  end
end

StyleD.xfm

object StyleDial: TStyleDial
  Left = 333
  Top = 198
  ActiveControl = ApplyBitBtn
  BorderStyle = bsDialog
  Caption = 'Select style'
  ClientHeight = 152
  ClientWidth = 221
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object LabelSample: TLabel
    Left = 4
    Top = 120
    Width = 209
    Height = 22
    Alignment = taCenter
    AutoSize = False
    Caption = 'Sample label'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
  end
  object ApplyBitBtn: TBitBtn
    Left = 128
    Top = 21
    Width = 75
    Height = 28
    Caption = '&Apply'
    Default = True
    ModalResult = 1
    TabOrder = 0
    OnClick = ApplyBitBtnClick
    Glyph.Data = {
      42010000424D4201000000000000760000002800000012000000110000000100
      040000000000CC00000000000000000000001000000000000000000000000000
      80000080000000808000800000008000800080800000C0C0C000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
      3333330000003333344333333333330000003333422433333333330000003334
      2222433333333300000033422222243333333300000034222A22224333333300
      00003222A3A222433333330000003A2A333A222433333300000033A33333A222
      433333000000333333333A222433330000003333333333A22243330000003333
      3333333A222433000000333333333333A222430000003333333333333A224300
      000033333333333333A223000000333333333333333A33000000333333333333
      333333000000}
  end
  object CloseBitBtn: TBitBtn
    Left = 128
    Top = 61
    Width = 75
    Height = 28
    Cancel = True
    Caption = 'Close'
    ModalResult = 2
    TabOrder = 1
    OnClick = CloseBitBtnClick
    Glyph.Data = {
      FE000000424DFE00000000000000760000002800000010000000110000000100
      0400000000008800000000000000000000001000000000000000000000000000
      80000080000000808000800000008000800080800000C0C0C000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
      3333338833333333333339118333339833333911183339118333391111839111
      1833339111181111183333391111111183333333911111183333333331111183
      3333333339111183333333339111118333333339111811183333339111839111
      8333339118333911183333391333339111833333333333391933333333333333
      3333}
  end
  object ItalicCheckBox: TCheckBox
    Left = 24
    Top = 13
    Width = 89
    Height = 25
    Caption = '&Italic'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsItalic]
    ParentFont = False
    TabOrder = 2
    OnClick = ItalicCheckBoxClick
  end
  object BoldCheckBox: TCheckBox
    Left = 24
    Top = 45
    Width = 89
    Height = 25
    Caption = '&Bold'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 3
    OnClick = BoldCheckBoxClick
  end
  object UnderlineCheckBox: TCheckBox
    Left = 24
    Top = 77
    Width = 89
    Height = 25
    Caption = '&Underline'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsUnderline]
    ParentFont = False
    TabOrder = 4
    OnClick = UnderlineCheckBoxClick
  end
end

ListD.xfm

object ListDial: TListDial
  Left = 328
  Top = 272
  Width = 217
  Height = 123
  VertScrollBar.Range = 94
  HorzScrollBar.Range = 211
  ActiveControl = ListBox1
  BorderStyle = �������