showmsg.~pas

《Kylix程序设计》一书中附带的例程源代码

unit ShowMsg;

interface

uses
  SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls, QExtCtrls;

type
  TFrmMain = class(TForm)
    RadGrpMsgMethod: TRadioGroup;
    RadGrpMsgType: TRadioGroup;
    GrpBoxButtons: TGroupBox;
    Bevel1: TBevel;
    ChkBoxButtonHelp: TCheckBox;
    RadBtnButtonOK: TRadioButton;
    RadBtnButtonOKCancel: TRadioButton;
    RadBtnButtonYesNo: TRadioButton;
    RadBtnButtonYesNoCancel: TRadioButton;
    RadBtnButtonAbortRetryIgnore: TRadioButton;
    LblX: TLabel;
    EdtX: TEdit;
    LblY: TLabel;
    EdtY: TEdit;
    LblMsg: TLabel;
    EdtMsg: TEdit;
    LblCaption: TLabel;
    EdtCaption: TEdit;
    BtnShow: TButton;
    PnlReturn: TPanel;
    LblReturn: TLabel;
    EdtReturn: TEdit;
    RadBtnButtonNone: TRadioButton;
    procedure RadGrpMsgMethodClick(Sender: TObject);
    procedure BtnShowClick(Sender: TObject);
  private
    { Private declarations }
    procedure DoMessageBox();
    procedure DoShowMessage();
    procedure DoShowMessagePos();
    procedure DoShowMessageFmt();
    procedure DoMessageDlg();
    procedure DoMessageDlgPos();
    procedure DoInputBox();
    procedure DoInputQuery();
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.xfm}

procedure TFrmMain.RadGrpMsgMethodClick(Sender: TObject);
begin
  case RadGrpMsgMethod.ItemIndex of
    0: // Invoking TApplication.MessageBox method
    begin
//      DoEnable();
    end;
    1: // Invoking ShowMessage function
    begin
//      DoEnable();
    end;
    2: // Invoking ShowMessagePos function
    begin
//      DoEnable();
    end;
    3: // Invoking ShowMessageFmt function
    begin
//      DoEnable();
    end;
    4: // Invoking MessageDlg function
    begin
//      DoEnable();
    end;
    5: // Invoking MessageDlgPos function
    begin
//      DoEnable();
    end;
    6: // Invoking InputBox function
    begin
//      DoEnable();
    end;
    7: // Invoking InputQuery function
    begin
//      DoEnable();
    end;
  end;
end;

procedure TFrmMain.BtnShowClick(Sender: TObject);
begin
  case RadGrpMsgMethod.ItemIndex of
    0: // Invoking TApplication.MessageBox method
    begin
      DoMessageBox();
    end;
    1: // Invoking ShowMessage function
    begin
      DoShowMessage();
    end;
    2: // Invoking ShowMessagePos function
    begin
      DoShowMessagePos();
    end;
    3: // Invoking ShowMessageFmt function
    begin
      DoShowMessageFmt();
    end;
    4: // Invoking MessageDlg function
    begin
      DoMessageDlg();
    end;
    5: // Invoking MessageDlgPos function
    begin
      DoMessageDlgPos();
    end;
    6: // Invoking InputBox function
    begin
      DoInputBox();
    end;
    7: // Invoking InputQuery function
    begin
      DoInputQuery();
    end;
  end;
end;

procedure TFrmMain.DoMessageBox;
var
  Text: WideString;
  Caption: WideString;
  Buttons: TMessageButtons;
  Style: TMessageStyle;
  Default: TMessageButton;
  Escape: TMessageButton;
  Return: TMessageButton;
begin
  Text := EdtMsg.Text;
  Caption := EdtCaption.Text;
  case RadGrpMsgType.ItemIndex of
    1: // smsInformation
      Style := smsInformation;
    2: // smsWarning
      Style := smsWarning;
    3: // smsCritical
      Style := smsCritical;
    else  // No other enumarated values in TMessageStyle left
      Style := smsInformation;
  end;
  Buttons := [];
  Default := smbOK;
  Escape := smbCancel;
