You've already forked lazarus-ccr
316 lines
10 KiB
ObjectPascal
316 lines
10 KiB
ObjectPascal
|
unit Main;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
|
||
|
|
Spin, Menus, LazHelpHTML, ExQuestionDlg;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TDemoForm }
|
||
|
|
|
||
|
|
TDemoForm = class(TForm)
|
||
|
|
Bevel1: TBevel;
|
||
|
|
btnQuestionDlgEx: TButton;
|
||
|
|
btnQuestionDlg: TButton;
|
||
|
|
btnMessageDlg: TButton;
|
||
|
|
btnDefaultPromptDlg: TButton;
|
||
|
|
btnDefaultQuestionDlg: TButton;
|
||
|
|
cbDefaultFont: TCheckBox;
|
||
|
|
cbFontName: TComboBox;
|
||
|
|
edX: TEdit;
|
||
|
|
edY: TEdit;
|
||
|
|
FontDialog1: TFontDialog;
|
||
|
|
gbFont: TGroupBox;
|
||
|
|
gbMaxWidth: TGroupBox;
|
||
|
|
gbTest: TGroupBox;
|
||
|
|
gbTestStd: TGroupBox;
|
||
|
|
HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer;
|
||
|
|
HTMLHelpDatabase1: THTMLHelpDatabase;
|
||
|
|
Label1: TLabel;
|
||
|
|
Label2: TLabel;
|
||
|
|
lblResult: TLabel;
|
||
|
|
lblResultStd: TLabel;
|
||
|
|
rgGlyphShowMode: TRadioGroup;
|
||
|
|
rgMsgType: TRadioGroup;
|
||
|
|
rgPosition: TRadioGroup;
|
||
|
|
rgBtnAlignment: TRadioGroup;
|
||
|
|
rgTextAlignment: TRadioGroup;
|
||
|
|
rgButtons: TRadioGroup;
|
||
|
|
rgMessage: TRadioGroup;
|
||
|
|
seMinWidth: TSpinEdit;
|
||
|
|
seFontSize: TSpinEdit;
|
||
|
|
seMaxWidth: TSpinEdit;
|
||
|
|
procedure btnMessageDlgClick(Sender: TObject);
|
||
|
|
procedure btnQuestionDlgExClick(Sender: TObject);
|
||
|
|
procedure btnQuestionDlgClick(Sender: TObject);
|
||
|
|
procedure btnDefaultPromptDlgClick(Sender: TObject);
|
||
|
|
procedure cbDefaultFontChange(Sender: TObject);
|
||
|
|
procedure btnDefaultQuestionDlgClick(Sender: TObject);
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
private
|
||
|
|
function GetModalResultStr(res: TModalResult): String;
|
||
|
|
|
||
|
|
public
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
DemoForm: TDemoForm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{$R *.lfm}
|
||
|
|
|
||
|
|
uses
|
||
|
|
LCLIntf, LCLType, InterfaceBase, TypInfo,
|
||
|
|
{$IF FPC_FullVersion >= 30202}System.{$IFEND}UITypes;
|
||
|
|
|
||
|
|
const
|
||
|
|
DLG_TITLE = 'Meine Anfrage';
|
||
|
|
MSG_TEXT: array[0..4] of String = (
|
||
|
|
'abc',
|
||
|
|
'Kurzer Text.',
|
||
|
|
'Das ist ein einigermaßen langer Text.',
|
||
|
|
'Dies ist ein sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr langer Text',
|
||
|
|
'Dies ist ein sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr sehr langer Text'
|
||
|
|
);
|
||
|
|
|
||
|
|
|
||
|
|
{ TDemoForm }
|
||
|
|
|
||
|
|
procedure TDemoForm.btnQuestionDlgExClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
msg: String;
|
||
|
|
X, Y: Integer;
|
||
|
|
// F: TForm;
|
||
|
|
mt: Dialogs.TMsgDlgType;
|
||
|
|
res: TModalResult;
|
||
|
|
begin
|
||
|
|
lblResult.Caption := '';
|
||
|
|
|
||
|
|
QuestionDlgEx_MaxWidth := seMaxWidth.Value;
|
||
|
|
QuestionDlgEx_MinWidth := seMinWidth.Value;
|
||
|
|
QuestionDlgEx_ButtonAlignment := TAlignment(rgBtnAlignment.ItemIndex);
|
||
|
|
QuestionDlgEx_TextAlignment := TAlignment(rgTextAlignment.ItemIndex);
|
||
|
|
QuestionDlgEx_GlyphShowMode := TGlyphShowMode(rgGlyphShowMode.ItemIndex);
|
||
|
|
if cbDefaultFont.Checked then
|
||
|
|
begin
|
||
|
|
QuestionDlgEx_FontName := 'default';
|
||
|
|
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;
|
||
|
|
|
||
|
|
// if cbDefaultFont.Checked then
|
||
|
|
case rgButtons.ItemIndex of
|
||
|
|
0: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', 'IsCancel'], 'HTML/index.html', X, Y);
|
||
|
|
1: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbNo, 'Nein', 'IsDefault', mbCancel, 'Abbrechen', 'IsCancel'], 'HTML/index.html', X, Y);
|
||
|
|
2: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch', 'IsCancel'], 'HTML/index.html', X, Y);
|
||
|
|
3: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch', 'IsCancel', mbClose, 'Schließen', mbHelp, 'Hilfe'], 'HTML/index.html', X, Y);
|
||
|
|
end;
|
||
|
|
{
|
||
|
|
else begin
|
||
|
|
case rgButtons.ItemIndex of
|
||
|
|
0: F := CreateQuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja'], 0, X, Y);
|
||
|
|
1: F := CreateQuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbNo, 'Nein', 'IsDefault', mbCancel, 'Abbrechen'], 0, X, Y);
|
||
|
|
2: F := CreateQuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch'], 0, X, Y);
|
||
|
|
3: F := CreateQuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch', mbClose, 'Schließen', mbHelp, 'Hilfe'], 0, X, Y);
|
||
|
|
else exit;
|
||
|
|
end;
|
||
|
|
F.Font.Name := cbFontName.Text;
|
||
|
|
F.Font.Size := seFontSize.Value;
|
||
|
|
res := F.ShowModal;
|
||
|
|
F.Free;
|
||
|
|
end;
|
||
|
|
}
|
||
|
|
|
||
|
|
lblResult.Caption := GetModalResultStr(res);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TDemoForm.btnMessageDlgClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
mt: TMsgDlgType;
|
||
|
|
res: TModalResult;
|
||
|
|
msg: String;
|
||
|
|
helpkwd: String;
|
||
|
|
begin
|
||
|
|
lblResultStd.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;
|
||
|
|
lblResultStd.Caption := GetModalResultStr(res);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TDemoForm.btnQuestionDlgClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
mt: TMsgDlgType;
|
||
|
|
res: TModalResult;
|
||
|
|
msg: String;
|
||
|
|
helpkwd: String;
|
||
|
|
begin
|
||
|
|
lblResultStd.Caption := '';
|
||
|
|
mt := TMsgDlgType(rgMsgType.ItemIndex);
|
||
|
|
msg := MSG_TEXT[rgMessage.ItemIndex];
|
||
|
|
helpkwd := 'HTML/index.html';
|
||
|
|
case rgButtons.ItemIndex of
|
||
|
|
0: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Ja'], helpkwd);
|
||
|
|
1: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbNo, 'Nein', 'IsDefault', mbCancel, 'Abbrechen'], helpkwd);
|
||
|
|
2: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch', 'IsCancel'], helpkwd);
|
||
|
|
3: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Ja', mbYesToAll, 'Ja zu allen', mbNo, 'Nein', 'IsDefault', mbNoToAll, 'Nein zu allen', mbCancel, 'Abbruch', 'IsCancel', mbClose, 'Schließen', mbHelp, 'Hilfe'], helpkwd);
|
||
|
|
end;
|
||
|
|
lblResultStd.Caption := GetModalResultStr(res);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TDemoForm.btnDefaultPromptDlgClick(Sender: TObject);
|
||
|
|
const
|
||
|
|
BUTTON_NAMES: array[idButtonOK..idButtonShield] of string = (
|
||
|
|
'idButtonOk', 'idButtonCancel', 'idButtonHelp', 'idButtonYes', 'idButtonNo',
|
||
|
|
'idButtonClose', 'idButtonAbort', 'idButtonRetry', 'idButtonIgnore',
|
||
|
|
'idButtonAll', 'idButtonYesToAll', 'idButtonNoToAll', 'idButtonOpen',
|
||
|
|
'idButtonSave', 'idButtonShield'
|
||
|
|
);
|
||
|
|
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
|
||
|
|
lblResultStd.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!
|
||
|
|
lblResultStd.Caption := 'Result: ' +BUTTON_NAMES[res];
|
||
|
|
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
|
||
|
|
lblResultStd.Caption := '';
|
||
|
|
|
||
|
|
btns := TDialogButtons.Create(TDialogButton);
|
||
|
|
case rgButtons.ItemIndex of
|
||
|
|
0: AddBtn('Ja', mrYes);
|
||
|
|
1: begin
|
||
|
|
AddBtn('Ja', mrYes);
|
||
|
|
AddBtn('Nein', mrNo, true);
|
||
|
|
AddBtn('Abbrechen', mrCancel);
|
||
|
|
end;
|
||
|
|
2: begin
|
||
|
|
AddBtn('Ja', mrYes);
|
||
|
|
AddBtn('Ja zu allen', mrYesToAll);
|
||
|
|
AddBtn('Nein', mrNo, true);
|
||
|
|
AddBtn('Nein zu allen', mrNoToAll);
|
||
|
|
AddBtn('Abbrechen', mrCancel);
|
||
|
|
end;
|
||
|
|
3: begin
|
||
|
|
AddBtn('Ja', mrYes);
|
||
|
|
AddBtn('Ja zu allen', mrYesToAll);
|
||
|
|
AddBtn('Nein', mrNo, true);
|
||
|
|
AddBtn('Nein zu allen', mrNoToAll);
|
||
|
|
AddBtn('Abbrechen', mrCancel);
|
||
|
|
AddBtn('Schließen', mrClose);
|
||
|
|
AddBtn('Hilfe', 100);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
res := DefaultQuestionDialog(
|
||
|
|
DLG_TITLE,
|
||
|
|
MSG_TEXT[rgMessage.ItemIndex],
|
||
|
|
rgMsgType.ItemIndex + 1 + idDialogBase,
|
||
|
|
btns,
|
||
|
|
0
|
||
|
|
);
|
||
|
|
lblResultStd.Caption := GetModalResultStr(res);
|
||
|
|
|
||
|
|
btns.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TDemoForm.FormCreate(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cbFontName.Items.Assign(Screen.Fonts);
|
||
|
|
cbFontName.ItemIndex := cbFontName.Items.IndexOf('Consolas');;
|
||
|
|
cbFontName.Enabled := false;
|
||
|
|
seFontSize.Enabled := false;
|
||
|
|
lblResult.Caption := '';
|
||
|
|
lblResultStd.Caption := '';
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TDemoForm.GetModalResultStr(res: TModalResult): String;
|
||
|
|
begin
|
||
|
|
Result := 'ModalResult: ' + {$IF FPC_FullVersion>=30202}System.{$IFEND}UITypes.ModalResultStr[res];
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|
||
|
|
|