Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 09 - Project MbParade

Project Structure

MbParade.dpr
program Mbparade;

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

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
MbForm.pas
unit MBForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Spin, Buttons;

type
  TForm1 = class(TForm)
    ButtonMessageDlg: TButton;
    ButtonShowMessage: TButton;
    ButtonShowMessagePos: TButton;
    GroupBox1: TGroupBox;
    RadioWarning: TRadioButton;
    RadioError: TRadioButton;
    RadioInformation: TRadioButton;
    RadioConfirmation: TRadioButton;
    Bevel1: TBevel;
    Edit1: TEdit;
    Label1: TLabel;
    RadioCustom: TRadioButton;
    GroupBox2: TGroupBox;
    RadioOK: TRadioButton;
    RadioOKCancel: TRadioButton;
    RadioYesNo: TRadioButton;
    RadioYesNoCancel: TRadioButton;
    CheckHelp: TCheckBox;
    ButtonMsgDlgPos: TButton;
    SpinY: TSpinEdit;
    SpinX: TSpinEdit;
    Label2: TLabel;
    Label3: TLabel;
    ButtonInputBox: TButton;
    ButtonInputQuery: TButton;
    Bevel2: TBevel;
    EditCaption: TEdit;
    EditPrompt: TEdit;
    EditValue: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ButtonQuit: TButton;
    procedure ButtonMessageDlgClick(Sender: TObject);
    procedure RadioWarningClick(Sender: TObject);
    procedure RadioErrorClick(Sender: TObject);
    procedure RadioInformationClick(Sender: TObject);
    procedure RadioConfirmationClick(Sender: TObject);
    procedure RadioCustomClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioOKClick(Sender: TObject);
    procedure RadioOKCancelClick(Sender: TObject);
    procedure RadioYesNoClick(Sender: TObject);
    procedure RadioYesNoCancelClick(Sender: TObject);
    procedure ButtonMsgDlgPosClick(Sender: TObject);
    procedure ButtonShowMessageClick(Sender: TObject);
    procedure ButtonShowMessagePosClick(Sender: TObject);
    procedure ButtonInputBoxClick(Sender: TObject);
    procedure ButtonInputQueryClick(Sender: TObject);
    procedure ButtonQuitClick(Sender: TObject);
  private
    { Private declarations }
    MsgDlgType: TMsgDlgType;
    MsgButtons: TMsgDlgButtons;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MsgDlgType := mtWarning;
  MsgButtons := [mbOk];
end;

procedure TForm1.ButtonMessageDlgClick(Sender: TObject);
begin
  if CheckHelp.Checked then
    Include (MsgButtons, mbHelp);
  MessageDlg (Edit1.Text, MsgDlgType, MsgButtons, 0);
end;

procedure TForm1.RadioWarningClick(Sender: TObject);
begin
  MsgDlgType := mtWarning;
end;

procedure TForm1.RadioErrorClick(Sender: TObject);
begin
  MsgDlgType := mtError;
end;

procedure TForm1.RadioInformationClick(Sender: TObject);
begin
  MsgDlgType := mtInformation;
end;

procedure TForm1.RadioConfirmationClick(Sender: TObject);
begin
  MsgDlgType := mtConfirmation;
end;

procedure TForm1.RadioCustomClick(Sender: TObject);
begin
  MsgDlgType := mtCustom;
end;

procedure TForm1.RadioOKClick(Sender: TObject);
begin
  MsgButtons := [mbOk];
end;

procedure TForm1.RadioOKCancelClick(Sender: TObject);
begin
  MsgButtons := mbOkCancel;
end;

procedure TForm1.RadioYesNoClick(Sender: TObject);
begin
  MsgButtons := [mbYes, mbNo];
end;

procedure TForm1.RadioYesNoCancelClick(Sender: TObject);
begin
    MsgButtons := mbYesNoCancel;
end;

