mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-11 09:38:52 +02:00
382 lines
8.1 KiB
ObjectPascal
382 lines
8.1 KiB
ObjectPascal
unit Unit1;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
|
|
|
|
type
|
|
TIntArray = array of Longint;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
ButtonAskUser: TButton;
|
|
ButtonPromptUser: TButton;
|
|
ButtonAppMsgbox: TButton;
|
|
ButtonLCLIntfMsgbox: TButton;
|
|
ButtonMsgDlg: TButton;
|
|
CheckFlag_AbortRetryIgnore: TRadioButton;
|
|
CheckFlag_Ok: TRadioButton;
|
|
CheckFlag_OkCancel: TRadioButton;
|
|
CheckFlag_RetryCancel: TRadioButton;
|
|
CheckFlag_YesNo: TRadioButton;
|
|
CheckFlag_YesNoCancel: TRadioButton;
|
|
EditCaption: TEdit;
|
|
EditMessage: TEdit;
|
|
GroupBox1: TGroupBox;
|
|
GroupBox2: TGroupBox;
|
|
GroupBox3: TGroupBox;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
ButtonClose: TButton;
|
|
CheckFlag_Info: TRadioButton;
|
|
CheckFlag_Warn: TRadioButton;
|
|
CheckFlag_Error: TRadioButton;
|
|
CheckFlag_Ask: TRadioButton;
|
|
CheckFlag_NoneIcon: TRadioButton;
|
|
CheckFlag_B1: TRadioButton;
|
|
CheckFlag_B2: TRadioButton;
|
|
CheckFlag_B3: TRadioButton;
|
|
CheckFlag_B4: TRadioButton;
|
|
procedure ButtonAppMsgboxClick(Sender: TObject);
|
|
procedure ButtonAskUserClick(Sender: TObject);
|
|
procedure ButtonCloseClick(Sender: TObject);
|
|
procedure ButtonLCLIntfMsgboxClick(Sender: TObject);
|
|
procedure ButtonMsgDlgClick(Sender: TObject);
|
|
procedure ButtonPromptUserClick(Sender: TObject);
|
|
private
|
|
function GetMsgFlags: integer;
|
|
function GetDlgType: TMsgDlgType;
|
|
function GetDlgButtons: TMsgDlgButtons;
|
|
function GetDlgTypeInt: integer;
|
|
function GetBtnArray: TIntArray;
|
|
function ButtonIdToString(N: integer): string;
|
|
function ButtonAltIdToString(N: integer): string;
|
|
|
|
public
|
|
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
uses
|
|
LCLType, LCLProc, LCLIntf, InterfaceBase, System.UITypes;
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.ButtonCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
function TForm1.GetMsgFlags: integer;
|
|
begin
|
|
Result:= 0;
|
|
|
|
if CheckFlag_Ok.Checked then
|
|
Result:= MB_OK
|
|
else
|
|
if CheckFlag_OkCancel.Checked then
|
|
Result:= MB_OKCANCEL
|
|
else
|
|
if CheckFlag_YesNo.Checked then
|
|
Result:= MB_YESNO
|
|
else
|
|
if CheckFlag_YesNoCancel.Checked then
|
|
Result:= MB_YESNOCANCEL
|
|
else
|
|
if CheckFlag_RetryCancel.Checked then
|
|
Result:= MB_RETRYCANCEL
|
|
else
|
|
if CheckFlag_AbortRetryIgnore.Checked then
|
|
Result:= MB_ABORTRETRYIGNORE;
|
|
|
|
if CheckFlag_Info.Checked then
|
|
Inc(Result, MB_ICONINFORMATION)
|
|
else
|
|
if CheckFlag_Warn.Checked then
|
|
Inc(Result, MB_ICONWARNING)
|
|
else
|
|
if CheckFlag_Error.Checked then
|
|
Inc(Result, MB_ICONERROR)
|
|
else
|
|
if CheckFlag_Ask.Checked then
|
|
Inc(Result, MB_ICONQUESTION);
|
|
|
|
if CheckFlag_B1.Checked then
|
|
Inc(Result, MB_DEFBUTTON1)
|
|
else
|
|
if CheckFlag_B2.Checked then
|
|
Inc(Result, MB_DEFBUTTON2)
|
|
else
|
|
if CheckFlag_B3.Checked then
|
|
Inc(Result, MB_DEFBUTTON3)
|
|
else
|
|
if CheckFlag_B4.Checked then
|
|
Inc(Result, MB_DEFBUTTON4);
|
|
end;
|
|
|
|
function TForm1.GetDlgType: TMsgDlgType;
|
|
begin
|
|
if CheckFlag_Info.Checked then
|
|
Result:= mtInformation
|
|
else
|
|
if CheckFlag_Warn.Checked then
|
|
Result:= mtWarning
|
|
else
|
|
if CheckFlag_Error.Checked then
|
|
Result:= mtError
|
|
else
|
|
if CheckFlag_Ask.Checked then
|
|
Result:= mtConfirmation
|
|
else
|
|
Result:= mtCustom;
|
|
end;
|
|
|
|
function TForm1.GetDlgButtons: TMsgDlgButtons;
|
|
begin
|
|
if CheckFlag_Ok.Checked then
|
|
Result:= [mbOk]
|
|
else
|
|
if CheckFlag_OkCancel.Checked then
|
|
Result:= mbOKCancel
|
|
else
|
|
if CheckFlag_YesNo.Checked then
|
|
Result:= mbYesNo
|
|
else
|
|
if CheckFlag_YesNoCancel.Checked then
|
|
Result:= mbYesNoCancel
|
|
else
|
|
if CheckFlag_RetryCancel.Checked then
|
|
Result:= [mbRetry, mbCancel]
|
|
else
|
|
if CheckFlag_AbortRetryIgnore.Checked then
|
|
Result:= mbAbortRetryIgnore
|
|
else
|
|
Result:= [mbOk];
|
|
end;
|
|
|
|
function TForm1.GetDlgTypeInt: integer;
|
|
begin
|
|
if CheckFlag_Info.Checked then
|
|
Result:= idDialogInfo
|
|
else
|
|
if CheckFlag_Warn.Checked then
|
|
Result:= idDialogWarning
|
|
else
|
|
if CheckFlag_Error.Checked then
|
|
Result:= idDialogError
|
|
else
|
|
if CheckFlag_Ask.Checked then
|
|
Result:= idDialogConfirm
|
|
else
|
|
Result:= 0;
|
|
end;
|
|
|
|
function TForm1.GetBtnArray: TIntArray;
|
|
begin
|
|
SetLength(Result, 0);
|
|
if CheckFlag_Ok.Checked then
|
|
begin
|
|
SetLength(Result, 1);
|
|
Result[0]:= idButtonOk;
|
|
end
|
|
else
|
|
if CheckFlag_OkCancel.Checked then
|
|
begin
|
|
SetLength(Result, 2);
|
|
Result[0]:= idButtonOk;
|
|
Result[1]:= idButtonCancel;
|
|
end
|
|
else
|
|
if CheckFlag_YesNo.Checked then
|
|
begin
|
|
SetLength(Result, 2);
|
|
Result[0]:= idButtonYes;
|
|
Result[1]:= idButtonNo;
|
|
end
|
|
else
|
|
if CheckFlag_YesNoCancel.Checked then
|
|
begin
|
|
SetLength(Result, 3);
|
|
Result[0]:= idButtonYes;
|
|
Result[1]:= idButtonNo;
|
|
Result[2]:= idButtonCancel;
|
|
end
|
|
else
|
|
if CheckFlag_RetryCancel.Checked then
|
|
begin
|
|
SetLength(Result, 2);
|
|
Result[0]:= idButtonRetry;
|
|
Result[1]:= idButtonCancel;
|
|
end
|
|
else
|
|
if CheckFlag_AbortRetryIgnore.Checked then
|
|
begin
|
|
SetLength(Result, 3);
|
|
Result[0]:= idButtonAbort;
|
|
Result[1]:= idButtonRetry;
|
|
Result[2]:= idButtonIgnore;
|
|
end;
|
|
end;
|
|
|
|
function TForm1.ButtonIdToString(N: integer): string;
|
|
begin
|
|
case N of
|
|
ID_OK: Result:= 'ID_OK';
|
|
ID_CANCEL: Result:= 'ID_CANCEL';
|
|
ID_YES: Result:= 'ID_YES';
|
|
ID_NO: Result:= 'ID_NO';
|
|
ID_RETRY: Result:= 'ID_RETRY';
|
|
ID_IGNORE: Result:= 'ID_IGNORE';
|
|
ID_ABORT: Result:= 'ID_ABORT';
|
|
ID_CLOSE: Result:= 'ID_CLOSE';
|
|
ID_HELP: Result:= 'ID_HELP';
|
|
else Result:= IntToStr(N);
|
|
end;
|
|
end;
|
|
|
|
function TForm1.ButtonAltIdToString(N: integer): string;
|
|
begin
|
|
case N of
|
|
idButtonOk: Result:= 'idButtonOk';
|
|
idButtonCancel: Result:= 'idButtonCancel';
|
|
idButtonYes: Result:= 'idButtonYes';
|
|
idButtonNo: Result:= 'idButtonNo';
|
|
idButtonRetry: Result:= 'idButtonRetry';
|
|
idButtonIgnore: Result:= 'idButtonIgnore';
|
|
idButtonAbort: Result:= 'idButtonAbort';
|
|
idButtonClose: Result:= 'idButtonClose';
|
|
idButtonHelp: Result:= 'idButtonHelp';
|
|
else Result:= IntToStr(N);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ButtonAppMsgboxClick(Sender: TObject);
|
|
var
|
|
N: integer;
|
|
begin
|
|
N:= Application.MessageBox(
|
|
PChar(EditMessage.Text),
|
|
PChar(EditCaption.Text),
|
|
GetMsgFlags);
|
|
Caption:= 'Application.MessageBox() returned '+ButtonIdToString(N);
|
|
end;
|
|
|
|
procedure TForm1.ButtonAskUserClick(Sender: TObject);
|
|
var
|
|
Buttons: TDialogButtons;
|
|
N: integer;
|
|
NDef: integer;
|
|
begin
|
|
NDef:= -1;
|
|
if CheckFlag_B1.Checked then
|
|
NDef:= 0
|
|
else
|
|
if CheckFlag_B2.Checked then
|
|
NDef:= 1
|
|
else
|
|
if CheckFlag_B3.Checked then
|
|
NDef:= 2
|
|
else
|
|
if CheckFlag_B4.Checked then
|
|
NDef:= 3;
|
|
|
|
Buttons:= TDialogButtons.Create(TDialogButton);
|
|
with Buttons.Add do
|
|
begin
|
|
Caption:= '<ok>';
|
|
ModalResult:= mrOk;
|
|
end;
|
|
with Buttons.Add do
|
|
begin
|
|
Caption:= '<cancel>';
|
|
ModalResult:= mrCancel;
|
|
end;
|
|
with Buttons.Add do
|
|
begin
|
|
Caption:= '<yes>';
|
|
ModalResult:= mrYes;
|
|
end;
|
|
with Buttons.Add do
|
|
begin
|
|
Caption:= '<no>';
|
|
ModalResult:= mrNo;
|
|
end;
|
|
with Buttons.Add do
|
|
begin
|
|
Caption:= '<ignore>';
|
|
ModalResult:= mrIgnore;
|
|
end;
|
|
|
|
if (NDef>=0) and (NDef<Buttons.Count) then
|
|
Buttons.DefaultButton:= Buttons[NDef];
|
|
|
|
N:= AskUser(
|
|
EditCaption.Text,
|
|
EditMessage.Text,
|
|
GetDlgTypeInt,
|
|
Buttons,
|
|
0);
|
|
FreeAndNil(Buttons);
|
|
|
|
Caption:= 'AskUser() returned '+ButtonIdToString(N);
|
|
end;
|
|
|
|
procedure TForm1.ButtonLCLIntfMsgboxClick(Sender: TObject);
|
|
var
|
|
N: integer;
|
|
begin
|
|
N:= LCLIntf.MessageBox(Handle,
|
|
PChar(EditMessage.Text),
|
|
PChar(EditCaption.Text),
|
|
GetMsgFlags
|
|
);
|
|
Caption:= 'LCLIntf.MessageBox() returned '+ButtonIdToString(N);
|
|
end;
|
|
|
|
procedure TForm1.ButtonMsgDlgClick(Sender: TObject);
|
|
var
|
|
Res: TModalResult;
|
|
begin
|
|
Res:= MessageDlg(
|
|
EditCaption.Text,
|
|
EditMessage.Text,
|
|
GetDlgType,
|
|
GetDlgButtons,
|
|
0);
|
|
Caption:= 'MessageDlg() returned '+ModalResultStr[Res];
|
|
end;
|
|
|
|
procedure TForm1.ButtonPromptUserClick(Sender: TObject);
|
|
var
|
|
Btn: array of Longint;
|
|
N: integer;
|
|
begin
|
|
Btn:= GetBtnArray;
|
|
if Length(Btn)=0 then exit;
|
|
|
|
N:= PromptUser(
|
|
EditCaption.Text,
|
|
EditMessage.Text,
|
|
GetDlgTypeInt,
|
|
@Btn[0],
|
|
Length(Btn),
|
|
0,
|
|
0);
|
|
Caption:= 'PromptUser() returned '+ButtonAltIdToString(N);
|
|
end;
|
|
|
|
end.
|
|
|