umessageboxconstructorform.pas

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

  begin
    if S[J] = ASingleQuotes then
    begin
      Insert(ASingleQuotes, S, J);
      Inc(L);
      Inc(J);
    end;
    Inc(J);
  end;
  Result := S;
end;

function TMessageBoxConstructorForm.CreateMessageStr(Strings: TStrings): string;
var
  I, Len: Integer;
begin
  Result := ASingleQuotes;
  for I := 0 to Strings.Count - 1 do
    Result := Result + DoubleSingleQuotes(Strings[I]) +
      ASingleQuotes + AReturn + APlus + ARealReturn + ASingleQuotes;
  Len := Length(Result);
  if Len >= 14 then
    Delete(Result, Len - 14, 15);
  Result := Result + ASingleQuotes;
end;

procedure TMessageBoxConstructorForm.CreateMessageBoxFuncStr(
  const CaseStatementsResult: Boolean);

  function GetIconIndex: Integer;
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to gbIconsMB.ControlCount - 1 do
      if (gbIconsMB.Controls[I] is TRadioButton)
        and (TRadioButton(gbIconsMB.Controls[I]).Checked) then
      begin
        Result := gbIconsMB.Controls[I].Tag;
        Break;
      end;
  end;

  function GetIconStr: string;
  const
    MB_ICON: array[0..4] of string = ('',
      'MB_ICONWARNING', 'MB_ICONERROR',
      'MB_ICONINFORMATION', 'MB_ICONQUESTION');
  begin
    Result := MB_ICON[GetIconIndex];
    if Result <> '' then Result := Result + AOr;
  end;

  function GetButtonsIndex: Integer;
  begin
    Result := 0;
    if rbOKMB.Checked then Result := 1
    else if rbOKCancelMB.Checked then Result := 2
    else if rbAbortRetryIgnoreMB.Checked then Result := 3
    else if rbYesNoMB.Checked then Result := 4
    else if rbRetryCancelMB.Checked then Result := 5
    else if rbYesNoCancelMB.Checked then Result := 6;
  end;

  function GetButtonsStr: string;
  const
    MB_BUTTON: array[0..6] of string = ('',
      'MB_OK', 'MB_OKCANCEL', 'MB_ABORTRETRYIGNORE',
      'MB_YESNO', 'MB_RETRYCANCEL', 'MB_YESNOCANCEL');
  begin
    Result := MB_BUTTON[GetButtonsIndex];
    if Result <> '' then Result := Result + AOr;
  end;

  function GetDefBtnIndex: Integer;
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to gbDefaultBtnMB.ControlCount - 1 do
      if (gbDefaultBtnMB.Controls[I] is TRadioButton)
        and (TRadioButton(gbDefaultBtnMB.Controls[I]).Checked) then
      begin
        Result := gbDefaultBtnMB.Controls[I].Tag;
        Break;
      end;
  end;

  function GetDefBtnStr: string;
  const
    MB_DEFBTN: array[0..3] of string = ('',
      'MB_DEFBUTTON1', 'MB_DEFBUTTON2', 'MB_DEFBUTTON3');
  begin
    Result := MB_DEFBTN[GetDefBtnIndex];
    if Result <> '' then Result := Result + AOr;
  end;

  function GetFlagsStr: string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to clbFlagMB.Items.Count - 1 do
      if clbFlagMB.Checked[I] then
        Result := Result + clbFlagMB.Items[I] + AOr;
  end;

  function GetIcon_Buttons_DefBtnAndFlagsStr: string;
  const
    OrLen = Length(AOr);
  begin
    Result := GetIconStr + GetButtonsStr + GetDefBtnStr + GetFlagsStr;
    if Result <> '' then
      Delete(Result, Length(Result) - OrLen + 1, OrLen);
  end;

  function CreateCaseStatementsFormatStr(const Can: Boolean): string;
  const
    OneLine = AColon + AComment + ARealReturn;
    Statements: array[0..6] of string = ('',
      'IDOK' + OneLine,
      'IDOK' + OneLine + 'IDCANCEL' + OneLine,
      'IDABORT' + OneLine + 'IDRETRY' + OneLine + 'IDIGNORE' + OneLine,
      'IDYES' + OneLine + 'IDNO' + OneLine,
      'IDRETRY' + OneLine + 'IDCANCEL' + OneLine,
      'IDYES' + OneLine + 'IDNO' + OneLine + 'IDCANCEL' + OneLine);
  var
    BtnIndex: Integer;
  begin
    Result := '%s';
    if Can then
    begin
      BtnIndex := GetButtonsIndex;
      if BtnIndex > 1 then
      begin
        Result := ACaseStatements;
        Result := Result + Statements[BtnIndex] + #13#10 + AEnd;
      end
      else
        Result := 'if %s = IDOK then'#13#10'begin' + ARealReturn + AComment +
          #13#10 + AEnd;
    end;
  end;

