mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-08 06:20:51 +02:00
GTK3: Added example application to help debugging GTK3 dialog boxes.
Closes #39435.
This commit is contained in:
Abou Al Montacir
parent
189a26739f
commit
4d53a927bb
138
examples/messageboxes/testmsgboxes.lpi
Normal file
138
examples/messageboxes/testmsgboxes.lpi
Normal file
@ -0,0 +1,138 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="Test message-boxes"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
</General>
|
||||
<BuildModes Count="3">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
<Item2 Name="gtk3">
|
||||
<MacroValues Count="1">
|
||||
<Macro1 Name="LCLWidgetType" Value="gtk3"/>
|
||||
</MacroValues>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testmsgboxes"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
<Item3 Name="qt5">
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="qt5"/>
|
||||
</MacroValues>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testmsgboxes"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</Item3>
|
||||
<SharedMatrixOptions Count="2">
|
||||
<Item1 ID="457214733240" Modes="gtk3" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk3"/>
|
||||
<Item2 ID="686369672140" Modes="qt5" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt5"/>
|
||||
</SharedMatrixOptions>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="testmsgboxes.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testmsgboxes"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
23
examples/messageboxes/testmsgboxes.lpr
Normal file
23
examples/messageboxes/testmsgboxes.lpr
Normal file
@ -0,0 +1,23 @@
|
||||
program testmsgboxes;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Title:='Test message-boxes';
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
266
examples/messageboxes/unit1.lfm
Normal file
266
examples/messageboxes/unit1.lfm
Normal file
@ -0,0 +1,266 @@
|
||||
object Form1: TForm1
|
||||
Left = 781
|
||||
Height = 481
|
||||
Top = 193
|
||||
Width = 585
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Test for various message-boxes'
|
||||
ClientHeight = 481
|
||||
ClientWidth = 585
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '2.1.0.0'
|
||||
object EditCaption: TEdit
|
||||
Left = 104
|
||||
Height = 33
|
||||
Top = 8
|
||||
Width = 472
|
||||
TabOrder = 0
|
||||
Text = 'StrCaption'
|
||||
end
|
||||
object EditMessage: TEdit
|
||||
Left = 104
|
||||
Height = 33
|
||||
Top = 40
|
||||
Width = 472
|
||||
TabOrder = 1
|
||||
Text = 'StrMessage'
|
||||
end
|
||||
object Label1: TLabel
|
||||
AnchorSideTop.Control = EditCaption
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 16
|
||||
Width = 57
|
||||
Caption = 'Caption:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
AnchorSideTop.Control = EditMessage
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 48
|
||||
Width = 63
|
||||
Caption = 'Message:'
|
||||
ParentColor = False
|
||||
end
|
||||
object ButtonClose: TButton
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 479
|
||||
Height = 33
|
||||
Top = 442
|
||||
Width = 100
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Close'
|
||||
Constraints.MinWidth = 100
|
||||
OnClick = ButtonCloseClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object ButtonAppMsgbox: TButton
|
||||
Left = 152
|
||||
Height = 25
|
||||
Top = 256
|
||||
Width = 264
|
||||
Caption = 'Application.MessageBox'
|
||||
OnClick = ButtonAppMsgboxClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 8
|
||||
Height = 170
|
||||
Top = 72
|
||||
Width = 217
|
||||
Caption = 'Button flags'
|
||||
ClientHeight = 152
|
||||
ClientWidth = 215
|
||||
TabOrder = 2
|
||||
object CheckFlag_Ok: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 75
|
||||
Caption = 'MB_OK'
|
||||
TabOrder = 3
|
||||
end
|
||||
object CheckFlag_OkCancel: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 130
|
||||
Caption = 'MB_OKCANCEL'
|
||||
Checked = True
|
||||
TabOrder = 5
|
||||
TabStop = True
|
||||
end
|
||||
object CheckFlag_YesNo: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 102
|
||||
Caption = 'MB_YESNO'
|
||||
TabOrder = 0
|
||||
end
|
||||
object CheckFlag_YesNoCancel: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 72
|
||||
Width = 157
|
||||
Caption = 'MB_YESNOCANCEL'
|
||||
TabOrder = 1
|
||||
end
|
||||
object CheckFlag_RetryCancel: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 96
|
||||
Width = 152
|
||||
Caption = 'MB_RETRYCANCEL'
|
||||
TabOrder = 2
|
||||
end
|
||||
object CheckFlag_AbortRetryIgnore: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 120
|
||||
Width = 198
|
||||
Caption = 'MB_ABORTRETRYIGNORE'
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
object ButtonLCLIntfMsgbox: TButton
|
||||
Left = 152
|
||||
Height = 25
|
||||
Top = 288
|
||||
Width = 264
|
||||
Caption = 'LCLIntf.MessageBox'
|
||||
OnClick = ButtonLCLIntfMsgboxClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 232
|
||||
Height = 169
|
||||
Top = 72
|
||||
Width = 225
|
||||
Caption = 'Icon flags'
|
||||
ClientHeight = 151
|
||||
ClientWidth = 223
|
||||
TabOrder = 3
|
||||
object CheckFlag_Info: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 189
|
||||
Caption = 'MB_ICONINFORMATION'
|
||||
Checked = True
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
end
|
||||
object CheckFlag_Warn: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 158
|
||||
Caption = 'MB_ICONWARNING'
|
||||
TabOrder = 2
|
||||
end
|
||||
object CheckFlag_Error: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 136
|
||||
Caption = 'MB_ICONERROR'
|
||||
TabOrder = 3
|
||||
end
|
||||
object CheckFlag_Ask: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 72
|
||||
Width = 161
|
||||
Caption = 'MB_ICONQUESTION'
|
||||
TabOrder = 4
|
||||
end
|
||||
object CheckFlag_NoneIcon: TRadioButton
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 96
|
||||
Width = 59
|
||||
Caption = 'none'
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object ButtonMsgDlg: TButton
|
||||
Left = 152
|
||||
Height = 25
|
||||
Top = 320
|
||||
Width = 264
|
||||
Caption = 'MessageDlg'
|
||||
OnClick = ButtonMsgDlgClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object GroupBox3: TGroupBox
|
||||
Left = 463
|
||||
Height = 168
|
||||
Top = 72
|
||||
Width = 113
|
||||
Caption = 'Def button'
|
||||
ClientHeight = 150
|
||||
ClientWidth = 111
|
||||
TabOrder = 4
|
||||
object CheckFlag_B1: TRadioButton
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 34
|
||||
Caption = '1'
|
||||
Checked = True
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
end
|
||||
object CheckFlag_B2: TRadioButton
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 34
|
||||
Caption = '2'
|
||||
TabOrder = 1
|
||||
end
|
||||
object CheckFlag_B3: TRadioButton
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 34
|
||||
Caption = '3'
|
||||
TabOrder = 2
|
||||
end
|
||||
object CheckFlag_B4: TRadioButton
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 72
|
||||
Width = 34
|
||||
Caption = '4'
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
object ButtonPromptUser: TButton
|
||||
Left = 152
|
||||
Height = 25
|
||||
Top = 352
|
||||
Width = 264
|
||||
Caption = 'PromptUser'
|
||||
OnClick = ButtonPromptUserClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object ButtonAskUser: TButton
|
||||
Left = 152
|
||||
Height = 25
|
||||
Top = 384
|
||||
Width = 264
|
||||
Caption = 'AskUser (ignore flags)'
|
||||
OnClick = ButtonAskUserClick
|
||||
TabOrder = 10
|
||||
end
|
||||
end
|
||||
381
examples/messageboxes/unit1.pas
Normal file
381
examples/messageboxes/unit1.pas
Normal file
@ -0,0 +1,381 @@
|
||||
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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user