messagedlgeditormain.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}

unit MessageDlgEditorMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls, CheckLst,
  JclBase, JvDSADialogs;

type
  TfrmMessageDlgEditor = class(TForm)
    btnClose: TButton;
    gbDlgType: TGroupBox;
    imgWarning: TImage;
    imgError: TImage;
    imgInformation: TImage;
    imgConfirmation: TImage;
    imgCustom: TImage;
    rbWarning: TRadioButton;
    rbError: TRadioButton;
    rbInformation: TRadioButton;
    rbConfirmation: TRadioButton;
    rbCustom: TRadioButton;
    btnSelectIcon: TButton;
    edCustomTitle: TEdit;
    cxCustomTitle: TCheckBox;
    gbButtons: TGroupBox;
    lblDefaultButton: TLabel;
    lblCancelButton: TLabel;
    lblHelpButton: TLabel;
    rbStdButtons: TRadioButton;
    rbCustomButtons: TRadioButton;
    clbStdButtons: TCheckListBox;
    mmCustomButtons: TMemo;
    cbDefaultButton: TComboBox;
    cbCancelButton: TComboBox;
    cbHelpButton: TComboBox;
    gbOther: TGroupBox;
    lblHelpContext: TLabel;
    lblMessage: TLabel;
    rbCenterScreen: TRadioButton;
    rbMainFormCenter: TRadioButton;
    rbActiveFormCenter: TRadioButton;
    edHelpCtx: TEdit;
    cxIsDSADialog: TCheckBox;
    edDSA_ID: TEdit;
    mmMessage: TMemo;
    lblSource: TLabel;
    mmSource: TMemo;
    btnTest: TButton;
    cxAutoClose: TCheckBox;
    edAutoCloseDelay: TEdit;
    lblAutoCloseUnit: TLabel;
    cxAutoCloseShow: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure imgWarningClick(Sender: TObject);
    procedure rbWarningClick(Sender: TObject);
    procedure imgErrorClick(Sender: TObject);
    procedure rbErrorClick(Sender: TObject);
    procedure imgInformationClick(Sender: TObject);
    procedure rbInformationClick(Sender: TObject);
    procedure imgConfirmationClick(Sender: TObject);
    procedure rbConfirmationClick(Sender: TObject);
    procedure imgCustomClick(Sender: TObject);
    procedure rbCustomClick(Sender: TObject);
    procedure btnSelectIconClick(Sender: TObject);
    procedure edCustomTitleChange(Sender: TObject);
    procedure rbStdButtonsClick(Sender: TObject);
    procedure rbCustomButtonsClick(Sender: TObject);
    procedure clbStdButtonsClickCheck(Sender: TObject);
    procedure mmCustomButtonsChange(Sender: TObject);
    procedure cbDefaultButtonChange(Sender: TObject);
    procedure cbCancelButtonChange(Sender: TObject);
    procedure cbHelpButtonChange(Sender: TObject);
    procedure rbCenterScreenClick(Sender: TObject);
    procedure rbActiveFormCenterClick(Sender: TObject);
    procedure rbMainFormCenterClick(Sender: TObject);
    procedure edHelpCtxChange(Sender: TObject);
    procedure cxIsDSADialogClick(Sender: TObject);
    procedure edDSA_IDChange(Sender: TObject);
    procedure mmMessageChange(Sender: TObject);
    procedure cxCustomTitleClick(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure cxAutoCloseClick(Sender: TObject);
    procedure edAutoCloseDelayChange(Sender: TObject);
    procedure cxAutoCloseShowClick(Sender: TObject);
  private
    { Private declarations }
    procedure DlgSettingChanged;
    procedure HandleDSAMessageDlg;
    procedure HandleDSAMessageDlgEx;
    procedure HandleMessageDlg;
    procedure HandleMessageDlgEx;
    function GenerateSource: string;
    function GetCenter: TDlgCenterKind;
    function GetTimeout: Integer;
    function GetTimeoutValue: string;
    function GetCustomButtonNames: TDynStringArray;
    function GetCustomButtonResults: TDynIntegerArray;
    function GetCustomCancelButton: Integer;
    function GetCustomDefaultButton: Integer;
    function GetCustomHelpButton: Integer;
    function GetDlgType: TMsgDlgType;
    function GetStdButtons: TMsgDlgButtons;
    function GetStdCancelButton: TMsgDlgBtn;
    function GetStdDefaultButton: TMsgDlgBtn;
    function GetStdHelpButton: TMsgDlgBtn;
    procedure InitDefaultLists;
    procedure TempDSARegCreate;
    procedure TempDSARegDestroy;
  public
    { Public declarations }
    TempDSA_ID: Integer;
    TmpStorage: TDSAQueueStorage;
    PicType: Integer;
    PicName: string;
    PicID: PChar;
  end;

var
  frmMessageDlgEditor: TfrmMessageDlgEditor;

implementation

{$R *.DFM}

uses
  TypInfo,
  MessageDlgEditorSelectIcon;

function MsgToSource(const S: TStrings): string;
begin
  Result := S.Text;
  Result := QuotedStr(Result);
  Result := StringReplace(StringReplace(Result, #13#10, ''' + #13#10 + ''', [rfReplaceAll]), '#13#10 + '''' + ', '#13#10', [rfReplaceAll]);
end;

function StdBtnsToSource(ChkLst: TCheckListBox): string;
var
  Prefix: string;
  I: Integer;
begin
  Result := '[';
  Prefix := '';
  for I := 0 to ChkLst.Items.Count - 1 do
  begin
    if ChkLst.Checked[I] then
    begin
      Result := Result + Prefix + ChkLst.Items[I];
      Prefix := ', ';
    end;
  end;
  Result := Result + ']';
end;

function CustomButtonsToSource(SL: TStrings): string;
var
  Prefix: string;
  Values: string;
  I: Integer;
  TmpName: string;
begin
  Result := '[';
  Values := '[';
  for I := 0 to SL.Count - 1 do
  begin
    if (Trim(SL[I]) <> '') then
    begin
      TmpName := SL.Names[I];
      if (Trim(SL.Values[TmpName]) <> '') and (TmpName = Trim(TmpName)) then
      begin
        Result := Result + Prefix + QuotedStr(TmpName);
        Values := Values + Prefix + Trim(SL.Values[TmpName]);
        Prefix := ', ';
      end;
    end;
  end;
  Result := Result + '], ' + Values + ']';
end;

procedure TfrmMessageDlgEditor.DlgSettingChanged;
begin
  // Setup Default lists
  InitDefaultLists;

  // Assert settings
  cxCustomTitle.Checked := cxCustomTitle.Checked or (
    (rbCustom.Checked) and (PicType <> 0)
  );
  edAutoCloseDelay.Enabled := cxAutoClose.Checked;
  cxAutoCloseShow.Enabled := cxAutoClose.Checked;

  // Enable/disable controls
  btnSelectIcon.Enabled := rbCustom.Checked;
  edCustomTitle.Enabled := cxCustomTitle.Checked;
  edDSA_ID.Enabled := cxIsDSADialog.Checked;
  clbStdButtons.Enabled := rbStdButtons.Checked;
  mmCustomButtons.Enabled := rbCustomButtons.Checked;

  // Generate source
  mmSource.Lines.Text := GenerateSource;
end;

procedure TfrmMessageDlgEditor.HandleDSAMessageDlg;
begin
  TempDSARegCreate;
  try
    if cxCustomTitle.Checked then
    begin
      if rbCustom.Checked and (PicType <> 0) then { custom picture }
        DSAMessageDlg(TempDSA_ID, edCustomTitle.Text, mmMessage.Lines.Text,
          imgCustom.Picture.Graphic, GetStdButtons, 0, GetCenter, GetTimeout, GetStdDefaultButton,
            GetStdCancelButton, GetStdHelpButton)
      else
        DSAMessageDlg(TempDSA_ID, edCustomTitle.Text, mmMessage.Lines.Text, GetDlgType,
          GetStdButtons, 0, GetCenter, GetTimeout, GetStdDefaultButton, GetStdCancelButton,
          GetStdHelpButton);
    end
    else { if not cxCustomTitle.Checked then }
      DSAMessageDlg(TempDSA_ID, mmMessage.Lines.Text, GetDlgType, GetStdButtons, 0, GetCenter,
        GetTimeout, GetStdDefaultButton, GetStdCancelButton, GetStdHelpButton);
  finally
    TempDSARegDestroy;
  end;
end;

procedure TfrmMessageDlgEditor.HandleDSAMessageDlgEx;
begin
  TempDSARegCreate;
  try
    if cxCustomTitle.Checked then
    begin
      if rbCustom.Checked and (PicType <> 0) then { custom picture }
        DSAMessageDlgEx(TempDSA_ID, edCustomTitle.Text, mmMessage.Lines.Text,
          imgCustom.Picture.Graphic, GetCustomButtonNames, GetCustomButtonResults, 0, GetCenter,
          GetTimeout, GetCustomDefaultButton, GetCustomCancelButton, GetCustomHelpButton)
      else
        DSAMessageDlgEx(TempDSA_ID, edCustomTitle.Text, mmMessage.Lines.Text, GetDlgType,
          GetCustomButtonNames, GetCustomButtonResults, 0, GetCenter, GetTimeout,
          GetCustomDefaultButton, GetCustomCancelButton, GetCustomHelpButton);
    end
    else { if not cxCustomTitle.Checked then }
      DSAMessageDlgEx(TempDSA_ID, mmMessage.Lines.Text, GetDlgType, GetCustomButtonNames,
        GetCustomButtonResults, 0, GetCenter, GetTimeout, GetCustomDefaultButton,
        GetCustomCancelButton, GetCustomHelpButton);
  finally
    TempDSARegDestroy;
  end;
end;

procedure TfrmMessageDlgEditor.HandleMessageDlg;
begin
  if cxCustomTitle.Checked then
  begin
    if rbCustom.Checked and (PicType <> 0) then { custom picture }
      MessageDlg(edCustomTitle.Text, mmMessage.Lines.Text, imgCustom.Picture.Graphic, GetStdButtons,
        0, GetCenter, GetTimeout, GetStdDefaultButton, GetStdCancelButton, GetStdHelpButton)
    else
      MessageDlg(edCustomTitle.Text, mmMessage.Lines.Text, GetDlgType, GetStdButtons, 0, GetCenter,
        GetTimeout, GetStdDefaultButton, GetStdCancelButton, GetStdHelpButton);
  end
  else { if not cxCustomTitle.Checked then }
    MessageDlg(mmMessage.Lines.Text, GetDlgType, GetStdButtons, 0, GetCenter, GetTimeout,
      GetStdDefaultButton, GetStdCancelButton, GetStdHelpButton);
end;

procedure TfrmMessageDlgEditor.HandleMessageDlgEx;
begin
  if cxCustomTitle.Checked then
  begin
    if rbCustom.Checked and (PicType <> 0) then { custom picture }
      MessageDlgEx(edCustomTitle.Text, mmMessage.Lines.Text, imgCustom.Picture.Graphic,
        GetCustomButtonNames, GetCustomButtonResults, 0, GetCenter, GetTimeout,
        GetCustomDefaultButton, GetCustomCancelButton, GetCustomHelpButton)
    else
      MessageDlgEx(edCustomTitle.Text, mmMessage.Lines.Text, GetDlgType, GetCustomButtonNames,
        GetCustomButtonResults, 0, GetCenter, GetTimeout, GetCustomDefaultButton,
        GetCustomCancelButton, GetCustomHelpButton);
  end
  else { if not cxCustomTitle.Checked then }
    MessageDlgEx(mmMessage.Lines.Text, GetDlgType, GetCustomButtonNames, GetCustomButtonResults, 0,
      GetCenter, GetTimeout, GetCustomDefaultButton, GetCustomCancelButton, GetCustomHelpButton);
end;

function TfrmMessageDlgEditor.GenerateSource: string;
  function HasGraphic: Boolean;
  begin
    Result := (
      rbCustom.Checked and (PicType <> 0)
    );
  end;

  function GetPicLoadSource: string;
  begin
    case PicType of
      1 .. 4:
        Result := 'Pic.Icon.Handle := LoadIcon(0, ' + PicName + ');';
      5:
        Result := 'Pic.Icon.Handle := LoadIcon(0, ''' + PicName + ''');';
      6:
        Result := 'Pic.Bitmap.Handle := LoadBitmap(0, ''' + PicName + ''');';
      7:
        Result := 'Pic.LoadFromFile(''' + PicName + ''');';
      else
        Result := '';
    end;
    if Result <> '' then
      Result := Result + #13#10 + '  ';
  end;

  function RequireCenter: Boolean;
  begin
    Result := not rbCenterScreen.Checked or cxAutoClose.Checked or (
      // for non-extended dialogs: button defaults are not met
      rbStdButtons.Checked and (
        (cbDefaultButton.ItemIndex <> 0) or
        (cbCancelButton.ItemIndex <> 0) or (
          (cbHelpButton.ItemIndex <> 0) and
          (cbHelpButton.Text <> 'mbHelp')
        )
      )
    ) or (
      // for extended dialogs: button defaults are not met
      rbCustomButtons.Checked and (
        (cbDefaultButton.ItemIndex <> 1) or
        (cbCancelButton.ItemIndex <> 2) or
        (cbHelpButton.ItemIndex <> 0)
      )
    );
  end;

  function RequireAutoClose: Boolean;
  begin
    Result := cxAutoClose.Checked or (
      // for non-extended dialogs: button defaults are not met
      rbStdButtons.Checked and (
        (cbDefaultButton.ItemIndex <> 0) or
        (cbCancelButton.ItemIndex <> 0) or (
          (cbHelpButton.ItemIndex <> 0) and
          (cbHelpButton.Text <> 'mbHelp')
        )
      )
    ) or (
      // for extended dialogs: button defaults are not met
      rbCustomButtons.Checked and (
        (cbDefaultButton.ItemIndex <> 1) or
        (cbCancelButton.ItemIndex <> 2) or
        (cbHelpButton.ItemIndex <> 0)
      )
    );
  end;

  function GetCenterName: string;
  begin
    if rbCenterScreen.Checked then
      Result := 'dckScreen'
    else if rbMainFormCenter.Checked then
      Result := 'dckMainForm'
    else if rbActiveFormCenter.Checked then
      Result := 'dckActiveForm'
    else
      Result := '??? error ???';
  end;

  function RequireDefaultButton: Boolean;
  begin
    Result := (rbStdButtons.Checked and (
      // Non extended dialogs: Either button has a non default value
      (cbDefaultButton.ItemIndex <> 0) or
      (cbCancelButton.ItemIndex <> 0) or (
        (cbHelpButton.ItemIndex <> 0) and
        (cbHelpButton.Text <> 'mbHelp')
      )
    )) or (rbCustomButtons.Checked and (
      // Extended dialogs: Either button has a non default value
      (cbDefaultButton.ItemIndex <> 1) or
      (cbCancelButton.ItemIndex <> 2) or
      (cbHelpButton.ItemIndex <> 0)
    ));
  end;

  function DefaultButtonName: string;
  begin
    if rbStdButtons.Checked then
    begin
      if cbDefaultButton.ItemIndex = 0 then
        Result := 'mbDefault'
      else if cbDefaultButton.ItemIndex = 1 then
        Result := 'mbNone'
      else
        Result := cbDefaultButton.Text;
    end
    else if rbCustomButtons.Checked then
    begin
      if cbDefaultButton.ItemIndex = 0 then
        Result := 'mbNone'
      else
        Result := IntToStr(cbDefaultButton.ItemIndex - 1);
    end;
  end;

  function RequireCancelButton: Boolean;
  begin
    Result := (rbStdButtons.Checked and (
      // Non extended dialogs: Either cancel or help button has a non default value
      (cbCancelButton.ItemIndex <> 0) or (
        (cbHelpButton.ItemIndex <> 0) and
        (cbHelpButton.Text <> 'mbHelp')
      )
    )) or (rbCustomButtons.Checked and (
      // Extended dialogs: Either cancel or help button has a non default value
      (cbCancelButton.ItemIndex <> 2) or
      (cbHelpButton.ItemIndex <> 0)
    ));
  end;

  function CancelButtonName: string;
  begin
    if rbStdButtons.Checked then
    begin
      if cbCancelButton.ItemIndex = 0 then
        Result := 'mbDefault'
      else if cbCancelButton.ItemIndex = 1 then
        Result := 'mbNone'
      else
        Result := cbCancelButton.Text;
    end
    else if rbCustomButtons.Checked then
    begin
      if cbCancelButton.ItemIndex = 0 then
        Result := 'mbNone'
      else
        Result := IntToStr(cbCancelButton.ItemIndex - 1);
    end;
  end;

  function RequireHelpButton: Boolean;
  begin
    Result := (rbStdButtons.Checked and (
      // Non extended dialogs: Help button has a non default value
      (cbHelpButton.ItemIndex <> 0) and
      (cbHelpButton.Text <> 'mbHelp')
    )) or (rbCustomButtons.Checked and (
      // Extended dialogs: Help button has a non default value
      (cbHelpButton.ItemIndex <> 0)
    ));
  end;

  function HelpButtonName: string;
  begin
    if rbStdButtons.Checked then
    begin
      if cbHelpButton.ItemIndex = 0 then
        Result := 'mbDefault'
      else if cbHelpButton.ItemIndex = 1 then
        Result := 'mbNone'
      else
        Result := cbHelpButton.Text;
    end
    else if rbCustomButtons.Checked then
    begin
      if cbHelpButton.ItemIndex = 0 then
        Result := 'mbNone'
      else
        Result := IntToStr(cbHelpButton.ItemIndex - 1);
    end;
  end;

begin
  if HasGraphic then
    Result := 'Pic := TPicture.Create;' + #13#10 + 'try'+ #13#10 + '  ' + GetPicLoadSource
  else
    Result := '';
  if cxIsDSADialog.Checked then
    Result := Result + 'DSAMessageDlg'
  else
    Result := Result + 'MessageDlg';

  if rbCustomButtons.Checked then
    Result := Result + 'Ex';