procedure TForm1.ButtonMsgDlgPosClick(Sender: TObject);
begin
  if CheckHelp.Checked then
    Include (MsgButtons, mbHelp);
  MessageDlgPos (Edit1.Text, MsgDlgType, MsgButtons,
    0, SpinX.Value, SpinY.Value);
end;

procedure TForm1.ButtonShowMessageClick(Sender: TObject);
begin
  ShowMessage (Edit1.Text);
end;

procedure TForm1.ButtonShowMessagePosClick(Sender: TObject);
begin
  ShowMessagePos (Edit1.Text, SpinX.Value, SpinY.Value);
end;

procedure TForm1.ButtonInputBoxClick(Sender: TObject);
begin
  EditValue.Text := InputBox (EditCaption.Text,
    EditPrompt.Text, EditValue.Text);
end;

procedure TForm1.ButtonInputQueryClick(Sender: TObject);
var
  Text: String;
begin
  Text := EditValue.Text;
  if InputQuery (EditCaption.Text, EditPrompt.Text, Text) then
    EditValue.Text := Text;
end;

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

end.
MbForm.dfm
object Form1: TForm1
  Left = 177
  Top = 139
  Width = 534
  Height = 379
  ActiveControl = ButtonMessageDlg
  Caption = 'Message Box Parade'
  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 Bevel1: TBevel
    Left = 8
    Top = 8
    Width = 505
    Height = 217
  end
  object Label1: TLabel
    Left = 216
    Top = 192
    Width = 46
    Height = 13
    Caption = 'M&essage:'
    FocusControl = Edit1
  end
  object Label2: TLabel
    Left = 21
    Top = 104
    Width = 10
    Height = 13
    Caption = '&X:'
    FocusControl = SpinX
  end
  object Label3: TLabel
    Left = 117
    Top = 104
    Width = 10
    Height = 13
    Caption = '&Y:'
    FocusControl = SpinY
  end
  object Bevel2: TBevel
    Left = 8
    Top = 232
    Width = 441
    Height = 105
  end
  object Label4: TLabel
    Left = 194
    Top = 250
    Width = 39
    Height = 13
    Alignment = taRightJustify
    Caption = '&Caption:'
    FocusControl = EditCaption
  end
  object Label5: TLabel
    Left = 197
    Top = 279
    Width = 36
    Height = 13
    Alignment = taRightJustify
    Caption = '&Prompt:'
    FocusControl = EditPrompt
  end
  object Label6: TLabel
    Left = 203
    Top = 308
    Width = 30
    Height = 13
    Alignment = taRightJustify
    Caption = '&Value:'
    FocusControl = EditValue
  end
  object ButtonMessageDlg: TButton
    Left = 16
    Top = 16
    Width = 137
    Height = 33
    Caption = '&MessageDlg...'
    Default = True
    TabOrder = 0
    OnClick = ButtonMessageDlgClick
  end
  object ButtonShowMessage: TButton
    Left = 16
    Top = 176
    Width = 137
    Height = 33
    Caption = 'Sho&wMessage...'
    TabOrder = 1
    OnClick = ButtonShowMessageClick
  end
  object ButtonShowMessagePos: TButton
    Left = 16
    Top = 136
    Width = 137
    Height = 33
    Caption = '&ShowMessagePos...'
    TabOrder = 2
    OnClick = ButtonShowMessagePosClick
  end
  object GroupBox1: TGroupBox
    Left = 216
    Top = 16
    Width = 121
    Height = 161
    Caption = 'Message &Type'
    TabOrder = 3
    object RadioWarning: TRadioButton
      Left = 8
      Top = 24
      Width = 105
      Height = 17
      Caption = 'Warning'
      Checked = True
      TabOrder = 0
      TabStop = True
      OnClick = RadioWarningClick
    end
    object RadioError: TRadioButton
      Left = 8
      Top = 50
      Width = 105
      Height = 17
      Caption = 'Error'
      TabOrder = 1
      OnClick = RadioErrorClick
    end
    object RadioInformation: TRadioButton
      Left = 8
      Top = 76
      Width = 105
      Height = 17
      Caption = 'Information'
      TabOrder = 2
      OnClick = RadioInformationClick
    end
    object RadioConfirmation: TRadioButton
      Left = 8
      Top = 102
      Width = 105
      Height = 17
      Caption = 'Confirmation'
      TabOrder = 3
      OnClick = RadioConfirmationClick
    end
    object RadioCustom: TRadioButton
      Left = 8
      Top = 128
      Width = 105
      Height = 17
      Caption = 'Custom'
      TabOrder = 4
      OnClick = RadioCustomClick
    end
  end
  object Edit1: TEdit
    Left = 280
    Top = 188
    Width = 217
    Height = 21
    TabOrder = 4
    Text = 'Hello'
  end
  object GroupBox2: TGroupBox
    Left = 352
    Top = 16
    Width = 145
    Height = 137
    Caption = '&Buttons'
    TabOrder = 5
    object RadioOK: TRadioButton
      Left = 8
      Top = 24
      Width = 129
      Height = 17
      Caption = 'OK'
      Checked = True
      TabOrder = 0
      TabStop = True
      OnClick = RadioOKClick
    end
    object RadioOKCancel: TRadioButton
      Left = 8
      Top = 51
      Width = 129
      Height = 17
      Caption = 'OK Cancel'
      TabOrder = 1
      OnClick = RadioOKCancelClick
    end
    object RadioYesNo: TRadioButton
      Left = 8
      Top = 77
      Width = 129
      Height = 17
      Caption = 'Yes No'
      TabOrder = 2
      OnClick = RadioYesNoClick
    end
    object RadioYesNoCancel: TRadioButton
      Left = 8
      Top = 104
      Width = 129
      Height = 17
      Caption = 'Yes No Cancel'
      TabOrder = 3
      OnClick = RadioYesNoCancelClick
    end
  end
  object CheckHelp: TCheckBox
    Left = 360
    Top = 160
    Width = 129
    Height = 17
    Caption = '&Help Button'
    TabOrder = 6
  end
  object ButtonMsgDlgPos: TButton
    Left = 16
    Top = 56
    Width = 137
    Height = 33
    Caption = 'MsgDlgP&os...'
    TabOrder = 7
    OnClick = ButtonMsgDlgPosClick
  end
  object SpinY: TSpinEdit
    Left = 141
    Top = 101
    Width = 49
    Height = 22
    Increment = 10
    MaxLength = 3
    MaxValue = 400
    MinValue = 1
    TabOrder = 8
    Value = 100
  end
  object SpinX: TSpinEdit
    Left = 45
    Top = 101
    Width = 49
    Height = 22
    Increment = 10
    MaxLength = 3
    MaxValue = 500
    MinValue = 1
    TabOrder = 9
    Value = 100
  end
  object ButtonInputBox: TButton
    Left = 16
    Top = 248
    Width = 137
    Height = 33
    Caption = '&InputBox...'
    TabOrder = 10
    OnClick = ButtonInputBoxClick
  end
  object ButtonInputQuery: TButton
    Left = 16
    Top = 288
    Width = 137
    Height = 33
    Caption = 'Input&Query...'
    TabOrder = 11
    OnClick = ButtonInputQueryClick
  end
  object EditCaption: TEdit
    Left = 240
    Top = 247
    Width = 193
    Height = 21
    TabOrder = 12
    Text = 'User Info '
  end
  object EditPrompt: TEdit
    Left = 240
    Top = 276
    Width = 193
    Height = 21
    TabOrder = 13
    Text = 'What''s your name?'
     end
  object EditValue: TEdit
    Left = 240
    Top = 304
    Width = 193
    Height = 21
    TabOrder = 14
    Text = 'Paul'
  end
  object ButtonQuit: TButton
    Left = 456
    Top = 272
    Width = 57
    Height = 33
    Caption = 'Q&uit'
    TabOrder = 15
    OnClick = ButtonQuitClick
  end
end