// TApplicaiton.MessageBox must include at least one button
{
  if ChkBoxButtonNone.Checked then
  begin
    Buttons := [];
    Application.MessageBox( Text, Caption, Buttons, Style );
    exit;
  end;
}
// This is default.
  if RadBtnButtonOK.Checked then
  begin
    System.Include( Buttons, smbOK );
  end
  else if RadBtnButtonOKCancel.Checked then
  begin
    System.Include( Buttons, smbOK );
    System.Include( Buttons, smbCancel );
    Default := smbOK;
    Escape := smbCancel;
  end
  else if RadBtnButtonYesNo.Checked then
  begin
    System.Include( Buttons, smbYes );
    System.Include( Buttons, smbNo );
    Default := smbYes;
    Escape := smbNo;
  end
  else if RadBtnButtonYesNoCancel.Checked then
  begin
    System.Include( Buttons, smbYes );
    System.Include( Buttons, smbNo );
    System.Include( Buttons, smbCancel );
    Default := smbYes;
    Escape := smbCancel;
  end
  else if RadBtnButtonAbortRetryIgnore.Checked then
  begin
    System.Include( Buttons, smbAbort );
    System.Include( Buttons, smbRetry );
    System.Include( Buttons, smbIgnore );
    Default := smbAbort;
    Escape := smbIgnore;
  end;
// No Help button.
{
  if ChkBoxButtonHelp.Checked then
    System.Include( Buttons, smbHelp );
}
  Return := Application.MessageBox( Text, Caption, Buttons, Style, Default, Escape );
  case Return of
    smbOK: EdtReturn.Text := 'smbOK';
    smbCancel: EdtReturn.Text := 'smbCancel';
    smbYes: EdtReturn.Text := 'smbYes';
    smbNo: EdtReturn.Text := 'smbNo';
    smbAbort: EdtReturn.Text := 'smbAbort';
    smbRetry: EdtReturn.Text := 'smbRetry';
    smbIgnore: EdtReturn.Text := 'smbIgnore';
  end;
end;

procedure TFrmMain.DoShowMessage;
var
  Msg: WideString;
begin
  Msg := EdtMsg.Text;
  QDialogs.ShowMessage( Msg );
  EdtReturn.Text := 'No returned';
end;

procedure TFrmMain.DoShowMessagePos;
var
  Msg: WideString;
  X, Y: Integer;
begin
  Msg := EdtMsg.Text;
  X := SysUtils.StrToIntDef( EdtX.Text, 350 );
  Y := SysUtils.StrToIntDef( EdtY.Text, 250 );
  QDialogs.ShowMessagePos( Msg, X, Y );
  EdtReturn.Text := 'No returned';
end;

procedure TFrmMain.DoShowMessageFmt;
var
  Msg: WideString;
begin
  Msg := EdtMsg.Text;
  QDialogs.ShowMessageFmt( Msg, [] );
  EdtReturn.Text := 'No returned';
end;

procedure TFrmMain.DoMessageDlg;
var
  Caption: WideString;
  Msg: WideString;
  DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons;
  HelpCtx: Integer;
  DefaultBtn: TMsgDlgBtn;
  Bitmap: TBitmap;
  Return: Integer;
begin
  Caption := EdtCaption.Text;
  Msg := EdtMsg.Text;
  case RadGrpMsgType.ItemIndex of
    0: // mtCustom
      DlgType := mtCustom;
    1: // mtInformation
      DlgType := mtInformation;
    2: // mtWarning
      DlgType := mtWarning;
    3: // mtError
      DlgType := mtError;
    4:  // mtConfirmation
      DlgType := mtConfirmation;
  end;
  Buttons := [];
  DefaultBtn := mbOk;
// GNOME X-Window Server generates dialogs with at least one button
  if RadBtnButtonNone.Checked then
  begin
    System.Include( Buttons, mbNone );
    MessageDlg( Caption, Msg, DlgType, Buttons, 0, mbNone, nil );
    exit;
  end
  else if RadBtnButtonOK.Checked then
  begin
    System.Include( Buttons, mbOk );
  end
  else if RadBtnButtonOKCancel.Checked then
  begin
    System.Include( Buttons, mbOk );
    System.Include( Buttons, mbCancel );
  end
  else if RadBtnButtonYesNo.Checked then
  begin
    System.Include( Buttons, mbYes );
    System.Include( Buttons, mbNo );
    DefaultBtn := mbYes;
  end
  else if RadBtnButtonYesNoCancel.Checked then
  begin
    System.Include( Buttons, mbYes );
    System.Include( Buttons, mbNo );
    System.Include( Buttons, mbCancel );
    DefaultBtn := mbYes;
  end
  else if RadBtnButtonAbortRetryIgnore.Checked then
  begin
    System.Include( Buttons, mbAbort );
    System.Include( Buttons, mbRetry );
    System.Include( Buttons, mbIgnore );
    DefaultBtn := mbAbort;
  end;

