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 DLGAPPLY

Project Structure


DLGAPPLY.DPR

program DlgApply;

uses
  Forms,
  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 Windows, Classes, Graphics, Forms, Controls,
     StyleD, ListD, StdCtrls, ExtCtrls;

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 *.DFM}

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, Windows, Classes, Graphics, Forms,
  Controls, Buttons, StdCtrls;

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 *.DFM}

{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 Windows, Classes, Graphics, Forms,
  Controls, Buttons, StdCtrls;

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

var
  ListDial: TListDial;

implementation

{$R *.DFM}

end.

MAIN.DFM

object Form1: TForm1
  Left = 151
  Top = 137
  Width = 350
  Height = 237
  ActiveControl = StyleButton
  Caption = 'DlgApply (Modal & modeless dialogs)'
  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 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.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label2: TLabel
    Tag = 1
    Left = 27
    Top = 60
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label3: TLabel
    Tag = 1
    Left = 27
    Top = 94
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label4: TLabel
    Tag = 1
    Left = 27
    Top = 128
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnClick = LabelClick
    OnDblClick = LabelDoubleClick
  end
  object Label5: TLabel
    Tag = 1
    Left = 27
    Top = 162
    Width = 50
    Height = 22
    Caption = 'Name'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    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.DFM

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.DFM

object ListDial: TListDial
  Left = 328
  Top = 272
  ActiveControl = ListBox1
  BorderStyle = bsDialog
  Caption = 'Select a name'
  ClientHeight = 123
  ClientWidth = 217
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 129
    Height = 123
    Align = alLeft
    ItemHeight = 13
    Items.Strings = (
      'Bob'
      'Cindy'
      'Jane'
      'Jeff'
      'John'
      'Julia'
      'Mark'
      'Martha'
      'Mary'
      'Micheal'
      'Nan'
      'Paul'
      'Robert'
      'Roberta'
      'Steve')
    Sorted = True
    TabOrder = 0
  end
  object BitBtn1: TBitBtn
    Left = 136
    Top = 29
    Width = 75
    Height = 28
    TabOrder = 1
    Kind = bkOK
  end
  object BitBtn2: TBitBtn
    Left = 136
    Top = 66
    Width = 75
    Height = 28
    TabOrder = 2
    Kind = bkCancel
  end
end