You've already forked lazarus-ccr
3ffa05fdeb
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8159 8e941d3f-bd1b-0410-a28a-d453659cc2b4
355 lines
13 KiB
ObjectPascal
355 lines
13 KiB
ObjectPascal
unit Main;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
|
|
Spin, Menus, LazHelpHTML, Buttons, ExtDlgs, ExQuestionDlg;
|
|
|
|
type
|
|
|
|
{ TDemoForm }
|
|
|
|
TDemoForm = class(TForm)
|
|
Bevel1: TBevel;
|
|
Bevel2: TBevel;
|
|
btnLoadCustomIcon: TBitBtn;
|
|
btnClearCustomIcon: TBitBtn;
|
|
btnQuestionDlgEx: TButton;
|
|
btnQuestionDlg: TButton;
|
|
btnMessageDlg: TButton;
|
|
btnDefaultPromptDlg: TButton;
|
|
btnDefaultQuestionDlg: TButton;
|
|
cbDefaultFont: TCheckBox;
|
|
cbFontName: TComboBox;
|
|
edX: TEdit;
|
|
edY: TEdit;
|
|
FontDialog: TFontDialog;
|
|
gbFont: TGroupBox;
|
|
gbMaxWidth: TGroupBox;
|
|
gbTestStd: TGroupBox;
|
|
gbTest: TGroupBox;
|
|
OpenDialog: TOpenDialog;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
rgTextBkColor: TRadioGroup;
|
|
rbLeftJustify: TRadioButton;
|
|
rbHCenter: TRadioButton;
|
|
rbRightJustify: TRadioButton;
|
|
rbTop: TRadioButton;
|
|
rbVCenter: TRadioButton;
|
|
rbBottom: TRadioButton;
|
|
gbTextAlignmentLayout: TGroupBox;
|
|
HTMLBrowserHelpViewer: THTMLBrowserHelpViewer;
|
|
HTMLHelpDatabase: THTMLHelpDatabase;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
rgGlyphShowMode: TRadioGroup;
|
|
rgMsgType: TRadioGroup;
|
|
rgPosition: TRadioGroup;
|
|
rgBtnAlignment: TRadioGroup;
|
|
rgButtons: TRadioGroup;
|
|
rgMessage: TRadioGroup;
|
|
seMinWidth: TSpinEdit;
|
|
seFontSize: TSpinEdit;
|
|
seMaxWidth: TSpinEdit;
|
|
procedure btnLoadCustomIconClick(Sender: TObject);
|
|
procedure btnClearCustomIconClick(Sender: TObject);
|
|
procedure btnDefaultPromptDlgClick(Sender: TObject);
|
|
procedure btnDefaultQuestionDlgClick(Sender: TObject);
|
|
procedure btnMessageDlgClick(Sender: TObject);
|
|
procedure btnQuestionDlgClick(Sender: TObject);
|
|
procedure btnQuestionDlgExClick(Sender: TObject);
|
|
procedure cbDefaultFontChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure rgTextBkColorClick(Sender: TObject);
|
|
private
|
|
function GetModalResultStr(res: TModalResult): String;
|
|
|
|
public
|
|
|
|
end;
|
|
|
|
var
|
|
DemoForm: TDemoForm;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
LCLIntf, LCLType, InterfaceBase, TypInfo, Math,
|
|
{$IF FPC_FullVersion >= 30202}System.{$IFEND}UITypes;
|
|
|
|
const
|
|
FORM_CAPTION = 'Test QuestionDlgEx';
|
|
DLG_TITLE = 'This is the caption of the dialog';
|
|
MSG_TEXT: array[0..6] of String = (
|
|
'msg',
|
|
'Short text',
|
|
'This is a long long long long text.',
|
|
'This is a very very very very very very very very very very very very very very long text.',
|
|
'This is even longer, another very very very very very very very very very very very very very very very very very very very very very very long text.',
|
|
'Line 1' + LineEnding + 'Line 2' + LineEnding + 'Line 3' + LineEnding + 'Line 4' + LineEnding + 'Line 5',
|
|
'This is a long long long long text.' + LineEnding + 'Short text.' + 'This is a very very very very very very very very very very very very very very long text.'
|
|
);
|
|
BUTTON_NAMES: array[idButtonOK..idButtonShield] of string = (
|
|
'idButtonOk', 'idButtonCancel', 'idButtonHelp', 'idButtonYes', 'idButtonNo',
|
|
'idButtonClose', 'idButtonAbort', 'idButtonRetry', 'idButtonIgnore',
|
|
'idButtonAll', 'idButtonYesToAll', 'idButtonNoToAll', 'idButtonOpen',
|
|
'idButtonSave', 'idButtonShield'
|
|
);
|
|
|
|
|
|
{ TDemoForm }
|
|
|
|
procedure TDemoForm.btnQuestionDlgExClick(Sender: TObject);
|
|
var
|
|
msg: String;
|
|
X, Y: Integer;
|
|
mt: Dialogs.TMsgDlgType;
|
|
res: TModalResult;
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
QuestionDlgEx_MaxWidth := seMaxWidth.Value;
|
|
QuestionDlgEx_MinWidth := seMinWidth.Value;
|
|
QuestionDlgEx_ButtonAlignment := TAlignment(rgBtnAlignment.ItemIndex);
|
|
if rbLeftJustify.Checked then QuestionDlgEx_TextAlignment := taLeftJustify
|
|
else if rbRightJustify.Checked then QuestionDlgEx_TextAlignment := taRightJustify
|
|
else if rbHCenter.Checked then QuestionDlgEx_TextAlignment := taCenter;
|
|
if rbTop.Checked then QuestionDlgEx_TextLayout := tlTop
|
|
else if rbVCenter.Checked then QuestionDlgEx_TextLayout := tlCenter
|
|
else if rbBottom.Checked then QuestionDlgEx_TextLayout := tlBottom;
|
|
QuestionDlgEx_GlyphShowMode := TGlyphShowMode(rgGlyphShowMode.ItemIndex);
|
|
if cbDefaultFont.Checked then
|
|
begin
|
|
QuestionDlgEx_FontName := '';
|
|
QuestionDlgEx_FontSize := 0;
|
|
end else
|
|
begin
|
|
QuestionDlgEx_FontName := cbFontName.Text;
|
|
QuestionDlgEx_FontSize := seFontSize.Value;
|
|
end;
|
|
|
|
msg := MSG_TEXT[rgMessage.ItemIndex];
|
|
mt := Dialogs.TMsgDlgType(rgMsgType.ItemIndex);
|
|
|
|
if rgPosition.ItemIndex = 0 then
|
|
begin
|
|
// interpret poDesigned as "missing X and Y", i.e. X := MaxInt; Y := MaxInt;
|
|
X := MaxInt;
|
|
Y := MaxInt;
|
|
end else
|
|
if rgPosition.ItemIndex = rgPosition.Items.Count-1 then
|
|
begin
|
|
// last item "custom" means: use X, Y from edit boxes
|
|
if not TryStrToInt(edX.Text, x) then X := MaxInt;
|
|
if not TryStrToInt(edY.Text, Y) then Y := MaxInt;
|
|
end else
|
|
begin
|
|
// These are the "poXXXX" values.
|
|
// Note: The poDefaultXXXX values do not work correctly.
|
|
X := -rgPosition.ItemIndex;
|
|
Y := MaxInt;
|
|
end;
|
|
|
|
case rgButtons.ItemIndex of
|
|
0: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', 'IsCancel'], 'HTML/index.html', X, Y);
|
|
1: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbNo, 'No sir', 'IsDefault', mbCancel, 'Changed my mind', 'IsCancel'], 'HTML/index.html', X, Y);
|
|
2: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel'], 'HTML/index.html', X, Y);
|
|
3: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel', mbClose, 'Close it', mbHelp, 'I need help'], 'HTML/index.html', X, Y);
|
|
end;
|
|
|
|
Caption := GetModalResultStr(res);
|
|
end;
|
|
|
|
procedure TDemoForm.btnMessageDlgClick(Sender: TObject);
|
|
var
|
|
mt: TMsgDlgType;
|
|
res: TModalResult;
|
|
msg: String;
|
|
helpkwd: String;
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
mt := TMsgDlgType(rgMsgType.ItemIndex);
|
|
msg := MSG_TEXT[rgMessage.ItemIndex];
|
|
helpkwd := 'HTML/index.html';
|
|
// Note: not possible to specify cancel button. Default button can only be
|
|
// specified if help is given as helpctx, not as helpkeyword.
|
|
case rgButtons.ItemIndex of
|
|
0: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes], helpkwd);
|
|
1: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbNo, mbCancel], helpkwd);
|
|
2: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbYesToAll, mbNo, mbNoToAll], helpkwd);
|
|
3: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbClose, mbHelp], helpkwd);
|
|
end;
|
|
Caption := GetModalResultStr(res);
|
|
end;
|
|
|
|
procedure TDemoForm.btnQuestionDlgClick(Sender: TObject);
|
|
var
|
|
mt: TMsgDlgType;
|
|
res: Integer;
|
|
msg: String;
|
|
helpkwd: String;
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
mt := TMsgDlgType(rgMsgType.ItemIndex);
|
|
msg := MSG_TEXT[rgMessage.ItemIndex];
|
|
helpkwd := 'HTML/index.html';
|
|
// There are two ways to work with this dialog:
|
|
// - use the Delphi compatible mrXXX constants (DO NOT USE THE mbXXX CONSTANTS!)
|
|
// - use the LCL idButtonXXX constants
|
|
case rgButtons.ItemIndex of
|
|
0: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir'], helpkwd);
|
|
1: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrNo, 'No sir', 'IsDefault', mrCancel, 'Changed my mind'], helpkwd);
|
|
2: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel'], helpkwd);
|
|
3: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel', mrClose, 'Schließen', mrNone, 'Hilfe'], helpkwd);
|
|
end;
|
|
Caption := GetModalResultStr(res);
|
|
(*
|
|
case rgButtons.ItemIndex of
|
|
0: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir'], helpkwd);
|
|
1: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonNo, 'No sir', 'IsDefault', idButtonCancel, 'Changed my mind'], helpkwd);
|
|
2: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel'], helpkwd);
|
|
3: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel', idButtonClose, 'Schließen', idButtonHelp, 'Hilfe'], helpkwd);
|
|
end;
|
|
Caption := FORM_CAPTION + ' - Result: ' + BUTTON_NAMES[res];
|
|
*)
|
|
end;
|
|
|
|
procedure TDemoForm.btnDefaultPromptDlgClick(Sender: TObject);
|
|
var
|
|
mt: Integer;
|
|
res: Integer;
|
|
msg: String;
|
|
btns1: array[0..0] of Integer = (idButtonYes);
|
|
btns3: array[0..2] of Integer = (idButtonYes, idButtonNo, idButtonCancel);
|
|
btns5: array[0..4] of Integer = (idButtonYes, idbuttonYesToAll, idButtonNo, idButtonNoToAll, idButtonCancel);
|
|
btns7: array[0..6] of Integer = (idButtonYes, idbuttonYesToAll, idButtonNo, idButtonNoToAll, idButtonCancel, idButtonClose, idButtonHelp);
|
|
defaultPos: Boolean;
|
|
X, Y: Integer;
|
|
s: String;
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
mt := idDialogBase + 1 + rgMsgType.ItemIndex;
|
|
msg := MSG_TEXT[rgMessage.ItemIndex];
|
|
if not TryStrToInt(edX.Text, X) then X := 0;
|
|
if not TryStrToInt(edY.Text, Y) then Y := 0;
|
|
defaultPos := (rgPosition.ItemIndex <> rgPosition.Items.Count-1);
|
|
// No help context support here.
|
|
case rgButtons.ItemIndex of
|
|
0: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns1, 1, 0, 0, defaultPos, X, Y);
|
|
1: res := DefaultPromptdialog(DLG_TITLE, msg, mt, @btns3, 3, 1, 2, defaultPos, X, Y);
|
|
2: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns5, 5, 2, 4, defaultPos, X, Y);
|
|
3: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns7, 7, 2, 4, defaultPos, X, Y);
|
|
end;
|
|
// Note: res is an idButtonXXXX value here!
|
|
Caption := FORM_CAPTION + '- Result: ' +BUTTON_NAMES[res];
|
|
end;
|
|
|
|
procedure TDemoForm.btnLoadCustomIconClick(Sender: TObject);
|
|
begin
|
|
if OpenDialog.Execute then
|
|
begin
|
|
if QuestionDlgEx_CustomIcon = nil then
|
|
QuestionDlgEx_CustomIcon := TPicture.Create
|
|
else
|
|
QuestionDlgEx_CustomIcon.Clear;
|
|
QuestionDlgEx_CustomIcon.LoadFromFile(OpenDialog.FileName);
|
|
end;
|
|
end;
|
|
|
|
procedure TDemoForm.btnClearCustomIconClick(Sender: TObject);
|
|
begin
|
|
FreeAndNil(QuestionDlgEx_CustomIcon);
|
|
end;
|
|
|
|
procedure TDemoForm.cbDefaultFontChange(Sender: TObject);
|
|
begin
|
|
cbFontName.Enabled := not cbDefaultFont.Checked;
|
|
seFontSize.Enabled := not cbDefaultFont.Checked;
|
|
end;
|
|
|
|
procedure TDemoForm.btnDefaultQuestionDlgClick(Sender: TObject);
|
|
var
|
|
btns: TDialogButtons;
|
|
res: TModalResult;
|
|
|
|
procedure AddBtn(ACaption: String; AKind: TModalResult; ADefault: Boolean = false);
|
|
begin
|
|
with btns.Add do
|
|
begin
|
|
Caption := ACaption;
|
|
ModalResult := AKind;
|
|
Default := ADefault;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
|
|
btns := TDialogButtons.Create(TDialogButton);
|
|
case rgButtons.ItemIndex of
|
|
0: AddBtn('Yes sir', mrYes);
|
|
1: begin
|
|
AddBtn('Yes sir', mrYes);
|
|
AddBtn('No sir', mrNo, true);
|
|
AddBtn('Changed my mind', mrCancel);
|
|
end;
|
|
2: begin
|
|
AddBtn('Yes sir', mrYes);
|
|
AddBtn('I fully agree', mrYesToAll);
|
|
AddBtn('No sir', mrNo, true);
|
|
AddBtn('I fully disagree', mrNoToAll);
|
|
AddBtn('Changed my mind', mrCancel);
|
|
end;
|
|
3: begin
|
|
AddBtn('Yes sir', mrYes);
|
|
AddBtn('I fully agree', mrYesToAll);
|
|
AddBtn('No sir', mrNo, true);
|
|
AddBtn('I fully disagree', mrNoToAll);
|
|
AddBtn('Changed my mind', mrCancel);
|
|
AddBtn('Close it', mrClose);
|
|
AddBtn('Help me', 100);
|
|
end;
|
|
end;
|
|
|
|
res := DefaultQuestionDialog(
|
|
DLG_TITLE,
|
|
MSG_TEXT[rgMessage.ItemIndex],
|
|
rgMsgType.ItemIndex + 1 + idDialogBase,
|
|
btns,
|
|
0
|
|
);
|
|
Caption := GetModalResultStr(res);
|
|
|
|
btns.Free;
|
|
end;
|
|
|
|
procedure TDemoForm.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption := FORM_CAPTION;
|
|
cbFontName.Items.Assign(Screen.Fonts);
|
|
cbFontName.ItemIndex := Max(0, cbFontName.Items.IndexOf('Liberation Sans'));
|
|
cbFontName.Enabled := false;
|
|
seFontSize.Enabled := false;
|
|
end;
|
|
|
|
procedure TDemoForm.rgTextBkColorClick(Sender: TObject);
|
|
begin
|
|
case rgTextBkColor.ItemIndex of
|
|
0: QuestionDlgEx_TextBkColor := clWindow;
|
|
1: QuestionDlgEx_TextBkColor := clBtnFace;
|
|
end;
|
|
end;
|
|
|
|
function TDemoForm.GetModalResultStr(res: TModalResult): String;
|
|
begin
|
|
Result := FORM_CAPTION + ' - ModalResult: ' + {$IF FPC_FullVersion>=30202}System.{$IFEND}UITypes.ModalResultStr[res];
|
|
end;
|
|
|
|
end.
|
|
|