begin
  mmCodeMB.Text := Format(CreateCaseStatementsFormatStr(
    CaseStatementsResult), [
    Format(AMessageBoxFun, [
      Format(APChar, [CreateMessageStr(mmMessageMB.Lines)]) + AComma +
      Format(APChar, [ASingleQuotes + DoubleSingleQuotes(cbTitleMB.Text) + ASingleQuotes]) +
      AComma + ARealReturn + GetIcon_Buttons_DefBtnAndFlagsStr])
    ]) + ASemicolon;
end;

procedure TMessageBoxConstructorForm.TestShowMessageBox;

  function GetIcon: Cardinal;
  const
    MB_ICON: array[0..4] of Cardinal = (MB_OK,
      MB_ICONWARNING, MB_ICONERROR, MB_ICONINFORMATION, MB_ICONQUESTION);
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to gbIconsMB.ControlCount - 1 do
      if (gbIconsMB.Controls[I] is TRadioButton)
        and (TRadioButton(gbIconsMB.Controls[I]).Checked) then
      begin
        Result := MB_ICON[gbIconsMB.Controls[I].Tag];
        Break;
      end;
  end;

  function GetButtons: Cardinal;
  begin
    Result := 0;
    if rbOKMB.Checked then Result := MB_OK
    else if rbOKCancelMB.Checked then Result := MB_OKCANCEL
    else if rbAbortRetryIgnoreMB.Checked then Result := MB_ABORTRETRYIGNORE
    else if rbYesNoMB.Checked then Result := MB_YESNO
    else if rbRetryCancelMB.Checked then Result := MB_RETRYCANCEL
    else if rbYesNoCancelMB.Checked then Result := MB_YESNOCANCEL;
  end;

  function GetDefBtn: Cardinal;
  const
    MB_DEFBTN: array[1..3] of Cardinal = (
      MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3);
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to gbDefaultBtnMB.ControlCount - 1 do
      if (gbDefaultBtnMB.Controls[I] is TRadioButton)
        and (TRadioButton(gbDefaultBtnMB.Controls[I]).Checked) then
      begin
        Result := MB_DEFBTN[gbDefaultBtnMB.Controls[I].Tag];
        Break;
      end;
  end;

  function GetFlags: Cardinal;
  const
    MB_FLAGS: array[0..11] of Cardinal = (MB_OK,
      MB_APPLMODAL, MB_SYSTEMMODAL, MB_TASKMODAL,
      MB_DEFAULT_DESKTOP_ONLY, MB_HELP, MB_RIGHT,
      MB_RTLREADING, MB_SETFOREGROUND, MB_TOPMOST,
      MB_SERVICE_NOTIFICATION, MB_SERVICE_NOTIFICATION_NT3X);
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to clbFlagMB.Items.Count - 1 do
      if clbFlagMB.Checked[I] then
        Result := Result + MB_FLAGS[I + 1];
  end;

begin
  MessageBox(Handle, PChar(mmMessageMB.Text), PChar(cbTitleMB.Text),
    GetIcon or GetButtons or GetDefBtn or GetFlags);
end;

