umessageboxconstructorform.pas

Delphi函数工厂。。。。。。。。。。。。。

{-----------------------------------------------------------------------------}
{
{   单元名:  uMessageBoxConstructorForm
{
{   作者:    阿文([e-mail]),杨勇([e-mail])
{
{   描述:    本单元中封装了模块化的窗体模块 TMessageBoxContructorForm ，并用一个
{            从 TCustomModuleDialog 类继承的 TMessageBoxDialog 封装了 TMessageBoxContructorForm
{            调用简单。直接使用 TMessageBoxDialog.Execute 方法即可弹出窗口。
{
{   版本：   V 1.0
{
{   历史:    2003-04-28  V1.0 阿文创建本单元 V1.0 版。
{
{   使用方法：
{            创建一个 TMessageBoxDialog 的实例，然后调用Execute方法即可：
{            var
{              MessageBoxDialog: TMessageBoxDialog;
{            begin
{              MessageBoxDialog := TMessageBoxDialog.Create(Application);
{              try
{                MessageBoxDialog.Execute; // 这一句将显示模块窗口
{              finally
{                 MessageBoxDialog.Free;
{              end;
{            end;
{
{            注意：任何情况下，不要直接使用 TMessageBoxContructorForm 类
{            这样才能保证完全遵守封装的原则。
{
{-----------------------------------------------------------------------------}
unit uMessageBoxConstructorForm;

//{$I directives.inc}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uCustomModuleForm, StdCtrls, ExtCtrls, ComCtrls, Spin, CheckLst;

type

  TMessageBoxDialog = class; // Forward declare the TMessageBoxDialog class.

{ =================================== }
{ TMessageBoxConstructorForm 声明部分 }
{ =================================== }
  TMessageBoxConstructorForm = class(TCustomModuleForm)
    PageControl: TPageControl;
    tsMessageBox: TTabSheet;
    tsMessageDlg: TTabSheet;
    lblMessageMB: TLabel;
    lblTitleMB: TLabel;
    gbIconsMB: TGroupBox;
    imgErrorMB: TImage;
    imgWarningMB: TImage;
    imgQuestionMB: TImage;
    imgInformationMB: TImage;
    rbNoneMB: TRadioButton;
    rbErrorMB: TRadioButton;
    rbWarningMB: TRadioButton;
    rbQuestionMB: TRadioButton;
    rbInformationMB: TRadioButton;
    cbTitleMB: TComboBox;
    gbButtonsMB: TGroupBox;
    rbOKMB: TRadioButton;
    rbOKCancelMB: TRadioButton;
    rbAbortRetryIgnoreMB: TRadioButton;
    rbYesNoMB: TRadioButton;
    rbRetryCancelMB: TRadioButton;
    rbYesNoCancelMB: TRadioButton;
    mmCodeMB: TMemo;
    mmMessageMB: TMemo;
    lblMessageMD: TLabel;
    mmMessageMD: TMemo;
    mmCodeMD: TMemo;
    gbIconsMD: TGroupBox;
    imgWarningMD: TImage;
    imgInformationMD: TImage;
    imgErrorMD: TImage;
    imgConfirmation: TImage;
    rbWarningMD: TRadioButton;
    rbErrorMD: TRadioButton;
    rbInformationMD: TRadioButton;
    rbConfirmationMD: TRadioButton;
    rbCustomMD: TRadioButton;
    gbButtonsMD: TGroupBox;
    lblHelpContext: TLabel;
    seHelpContextMD: TSpinEdit;
    cbOKMD: TCheckBox;
    cbCancelMD: TCheckBox;
    cbYesMD: TCheckBox;
    cbNoMD: TCheckBox;
    cbAbortMD: TCheckBox;
    cbRetryMD: TCheckBox;
    cbIgnoreMD: TCheckBox;
    cbCreateCaseStatementsMB: TCheckBox;
    cbAllMD: TCheckBox;
    cbYesToAllMD: TCheckBox;
    cbNoToAllMD: TCheckBox;
    cbHelpMD: TCheckBox;
    pnlResultMD: TPanel;
    cbGenerateResultCodeMD: TCheckBox;
    cbMrOKMD: TCheckBox;
    cbMrCancelMD: TCheckBox;
    cbMrYesMD: TCheckBox;
    cbMrNoMD: TCheckBox;
    cbMrAbortMD: TCheckBox;
    cbMrRetryMD: TCheckBox;
    cbMrIgnoreMD: TCheckBox;
    cbMrAllMD: TCheckBox;
    cbMrYesToAllMD: TCheckBox;
    cbMrNoToAllMD: TCheckBox;
    cbMrNoneMD: TCheckBox;
    btnTestMessage: TButton;
    btnCopy: TButton;
    gbDefaultBtnMB: TGroupBox;
    rbDefBtn1: TRadioButton;
    rbDefBtn2: TRadioButton;
    rbDefBtn3: TRadioButton;
    clbFlagMB: TCheckListBox;
    procedure imgWarningMBClick(Sender: TObject);
    procedure imgErrorMBClick(Sender: TObject);
    procedure imgInformationMBClick(Sender: TObject);
    procedure imgQuestionMBClick(Sender: TObject);
    procedure seHelpContextMDKeyPress(Sender: TObject; var Key: Char);
    procedure seHelpContextMDChange(Sender: TObject);
    procedure imgWarningMDClick(Sender: TObject);
    procedure imgErrorMDClick(Sender: TObject);
    procedure imgInformationMDClick(Sender: TObject);
    procedure rbConfirmationMDClick(Sender: TObject);
    procedure cbGenerateResultCodeMDClick(Sender: TObject);
    procedure mmMessageMBChange(Sender: TObject);
    procedure AnyShowButtonsRadioButtonClick(Sender: TObject);
    procedure clbFlagMBMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btnCopyClick(Sender: TObject);
    procedure btnTestMessageClick(Sender: TObject);
    procedure mmMessageMDChange(Sender: TObject);
  private
    { Private declarations }
    FMessageBoxDialog: TMessageBoxDialog;
    procedure EnableResultCheckBoxes(const DisableAll: Boolean);
    procedure EnableDefBtnRadioButtons(const HowMany: Integer);
    function DoubleSingleQuotes(S: string): string;
    function CreateMessageStr(Strings: TStrings): string;

    procedure CreateMessageBoxFuncStr(const CaseStatementsResult: Boolean);
    procedure CreateMessageDlgFuncStr(const CaseStatementsResult: Boolean);
    procedure TestShowMessageBox;
    procedure TestShowMessageDlg;
  public
    { Public declarations }
  end;

{ ========================== }
{ TMessageBoxDialog 声明部分 }
{ ========================== }
  TMessageBoxDialog = class(TCustomModuleDialog)
  private
    FModuleForm: TMessageBoxConstructorForm;
    FPageIndex: Integer;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;

  published
    property PageIndex: Integer read FPageIndex write FPageIndex
      default 0;
  end;

var
  MessageBoxConstructorForm: TMessageBoxConstructorForm;

implementation

{$R *.dfm}

resourcestring
  SDefultMessageBoxDialogTitle = '对话框函数快速生成器';


{ TMessageBoxDialog }

constructor TMessageBoxDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TMessageBoxConstructorForm.Create(Self);
  FModuleForm.FMessageBoxDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultMessageBoxDialogTitle;

  FWindowForm := FModuleForm;
  FPageIndex := 0;
end;

destructor TMessageBoxDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TMessageBoxDialog.Execute: Boolean;
begin
  inherited Execute;
  Result := FModuleForm.ShowModal = mrOK;
end;

{ TMessageBoxConstructorForm }

procedure TMessageBoxConstructorForm.imgWarningMBClick(Sender: TObject);
begin
  inherited;
  rbWarningMB.Checked := True;
end;

procedure TMessageBoxConstructorForm.imgErrorMBClick(Sender: TObject);
begin
  inherited;
  rbErrorMB.Checked := True;
end;

procedure TMessageBoxConstructorForm.imgInformationMBClick(
  Sender: TObject);
begin
  inherited;
  rbInformationMB.Checked := True;
end;

procedure TMessageBoxConstructorForm.imgQuestionMBClick(Sender: TObject);
begin
  inherited;
  rbQuestionMB.Checked := True;
end;

procedure TMessageBoxConstructorForm.seHelpContextMDKeyPress(Sender: TObject;
  var Key: Char);
begin
  inherited;
  case Key of
    '0'..'9', #8:
  else
    Key := #0;
    Beep;
  end;
end;

procedure TMessageBoxConstructorForm.seHelpContextMDChange(Sender: TObject);
begin
  inherited;
  with seHelpContextMD do
    if Text = '' then
      Text := '0';
  CreateMessageDlgFuncStr(cbGenerateResultCodeMD.Checked);
end;

procedure TMessageBoxConstructorForm.imgWarningMDClick(Sender: TObject);
begin
  inherited;
  rbWarningMD.Checked := True;
end;

procedure TMessageBoxConstructorForm.imgErrorMDClick(Sender: TObject);
begin
  inherited;
  rbErrorMD.Checked := True;
end;

procedure TMessageBoxConstructorForm.imgInformationMDClick(
  Sender: TObject);
begin
  inherited;
  rbInformationMD.Checked := True;
end;

procedure TMessageBoxConstructorForm.rbConfirmationMDClick(
  Sender: TObject);
begin
  inherited;
  rbConfirmationMD.Checked := True;
end;

procedure TMessageBoxConstructorForm.EnableResultCheckBoxes(
  const DisableAll: Boolean);

  procedure DisableAllMRCheckBox(pnl: TPanel);
  var
    I: Integer;
  begin
    for I := 0 to pnl.ControlCount - 1 do
      if (pnl.Controls[I].Tag = 9) and (pnl.Controls[I] is TCheckBox) then
        with TCheckBox(pnl.Controls[I]) do
        begin
          if Checked then
            Checked := False;
          if Enabled then
            Enabled := False;
        end;
  end;

begin
  if DisableAll then
  begin
    DisableAllMRCheckBox(pnlResultMD);
  end
  else
  begin
    cbMrOKMD.Enabled := cbOKMD.Checked;
    cbMrCancelMD.Enabled := cbCancelMD.Checked;
    cbMrYesMD.Enabled := cbYesMD.Checked;
    cbMrNoMD.Enabled := cbNoMD.Checked;

    cbMrAbortMD.Enabled := cbAbortMD.Checked;
    cbMrRetryMD.Enabled := cbRetryMD.Checked;
    cbMrIgnoreMD.Enabled := cbIgnoreMD.Checked;

    cbMrAllMD.Enabled := cbAllMD.Checked;
    cbMrYesToAllMD.Enabled := cbYesToAllMD.Checked;
    cbMrNoToAllMD.Enabled := cbNoToAllMD.Checked;

    cbMrNoneMD.Enabled := True;
  end;
end;

procedure TMessageBoxConstructorForm.AnyShowButtonsRadioButtonClick(
  Sender: TObject);
begin
  inherited;
  EnableDefBtnRadioButtons(TControl(Sender).Tag);
  CreateMessageBoxFuncStr(cbCreateCaseStatementsMB.Checked);
end;

procedure TMessageBoxConstructorForm.EnableDefBtnRadioButtons(
  const HowMany: Integer);
var
  I: Integer;
begin
  for I := 0 to gbDefaultBtnMB.ControlCount - 1 do
    if gbDefaultBtnMB.Controls[I].Tag <= HowMany then
    begin
      if gbDefaultBtnMB.Controls[I] is TRadioButton then
        with TRadioButton(gbDefaultBtnMB.Controls[I]) do
          Enabled := True;
    end
    else
    begin
      if gbDefaultBtnMB.Controls[I] is TRadioButton then
        with TRadioButton(gbDefaultBtnMB.Controls[I]) do
        begin
          Checked := False;
          Enabled := False;
        end; { end of WITH }
    end;
end;

procedure TMessageBoxConstructorForm.cbGenerateResultCodeMDClick(
  Sender: TObject);
begin
  inherited;
  EnableResultCheckBoxes(not cbGenerateResultCodeMD.Checked);
  CreateMessageDlgFuncStr(cbGenerateResultCodeMD.Checked);
end;


const
  ARealReturn = #13#10'  ';


  AMessageBoxFun = 'MessageBox(Handle, %s)';
  AMessageDlgFun = 'MessageDlg(%s)';
  APChar = 'PChar(%s)';
  ASingleQuotes = '''';
  AComma = ', ';
  AColon = ': ';
  ACaseStatements = 'case %s of' + ARealReturn;
  AReturn = '#13#10';
  APlus = ' + ';
  AOr = ' or ';
  AComment = '// Add your code here';
  AEnd = 'end';
  ASemicolon = ';';
  ASquareBrackets = '[%s]';


function TMessageBoxConstructorForm.DoubleSingleQuotes(S: string): string;
var
  J, L: Integer;
begin
  J := 1;
  L := Length(S);
  while J <= L do