// No Help button.
{
  if ChkBoxButtonHelp.Checked then
    System.Include( Buttons, mbHelp );
}
  HelpCtx := 0;
  Bitmap := nil;
  Return := QDialogs.MessageDlg( Caption, Msg, DlgType, Buttons, HelpCtx, DefaultBtn, Bitmap );
  if Return = mrOk then
    EdtReturn.Text := 'mbOk'
  else if Return = mrCancel then
    EdtReturn.Text := 'mbCancel'
  else if Return = mrYes then
    EdtReturn.Text := 'mbYes'
  else if Return = mrNo then
    EdtReturn.Text := 'mbNo'
  else if Return = mrAbort then
    EdtReturn.Text := 'mbAbort'
  else if Return = mrRetry then
    EdtReturn.Text := 'mbRetry'
  else if Return = mrIgnore then
    EdtReturn.Text := 'mbIgnore';
end;

procedure TFrmMain.DoMessageDlgPos;
var
  Msg: WideString;
  DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons;
  HelpCtx: Integer;
  X, Y: Integer;
  DefaultBtn: TMsgDlgBtn;
  Bitmap: TBitmap;
  Return: Integer;
begin
  Msg := EdtMsg.Text;
  case RadGrpMsgType.ItemIndex of
    0: // mtCustom
      DlgType := mtCustom;
    1: // mtInformation
      DlgType := mtInformation;
    2: // mtWarning
      DlgType := mtWarning;
    3: // mtError
      DlgType := mtError;
    4:  // mtConfirmation
      DlgType := mtConfirmation;
  end;
  Buttons := [];
  DefaultBtn := mbOk;
// GNOME X-Window Server generates dialogs with at least one button
  if RadBtnButtonNone.Checked then
  begin
    System.Include( Buttons, mbNone );
    MessageDlg( Caption, Msg, DlgType, Buttons, 0, mbNone, nil );
    exit;
  end
  else if RadBtnButtonOK.Checked then
  begin
    System.Include( Buttons, mbOk );
  end
  else if RadBtnButtonOKCancel.Checked then
  begin
    System.Include( Buttons, mbOk );
    System.Include( Buttons, mbCancel );
  end
  else if RadBtnButtonYesNo.Checked then
  begin
    System.Include( Buttons, mbYes );
    System.Include( Buttons, mbNo );
    DefaultBtn := mbYes;
  end
  else if RadBtnButtonYesNoCancel.Checked then
  begin
    System.Include( Buttons, mbYes );
    System.Include( Buttons, mbNo );
    System.Include( Buttons, mbCancel );
    DefaultBtn := mbYes;
  end
  else if RadBtnButtonAbortRetryIgnore.Checked then
  begin
    System.Include( Buttons, mbAbort );
    System.Include( Buttons, mbRetry );
    System.Include( Buttons, mbIgnore );
    DefaultBtn := mbAbort;
  end;
// No Help button.
{
  if ChkBoxButtonHelp.Checked then
    System.Include( Buttons, mbHelp );
}
  HelpCtx := 0;
  X := SysUtils.StrToIntDef( EdtX.Text, 350 );
  Y := SysUtils.StrToIntDef( EdtY.Text, 250 );
  Bitmap := nil;
  Return := QDialogs.MessageDlgPos( Msg, DlgType, Buttons, HelpCtx, X, Y, DefaultBtn, Bitmap );
  if Return = mrOk then
    EdtReturn.Text := 'mbOk'
  else if Return = mrCancel then
    EdtReturn.Text := 'mbCancel'
  else if Return = mrYes then
    EdtReturn.Text := 'mbYes'
  else if Return = mrNo then
    EdtReturn.Text := 'mbNo'
  else if Return = mrAbort then
    EdtReturn.Text := 'mbAbort'
  else if Return = mrRetry then
    EdtReturn.Text := 'mbRetry'
  else if Return = mrIgnore then
    EdtReturn.Text := 'mbIgnore';
end;

procedure TFrmMain.DoInputBox;
var
  ACaption, APrompt: WideString;
  ADefault, Min, Max, Increment: Integer;
  Return: Integer;
begin
  ACaption := EdtCaption.Text;
  APrompt := EdtMsg.Text;
  ADefault := 0;
  Min := 0;
  Max := 100;
  Increment := 1;
  Return := QDialogs.InputBox( ACaption, APrompt, ADefault, Min, Max, Increment );
  EdtReturn.Text := SysUtils.IntToStr( Return );
end;

procedure TFrmMain.DoInputQuery;
var
  ACaption, APrompt: WideString;
  Value, Min, Max, Increment: Integer;
  Return: Boolean;
begin
  ACaption := EdtCaption.Text;
  APrompt := EdtMsg.Text;
  Value := 0;
  Min := 0;
  Max := 100;
  Increment := 1;
  Return := QDialogs.InputQuery( ACaption, APrompt, Value, Min, Max, Increment );
  if Return then
    EdtReturn.Text := 'mbOk: Value = ' + SysUtils.IntToStr( Value )
  else
    EdtReturn.Text := 'mbCancel';
end;

end.