procedure TMessageBoxConstructorForm.CreateMessageDlgFuncStr(
  const CaseStatementsResult: Boolean);

  function GetIconIndex: Integer;
  var
    I: Integer;
  begin
    Result := 4; // 4 is mtCustom
    for I := 0 to gbIconsMD.ControlCount - 1 do
      if (gbIconsMD.Controls[I] is TRadioButton)
        and (TRadioButton(gbIconsMD.Controls[I]).Checked) then
      begin
        Result := gbIconsMD.Controls[I].Tag;
        Break;
      end;
  end;

  function GetIconStr: string;
  const
    MT_ICON: array[0..4] of string = ('mtWarning',
      'mtError', 'mtInformation', 'mtConfirmation', 'mtCustom');
  begin
    Result := MT_ICON[GetIconIndex];
  end;

  function GetButtonsStr: string;
  const
    mb = 'mb';
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to gbButtonsMD.ControlCount - 1 do
      if gbButtonsMD.Controls[I] is TCheckBox then
        with TCheckBox(gbButtonsMD.Controls[I]) do
        begin
          if Checked then
            Result := Result + mb + Caption + AComma;
        end;
    if Result <> '' then
      Delete(Result, Length(Result) - 1, 2);
  end;

  function GetResults: string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to pnlResultMD.ControlCount - 1 do
      if pnlResultMD.Controls[I] is TCheckBox then
        with TCheckBox(pnlResultMD.Controls[I]) do
        begin
          if Checked then
            Result := Result + Caption + AColon + AComment + ARealReturn;
        end;
    if Result <> '' then
      Result := ARealReturn + Result;
  end;

  function CreateCaseStatementsFormatStr(const Can: Boolean): string;
  var
    ResultStr: string;
  begin
    Result := '%s';
    ResultStr := GetResults;
    if (Can) and (ResultStr <> '') then
      Result := ACaseStatements + ResultStr + #13#10 + AEnd;
  end;

begin
  mmCodeMD.Text := Format(CreateCaseStatementsFormatStr(
    CaseStatementsResult), [
    Format(AMessageDlgFun, [
      CreateMessageStr(mmMessageMD.Lines) + AComma +
        GetIconStr + AComma + ARealReturn +
        Format(ASquareBrackets, [
        GetButtonsStr
          ]) + AComma + seHelpContextMD.Text
        ])
      ]);
end;

procedure TMessageBoxConstructorForm.TestShowMessageDlg;

  function GetIcon: TMsgDlgType;
  begin
    Result := mtCustom;
    if rbWarningMD.Checked then Result := mtWarning
    else if rbErrorMD.Checked then Result := mtError
    else if rbInformationMD.Checked then Result := mtInformation
    else if rbConfirmationMD.Checked then Result := mtConfirmation;
  end;

  function GetButtons: TMsgDlgButtons;
  begin
    Result := [];
    if cbOKMD.Checked then Include(Result, mbOK);
    if cbCancelMD.Checked then Include(Result, mbCancel);
    if cbYesMD.Checked then Include(Result, mbYes);
    if cbNoMD.Checked then Include(Result, mbNo);
    if cbAbortMD.Checked then Include(Result, mbAbort);
    if cbRetryMD.Checked then Include(Result, mbRetry);
    if cbIgnoreMD.Checked then Include(Result, mbIgnore);
    if cbAllMD.Checked then Include(Result, mbAll);
    if cbYesToAllMD.Checked then Include(Result, mbYesToAll);
    if cbNoToAllMD.Checked then Include(Result, mbNoToAll);
    if cbHelpMD.Checked then Include(Result, mbHelp);
  end;

begin
  MessageDlg(mmMessageMD.Text, GetIcon, GetButtons,
    seHelpContextMD.Value);
end;

procedure TMessageBoxConstructorForm.mmMessageMBChange(Sender: TObject);
begin
  inherited;
  CreateMessageBoxFuncStr(cbCreateCaseStatementsMB.Checked);
end;

procedure TMessageBoxConstructorForm.clbFlagMBMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  with clbFlagMB do
  begin
    if ItemIndex <> -1 then
      Hint := Items[ItemIndex]
    else
      Hint := '';
  end;
end;

procedure TMessageBoxConstructorForm.btnCopyClick(Sender: TObject);
begin
  inherited;
  if PageControl.ActivePage = tsMessageBox then
  begin
    mmCodeMB.SelectAll;
    mmCodeMB.CopyToClipboard;
  end
  else if PageControl.ActivePage = tsMessageDlg then
  begin
    mmCodeMD.SelectAll;
    mmCodeMD.CopyToClipboard;
  end;
end;

procedure TMessageBoxConstructorForm.btnTestMessageClick(Sender: TObject);
begin
  inherited;
  if PageControl.ActivePage = tsMessageBox then
    TestShowMessageBox
  else if PageControl.ActivePage = tsMessageDlg then
    TestShowMessageDlg;
end;

procedure TMessageBoxConstructorForm.mmMessageMDChange(Sender: TObject);
begin
  inherited;
  CreateMessageDlgFuncStr(cbGenerateResultCodeMD.Checked);
end;
{$IFDEF DEBUGMODE}
initialization
  with TMessageBoxDialog.Create(nil) do
  begin
    Execute;
    Free;
  end;
{$ENDIF}

end.