extctrls: Add extended question dialog.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8150 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
efd704f6db
commit
7332a8c1e4
86
components/exctrls/examples/QuestionDlgEx/demo.lpi
Normal file
86
components/exctrls/examples/QuestionDlgEx/demo.lpi
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="12"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<Title Value="demo"/>
|
||||||
|
<Scaled Value="True"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<DpiAware Value="True"/>
|
||||||
|
</XPManifest>
|
||||||
|
</General>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<UseFileFilters Value="True"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="ExCtrlsPkg"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="demo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="main.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="DemoForm"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
<UnitName Value="Main"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="demo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<DebugInfoType Value="dsDwarf2Set"/>
|
||||||
|
</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>
|
||||||
24
components/exctrls/examples/QuestionDlgEx/demo.lpr
Normal file
24
components/exctrls/examples/QuestionDlgEx/demo.lpr
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
program demo;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF HASAMIGA}
|
||||||
|
athreads,
|
||||||
|
{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, Main, ExQuestionDlg;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource:=True;
|
||||||
|
Application.Scaled:=True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TDemoForm, DemoForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
@ -0,0 +1,6 @@
|
|||||||
|
<html>
|
||||||
|
<body>
|
||||||
|
<p>This is the help file for QuestionDlgEx.</p>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
551
components/exctrls/examples/QuestionDlgEx/main.lfm
Normal file
551
components/exctrls/examples/QuestionDlgEx/main.lfm
Normal file
@ -0,0 +1,551 @@
|
|||||||
|
object DemoForm: TDemoForm
|
||||||
|
Left = 257
|
||||||
|
Height = 563
|
||||||
|
Top = 128
|
||||||
|
Width = 686
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Test QuestionDlgEx'
|
||||||
|
ClientHeight = 563
|
||||||
|
ClientWidth = 686
|
||||||
|
OnCreate = FormCreate
|
||||||
|
LCLVersion = '2.0.12.0'
|
||||||
|
object rgButtons: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = rgBtnAlignment
|
||||||
|
AnchorSideTop.Control = rgMessage
|
||||||
|
AnchorSideRight.Control = rgBtnAlignment
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgMessage
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 190
|
||||||
|
Height = 115
|
||||||
|
Top = 280
|
||||||
|
Width = 112
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
AutoFill = True
|
||||||
|
Caption = 'Buttons'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 108
|
||||||
|
ItemIndex = 1
|
||||||
|
Items.Strings = (
|
||||||
|
'1 button'
|
||||||
|
'3 buttons'
|
||||||
|
'5 buttons'
|
||||||
|
'7 buttons'
|
||||||
|
)
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object rgMessage: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = gbTest
|
||||||
|
AnchorSideTop.Control = rgTextAlignment
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = rgMsgType
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 24
|
||||||
|
Height = 115
|
||||||
|
Top = 280
|
||||||
|
Width = 134
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Top = 24
|
||||||
|
Caption = 'Message'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 130
|
||||||
|
ItemIndex = 2
|
||||||
|
Items.Strings = (
|
||||||
|
'very short'
|
||||||
|
'short'
|
||||||
|
'medium'
|
||||||
|
'long'
|
||||||
|
'very long'
|
||||||
|
)
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object gbFont: TGroupBox
|
||||||
|
AnchorSideLeft.Control = rgBtnAlignment
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Bevel1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgTextAlignment
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 334
|
||||||
|
Height = 77
|
||||||
|
Top = 179
|
||||||
|
Width = 322
|
||||||
|
Anchors = [akTop, akLeft, akBottom]
|
||||||
|
BorderSpacing.Left = 32
|
||||||
|
BorderSpacing.Right = 24
|
||||||
|
Caption = 'Font'
|
||||||
|
ClientHeight = 57
|
||||||
|
ClientWidth = 318
|
||||||
|
TabOrder = 2
|
||||||
|
object cbDefaultFont: TCheckBox
|
||||||
|
Left = 22
|
||||||
|
Height = 19
|
||||||
|
Top = 0
|
||||||
|
Width = 57
|
||||||
|
Caption = 'default'
|
||||||
|
Checked = True
|
||||||
|
OnChange = cbDefaultFontChange
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object cbFontName: TComboBox
|
||||||
|
AnchorSideRight.Control = seFontSize
|
||||||
|
Left = 22
|
||||||
|
Height = 23
|
||||||
|
Top = 24
|
||||||
|
Width = 206
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
BorderSpacing.Right = 16
|
||||||
|
ItemHeight = 15
|
||||||
|
TabOrder = 1
|
||||||
|
Text = 'cbFontName'
|
||||||
|
end
|
||||||
|
object seFontSize: TSpinEdit
|
||||||
|
AnchorSideRight.Control = gbFont
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 244
|
||||||
|
Height = 23
|
||||||
|
Top = 24
|
||||||
|
Width = 58
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.Right = 16
|
||||||
|
TabOrder = 2
|
||||||
|
Value = 12
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object rgBtnAlignment: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = rgTextAlignment
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Bevel1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgTextAlignment
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 190
|
||||||
|
Height = 77
|
||||||
|
Top = 179
|
||||||
|
Width = 112
|
||||||
|
Anchors = [akTop, akLeft, akBottom]
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 32
|
||||||
|
Caption = 'Button alignment'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 57
|
||||||
|
ClientWidth = 108
|
||||||
|
ItemIndex = 2
|
||||||
|
Items.Strings = (
|
||||||
|
'left'
|
||||||
|
'right'
|
||||||
|
'center'
|
||||||
|
)
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object rgTextAlignment: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = gbTest
|
||||||
|
AnchorSideTop.Control = Bevel1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = rgMsgType
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 24
|
||||||
|
Height = 77
|
||||||
|
Top = 179
|
||||||
|
Width = 134
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Text alignment'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 57
|
||||||
|
ClientWidth = 130
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'left'
|
||||||
|
'right'
|
||||||
|
'center'
|
||||||
|
)
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
object gbMaxWidth: TGroupBox
|
||||||
|
AnchorSideLeft.Control = rgGlyphShowMode
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = rgGlyphShowMode
|
||||||
|
AnchorSideRight.Control = gbFont
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgGlyphShowMode
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 490
|
||||||
|
Height = 115
|
||||||
|
Top = 280
|
||||||
|
Width = 166
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
BorderSpacing.Left = 24
|
||||||
|
Caption = 'Dialog size limits'
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 162
|
||||||
|
TabOrder = 5
|
||||||
|
object Label1: TLabel
|
||||||
|
AnchorSideLeft.Control = gbMaxWidth
|
||||||
|
AnchorSideTop.Control = seMaxWidth
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 16
|
||||||
|
Width = 56
|
||||||
|
BorderSpacing.Left = 16
|
||||||
|
Caption = 'Max width'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object seMaxWidth: TSpinEdit
|
||||||
|
AnchorSideTop.Control = gbMaxWidth
|
||||||
|
AnchorSideRight.Control = gbMaxWidth
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 88
|
||||||
|
Height = 23
|
||||||
|
Top = 12
|
||||||
|
Width = 58
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.Top = 12
|
||||||
|
BorderSpacing.Right = 16
|
||||||
|
TabOrder = 0
|
||||||
|
Value = 100
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
AnchorSideTop.Control = seMinWidth
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 55
|
||||||
|
Width = 54
|
||||||
|
Caption = 'Min width'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object seMinWidth: TSpinEdit
|
||||||
|
AnchorSideTop.Control = seMaxWidth
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = gbMaxWidth
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 88
|
||||||
|
Height = 23
|
||||||
|
Top = 51
|
||||||
|
Width = 58
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.Top = 16
|
||||||
|
BorderSpacing.Right = 16
|
||||||
|
TabOrder = 1
|
||||||
|
Value = 100
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object rgPosition: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = rgBtnAlignment
|
||||||
|
AnchorSideTop.Control = rgMsgType
|
||||||
|
AnchorSideRight.Control = gbFont
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgMsgType
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 190
|
||||||
|
Height = 115
|
||||||
|
Top = 419
|
||||||
|
Width = 466
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Position'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.TopBottomSpacing = 4
|
||||||
|
ChildSizing.HorizontalSpacing = 16
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 3
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 462
|
||||||
|
Columns = 3
|
||||||
|
ItemIndex = 9
|
||||||
|
Items.Strings = (
|
||||||
|
'poDesigned'
|
||||||
|
'poDefault'
|
||||||
|
'poDefaultPosOnly'
|
||||||
|
'poDefaultSizeOnly'
|
||||||
|
'poScreenCenter'
|
||||||
|
'poDesktopCenter'
|
||||||
|
'poMainFormCenter'
|
||||||
|
'poOwnerFormCenter'
|
||||||
|
'poWorkAreaCenter'
|
||||||
|
'(Custom)'
|
||||||
|
)
|
||||||
|
TabOrder = 6
|
||||||
|
object edX: TEdit
|
||||||
|
Left = 162
|
||||||
|
Height = 23
|
||||||
|
Top = 64
|
||||||
|
Width = 142
|
||||||
|
TabOrder = 0
|
||||||
|
TextHint = 'Enter X value'
|
||||||
|
end
|
||||||
|
object edY: TEdit
|
||||||
|
Left = 320
|
||||||
|
Height = 23
|
||||||
|
Top = 64
|
||||||
|
Width = 130
|
||||||
|
TabOrder = 1
|
||||||
|
TextHint = 'Enter Y value'
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object rgMsgType: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = gbTest
|
||||||
|
AnchorSideTop.Control = rgMessage
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 24
|
||||||
|
Height = 115
|
||||||
|
Top = 419
|
||||||
|
Width = 134
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Top = 24
|
||||||
|
BorderSpacing.Bottom = 24
|
||||||
|
Caption = 'Message type'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 130
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'mtWarning'
|
||||||
|
'mtError'
|
||||||
|
'mtInformation'
|
||||||
|
'mtConfirmation'
|
||||||
|
'mtCustom'
|
||||||
|
)
|
||||||
|
TabOrder = 7
|
||||||
|
end
|
||||||
|
object rgGlyphShowMode: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = gbFont
|
||||||
|
AnchorSideTop.Control = gbFont
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = rgMessage
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 334
|
||||||
|
Height = 115
|
||||||
|
Top = 280
|
||||||
|
Width = 132
|
||||||
|
Anchors = [akTop, akLeft, akBottom]
|
||||||
|
AutoFill = True
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Top = 24
|
||||||
|
Caption = 'GlyphShowMode'
|
||||||
|
ChildSizing.LeftRightSpacing = 12
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 95
|
||||||
|
ClientWidth = 128
|
||||||
|
ItemIndex = 2
|
||||||
|
Items.Strings = (
|
||||||
|
'gsmAlways '
|
||||||
|
'gsmNever '
|
||||||
|
'gsmApplication'
|
||||||
|
'gsmSystem '
|
||||||
|
)
|
||||||
|
TabOrder = 8
|
||||||
|
end
|
||||||
|
object gbTest: TGroupBox
|
||||||
|
AnchorSideLeft.Control = Owner
|
||||||
|
AnchorSideTop.Control = Owner
|
||||||
|
AnchorSideRight.Control = rgBtnAlignment
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 24
|
||||||
|
Height = 104
|
||||||
|
Top = 24
|
||||||
|
Width = 264
|
||||||
|
BorderSpacing.Around = 24
|
||||||
|
Caption = 'Test QuestionDlgEx'
|
||||||
|
ClientHeight = 84
|
||||||
|
ClientWidth = 260
|
||||||
|
TabOrder = 9
|
||||||
|
object btnQuestionDlgEx: TButton
|
||||||
|
AnchorSideLeft.Control = gbTest
|
||||||
|
AnchorSideTop.Control = gbTest
|
||||||
|
AnchorSideRight.Control = gbTest
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = gbTest
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 8
|
||||||
|
Height = 41
|
||||||
|
Top = 8
|
||||||
|
Width = 244
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Around = 8
|
||||||
|
BorderSpacing.InnerBorder = 8
|
||||||
|
Caption = 'QuestionDlgEx'
|
||||||
|
OnClick = btnQuestionDlgExClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object lblResult: TLabel
|
||||||
|
AnchorSideLeft.Control = btnQuestionDlgEx
|
||||||
|
AnchorSideTop.Control = btnQuestionDlgEx
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 57
|
||||||
|
Width = 45
|
||||||
|
Caption = 'lblResult'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbTestStd: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbFont
|
||||||
|
AnchorSideTop.Control = gbTest
|
||||||
|
AnchorSideRight.Control = gbFont
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 334
|
||||||
|
Height = 104
|
||||||
|
Top = 24
|
||||||
|
Width = 322
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
Caption = 'Test standard dialogs'
|
||||||
|
ClientHeight = 84
|
||||||
|
ClientWidth = 318
|
||||||
|
TabOrder = 10
|
||||||
|
object btnQuestionDlg: TButton
|
||||||
|
AnchorSideTop.Control = gbTestStd
|
||||||
|
Left = 32
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 92
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'QuestionDlg'
|
||||||
|
OnClick = btnQuestionDlgClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object btnDefaultQuestionDlg: TButton
|
||||||
|
AnchorSideTop.Control = gbTestStd
|
||||||
|
Left = 160
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 130
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'DefaultQuestionDlg'
|
||||||
|
OnClick = btnDefaultQuestionDlgClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object lblResultStd: TLabel
|
||||||
|
AnchorSideLeft.Control = btnQuestionDlgEx
|
||||||
|
AnchorSideTop.Control = btnQuestionDlgEx
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 57
|
||||||
|
Width = 62
|
||||||
|
Caption = 'lblResultStd'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object btnMessageDlg: TButton
|
||||||
|
AnchorSideLeft.Control = btnQuestionDlg
|
||||||
|
AnchorSideTop.Control = btnQuestionDlg
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = btnQuestionDlg
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 32
|
||||||
|
Height = 25
|
||||||
|
Top = 27
|
||||||
|
Width = 92
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
Caption = 'MessageDlg'
|
||||||
|
OnClick = btnMessageDlgClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object btnDefaultPromptDlg: TButton
|
||||||
|
AnchorSideLeft.Control = btnDefaultQuestionDlg
|
||||||
|
AnchorSideTop.Control = btnDefaultQuestionDlg
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = btnDefaultQuestionDlg
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 160
|
||||||
|
Height = 25
|
||||||
|
Top = 27
|
||||||
|
Width = 130
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
Caption = 'DefaultPromptDlg'
|
||||||
|
OnClick = btnDefaultPromptDlgClick
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Bevel1: TBevel
|
||||||
|
AnchorSideLeft.Control = Owner
|
||||||
|
AnchorSideTop.Control = gbTest
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = Owner
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 24
|
||||||
|
Height = 3
|
||||||
|
Top = 152
|
||||||
|
Width = 638
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
BorderSpacing.Around = 24
|
||||||
|
Shape = bsTopLine
|
||||||
|
end
|
||||||
|
object FontDialog1: TFontDialog
|
||||||
|
MinFontSize = 0
|
||||||
|
MaxFontSize = 0
|
||||||
|
Left = 480
|
||||||
|
Top = 136
|
||||||
|
end
|
||||||
|
object HTMLHelpDatabase1: THTMLHelpDatabase
|
||||||
|
BaseURL = 'file://html/'
|
||||||
|
AutoRegister = True
|
||||||
|
KeywordPrefix = 'HTML/'
|
||||||
|
Left = 136
|
||||||
|
Top = 112
|
||||||
|
end
|
||||||
|
object HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer
|
||||||
|
BrowserParams = '%s'
|
||||||
|
AutoRegister = True
|
||||||
|
Left = 240
|
||||||
|
Top = 112
|
||||||
|
end
|
||||||
|
end
|
||||||
315
components/exctrls/examples/QuestionDlgEx/main.pas
Normal file
315
components/exctrls/examples/QuestionDlgEx/main.pas
Normal file
@ -0,0 +1,315 @@
|
|||||||
|
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.
|
||||||
|
|
||||||
@ -19,7 +19,7 @@
|
|||||||
- TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images
|
- TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images
|
||||||
- TColumnComboBoxEx"/>
|
- TColumnComboBoxEx"/>
|
||||||
<License Value="LGPL with linking exception (like Lazarus LCL)."/>
|
<License Value="LGPL with linking exception (like Lazarus LCL)."/>
|
||||||
<Files Count="6">
|
<Files Count="7">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="source\excheckctrls.pas"/>
|
<Filename Value="source\excheckctrls.pas"/>
|
||||||
<UnitName Value="ExCheckCtrls"/>
|
<UnitName Value="ExCheckCtrls"/>
|
||||||
@ -45,6 +45,10 @@
|
|||||||
<Filename Value="source\excheckcombo.pas"/>
|
<Filename Value="source\excheckcombo.pas"/>
|
||||||
<UnitName Value="ExCheckCombo"/>
|
<UnitName Value="ExCheckCombo"/>
|
||||||
</Item6>
|
</Item6>
|
||||||
|
<Item7>
|
||||||
|
<Filename Value="source\exquestiondlg.pas"/>
|
||||||
|
<UnitName Value="ExQuestionDlg"/>
|
||||||
|
</Item7>
|
||||||
</Files>
|
</Files>
|
||||||
<CompatibilityMode Value="True"/>
|
<CompatibilityMode Value="True"/>
|
||||||
<LazDoc Paths="fpdoc"/>
|
<LazDoc Paths="fpdoc"/>
|
||||||
|
|||||||
@ -9,7 +9,7 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
ExCheckCtrls, ExEditCtrls, ExCtrlsReg, ExButtons, ExCombo, ExCheckCombo,
|
ExCheckCtrls, ExEditCtrls, ExCtrlsReg, ExButtons, ExCombo, ExCheckCombo,
|
||||||
LazarusPackageIntf;
|
ExQuestionDlg, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
540
components/exctrls/source/exquestiondlg.pas
Normal file
540
components/exctrls/source/exquestiondlg.pas
Normal file
@ -0,0 +1,540 @@
|
|||||||
|
{
|
||||||
|
'*******************************************************************************
|
||||||
|
'
|
||||||
|
' Michael Koecher/six1 & Werner Pamler/wp_xyz https://www.lazarusforum.de/
|
||||||
|
'
|
||||||
|
' LGPL2/Linking Exception
|
||||||
|
' oder
|
||||||
|
' http://creativecommons.org/licenses/by-sa/3.0/de/
|
||||||
|
'
|
||||||
|
' Based on post in the German Lazarus forum https://www.lazarusforum.de/
|
||||||
|
'
|
||||||
|
'*******************************************************************************
|
||||||
|
}
|
||||||
|
unit ExQuestionDlg;
|
||||||
|
|
||||||
|
{$mode ObjFPC}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
LclIntf, LclType, Types,
|
||||||
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
|
||||||
|
ExtCtrls, Menus;
|
||||||
|
|
||||||
|
|
||||||
|
// AX, AY >= 0 absolute position
|
||||||
|
//
|
||||||
|
// AX= -ord(poXXXX) and AY = MaxInt
|
||||||
|
// 0 poDesigned, // places form as if AX and AY were not specified (both MaxInt).
|
||||||
|
// -1 poDefault, // LCL decision (normally window manager decides)
|
||||||
|
// -2 poDefaultPosOnly, // designed size and LCL position
|
||||||
|
// -3 poDefaultSizeOnly, // designed position and LCL size
|
||||||
|
// -4 poScreenCenter, // center form on screen (depends on DefaultMonitor)
|
||||||
|
// -5 poDesktopCenter, // center form on desktop (total of all screens)
|
||||||
|
// -6 poMainFormCenter, // center form on main form (depends on DefaultMonitor)
|
||||||
|
// -7 poOwnerFormCenter, // center form on owner form (depends on DefaultMonitor)
|
||||||
|
// -8 poWorkAreaCenter
|
||||||
|
// NOTE: poDefaultXXXX are not working as expected
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AX: Integer = MaxInt; AY: Integer = MaxInt): TModalResult; overload;
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AHelpCtx, AX, AY: Integer): TModalResult; overload;
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AHelpKeyword: String;
|
||||||
|
AX: Integer = MaxInt; AY: Integer= MaxInt): TModalResult; overload;
|
||||||
|
|
||||||
|
function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AX, AY: Integer ): TForm;
|
||||||
|
|
||||||
|
var
|
||||||
|
QuestionDlgEx_MaxWidth: Integer = 500;
|
||||||
|
QuestionDlgEx_MinWidth: Integer = 250;
|
||||||
|
QuestionDlgEx_ButtonAlignment: TAlignment = taCenter;
|
||||||
|
QuestionDlgEx_TextAlignment: TAlignment = taLeftJustify;
|
||||||
|
QuestionDlgEx_FontName: String = '';
|
||||||
|
QuestionDlgEx_FontSize: Integer = 0;
|
||||||
|
QuestionDlgEx_GlyphShowMode: TGlyphShowMode = gsmApplication;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
TypInfo, Math;
|
||||||
|
|
||||||
|
function GetBKType(str:string):TBitBtnKind;
|
||||||
|
var
|
||||||
|
value: Integer;
|
||||||
|
begin
|
||||||
|
value := GetEnumValue(TypeInfo(TBitBtnKind), 'bk' + str);
|
||||||
|
if value > -1 then
|
||||||
|
Result := TBitBtnKind(value)
|
||||||
|
else
|
||||||
|
Result := bkCancel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TQForm = class(TForm)
|
||||||
|
private
|
||||||
|
type
|
||||||
|
TBtnParams = record
|
||||||
|
Caption: string;
|
||||||
|
Kind: integer;
|
||||||
|
IsDefaultOrCancel: Byte; // 1 = IsDefault, 2 = IsCancel
|
||||||
|
end;
|
||||||
|
TBtnParamsArray = array of TBtnParams;
|
||||||
|
private
|
||||||
|
FButtonAlignment: TAlignment;
|
||||||
|
FButtons: array of TBitBtn;
|
||||||
|
FButtonPanel: TPanel;
|
||||||
|
FDialogType: TMsgDlgType;
|
||||||
|
FImage: TImage;
|
||||||
|
FInnerButtonPanel: TPanel;
|
||||||
|
FLabel: TLabel;
|
||||||
|
FTextAlignment: TAlignment;
|
||||||
|
FTextPanel: TPanel;
|
||||||
|
FXPos, FYPos: Integer;
|
||||||
|
function GetMsg: String;
|
||||||
|
procedure SetDialogType(AValue: TMsgDlgType);
|
||||||
|
procedure SetMsg(const AValue: String);
|
||||||
|
protected
|
||||||
|
procedure Activate; override;
|
||||||
|
procedure AdjustFormSizeAndPosition(AX, AY: Integer);
|
||||||
|
procedure ApplyButtonAlignment;
|
||||||
|
procedure ApplyTextAlignment;
|
||||||
|
procedure CreateButtonPanel;
|
||||||
|
procedure CreateImage;
|
||||||
|
procedure CreateLabel;
|
||||||
|
procedure CreateInnerButtonPanel;
|
||||||
|
procedure CreateTextPanel;
|
||||||
|
procedure HelpClickHandler(Sender: TObject);
|
||||||
|
function MeasureButtonPanel: Integer;
|
||||||
|
function MeasureTextPanel: Integer;
|
||||||
|
function PrepareButtons(const AButtons: array of const): TBtnParamsArray;
|
||||||
|
procedure SetFormPosition(AX, AY: Integer);
|
||||||
|
public
|
||||||
|
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
|
||||||
|
procedure AddButtons(const AButtons: array of const);
|
||||||
|
property ButtonAlignment: TAlignment read FButtonAlignment write FButtonAlignment;
|
||||||
|
property DialogType: TMsgDlgType read FDialogType write SetDialogType;
|
||||||
|
property Msg: String read GetMsg write SetMsg;
|
||||||
|
property TextAlignment: TAlignment read FTextAlignment write FTextAlignment;
|
||||||
|
property XPos: Integer read FXPos write FXPos;
|
||||||
|
property YPos: Integer read FYPos write FYPos;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TQForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
BorderStyle := bsDialog;
|
||||||
|
BorderIcons := [biSystemMenu];
|
||||||
|
Color := clWindow;
|
||||||
|
PopupMode := pmAuto;
|
||||||
|
|
||||||
|
CreateTextPanel;
|
||||||
|
CreateImage;
|
||||||
|
CreateLabel;
|
||||||
|
|
||||||
|
CreateButtonPanel;
|
||||||
|
CreateInnerButtonPanel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.Activate;
|
||||||
|
begin
|
||||||
|
AdjustFormSizeAndPosition(FXPos, FYPos);
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.AddButtons(const AButtons: array of const);
|
||||||
|
const
|
||||||
|
MsgDlgBtnStr : array [0..11] of string = (
|
||||||
|
'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore',
|
||||||
|
'All', 'NoToAll', 'YesToAll', 'Help', 'Close'
|
||||||
|
);
|
||||||
|
var
|
||||||
|
btnParams: TBtnParamsArray;
|
||||||
|
i: Integer;
|
||||||
|
btn: TBitBtn;
|
||||||
|
begin
|
||||||
|
// Translate given Buttons into array of button parameters.
|
||||||
|
btnParams := PrepareButtons(AButtons);
|
||||||
|
|
||||||
|
// Create BitBtn's
|
||||||
|
SetLength(FButtons, Length(btnParams));
|
||||||
|
for i := 0 to high(btnParams) do
|
||||||
|
begin
|
||||||
|
btn := TBitBtn.Create(Self);
|
||||||
|
btn.Parent := FInnerButtonPanel;
|
||||||
|
btn.GlyphShowMode := QuestionDlgEx_GlyphShowMode;
|
||||||
|
btn.Kind := GetBKType(MsgDlgBtnStr[btnParams[i].Kind]);
|
||||||
|
if btn.Kind = bkHelp then
|
||||||
|
btn.OnClick := @HelpClickHandler;
|
||||||
|
if trim(btnParams[i].Caption) <> '' then
|
||||||
|
btn.Caption := btnParams[i].Caption;
|
||||||
|
btn.Constraints.MinWidth := 75;
|
||||||
|
btn.Cancel := (btnParams[i].IsDefaultOrCancel = 2);
|
||||||
|
btn.Default := (btnParams[i].IsDefaultOrCancel = 1);
|
||||||
|
if btn.Default then ActiveControl := btn;
|
||||||
|
btn.AutoSize := true;
|
||||||
|
btn.BorderSpacing.Around := 6;
|
||||||
|
if i = 0 then
|
||||||
|
btn.AnchorSideLeft.Control := FInnerButtonPanel
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
btn.AnchorSideLeft.Control := FButtons[i-1];
|
||||||
|
btn.AnchorSideLeft.Side := asrBottom;
|
||||||
|
end;
|
||||||
|
btn.AnchorSideTop.Control := FInnerButtonPanel;
|
||||||
|
FButtons[i] := btn;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// MeasureButtonPanel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.AdjustFormSizeAndPosition(AX, AY: Integer);
|
||||||
|
var
|
||||||
|
buttonPanelWidth, textPanelWidth: Integer;
|
||||||
|
w, h: Integer;
|
||||||
|
begin
|
||||||
|
if (FTextPanel = nil) or (FLabel = nil) or (FButtonPanel = nil) then
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FTextPanel.Anchors := [akLeft, akTop];
|
||||||
|
FLabel.Anchors := [akLeft, akTop];
|
||||||
|
FButtonPanel.Anchors := [akLeft, akTop];
|
||||||
|
|
||||||
|
buttonPanelWidth := MeasureButtonPanel;
|
||||||
|
textPanelWidth := MeasureTextPanel;
|
||||||
|
|
||||||
|
if buttonPanelWidth > textPanelWidth then
|
||||||
|
begin
|
||||||
|
Constraints.MinWidth := buttonPanelWidth;
|
||||||
|
Constraints.MaxWidth := buttonPanelWidth;
|
||||||
|
Width := buttonPanelWidth;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
if textPanelWidth > QuestionDlgEx_MaxWidth then
|
||||||
|
begin
|
||||||
|
if buttonPanelWidth > QuestionDlgEx_Maxwidth then
|
||||||
|
textPanelWidth := buttonPanelWidth
|
||||||
|
else
|
||||||
|
textPanelWidth := QuestionDlgEx_MaxWidth;
|
||||||
|
end;
|
||||||
|
Constraints.MinWidth := textPanelWidth;
|
||||||
|
Constraints.MaxWidth := textPanelWidth;
|
||||||
|
Width := textPanelWidth;
|
||||||
|
end;
|
||||||
|
|
||||||
|
HandleNeeded;
|
||||||
|
AutoSize := true;
|
||||||
|
|
||||||
|
FTextPanel.Anchors := [akLeft, akRight, akTop];
|
||||||
|
FLabel.Anchors := [akLeft, akRight, akTop];
|
||||||
|
FButtonPanel.Anchors := [akLeft, akRight, akTop];
|
||||||
|
|
||||||
|
ApplyButtonAlignment;
|
||||||
|
ApplyTextAlignment;
|
||||||
|
|
||||||
|
SetFormPosition(AX, AY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.ApplyButtonAlignment;
|
||||||
|
begin
|
||||||
|
// Set button and text alignments
|
||||||
|
case FButtonAlignment of
|
||||||
|
taLeftJustify: ;
|
||||||
|
taCenter:
|
||||||
|
FInnerButtonPanel.AnchorSideLeft.Side := asrCenter;
|
||||||
|
taRightJustify:
|
||||||
|
begin
|
||||||
|
FInnerButtonPanel.Anchors := [akTop, akRight];
|
||||||
|
FInnerButtonPanel.AnchorSideRight.Control := FButtonPanel;
|
||||||
|
FInnerButtonPanel.AnchorSideRight.Side := asrRight;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.ApplyTextAlignment;
|
||||||
|
begin
|
||||||
|
FLabel.Alignment := FTextAlignment;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.CreateButtonPanel;
|
||||||
|
begin
|
||||||
|
FButtonPanel := TPanel.Create(Self);
|
||||||
|
with FButtonPanel do
|
||||||
|
begin
|
||||||
|
BevelOuter := bvNone;
|
||||||
|
Caption := '';
|
||||||
|
Color := clBtnFace;
|
||||||
|
AutoSize := true;
|
||||||
|
AnchorSideTop.Control := FTextPanel;
|
||||||
|
AnchorSideTop.Side := asrBottom;
|
||||||
|
AnchorSideLeft.Control := Self;
|
||||||
|
AnchorSideRight.Control := Self;
|
||||||
|
AnchorSideRight.Side := asrBottom;
|
||||||
|
Parent := Self;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.CreateImage;
|
||||||
|
var
|
||||||
|
lSize: TSize;
|
||||||
|
begin
|
||||||
|
lSize.cx := GetSystemMetrics(SM_CXICON);
|
||||||
|
lSize.cy := GetSystemMetrics(SM_CYICON);
|
||||||
|
|
||||||
|
FImage := TImage.Create(Self);
|
||||||
|
with FImage do
|
||||||
|
begin
|
||||||
|
Parent := FTextPanel;
|
||||||
|
AnchorSideTop.Control := FTextPanel;
|
||||||
|
BorderSpacing.Left := 10;
|
||||||
|
BorderSpacing.Top := 5;
|
||||||
|
BorderSpacing.Bottom := 10;
|
||||||
|
Width:= Min(32, lSize.CY);
|
||||||
|
Height:= Min(32, lSize.CY);
|
||||||
|
Transparent := true;
|
||||||
|
Proportional := true;
|
||||||
|
AntialiasingMode := amON;
|
||||||
|
Center := true;
|
||||||
|
if lSize.CX > Width then
|
||||||
|
Stretch := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.CreateLabel;
|
||||||
|
begin
|
||||||
|
FLabel := TLabel.Create(Self);
|
||||||
|
with FLabel do
|
||||||
|
begin
|
||||||
|
Parent := FTextPanel;
|
||||||
|
AnchorSideLeft.Control := FImage;
|
||||||
|
AnchorSideLeft.Side := asrBottom;
|
||||||
|
AnchorSideTop.Control := FTextPanel;
|
||||||
|
AnchorSideTop.Side := asrTop;
|
||||||
|
AnchorSideRight.Control := FTextPanel;
|
||||||
|
AnchorSideRight.Side := asrBottom;
|
||||||
|
BorderSpacing.Around := 10;
|
||||||
|
WordWrap := true;
|
||||||
|
Transparent := true;
|
||||||
|
AutoSize := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.CreateInnerButtonPanel;
|
||||||
|
begin
|
||||||
|
FInnerButtonPanel := TPanel.Create(Self);
|
||||||
|
with FInnerButtonPanel do
|
||||||
|
begin
|
||||||
|
AnchorSideLeft.Control := FButtonPanel;
|
||||||
|
AnchorSideTop.Control := FButtonPanel;
|
||||||
|
AnchorSideRight.Control := FButtonPanel;
|
||||||
|
AnchorSideRight.Side := asrBottom;
|
||||||
|
BevelOuter := bvNone;
|
||||||
|
Caption := '';
|
||||||
|
AutoSize := true;
|
||||||
|
Parent := FButtonPanel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.CreateTextPanel;
|
||||||
|
begin
|
||||||
|
FTextPanel := TPanel.Create(Self);
|
||||||
|
with FTextPanel do
|
||||||
|
begin
|
||||||
|
AnchorSideLeft.Control := Self;
|
||||||
|
AnchorSideTop.Control := Self;
|
||||||
|
AnchorSideRight.Control := Self;
|
||||||
|
AnchorSideRight.Side := asrBottom;
|
||||||
|
BevelOuter := bvNone;
|
||||||
|
Caption := '';
|
||||||
|
Color := clWindow;
|
||||||
|
AutoSize := true;
|
||||||
|
Parent := Self;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TQForm.GetMsg: String;
|
||||||
|
begin
|
||||||
|
Result := FLabel.Caption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.HelpClickHandler(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ShowHelp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TQForm.MeasureButtonPanel: Integer;
|
||||||
|
var
|
||||||
|
h: Integer = 0;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
FButtonPanel.HandleNeeded;
|
||||||
|
FButtonPanel.GetPreferredSize(Result, h);
|
||||||
|
Result := Max(QuestionDlgEx_MinWidth, result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TQForm.MeasureTextPanel: Integer;
|
||||||
|
var
|
||||||
|
h: Integer = 0;
|
||||||
|
savedAutoSize: Boolean;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
savedAutoSize := FTextPanel.AutoSize;
|
||||||
|
FTextPanel.AutoSize := true;
|
||||||
|
FTextPanel.HandleNeeded;
|
||||||
|
FTextPanel.GetPreferredSize(Result, h);
|
||||||
|
Result := Max(QuestionDlgEx_MinWidth, Result);
|
||||||
|
FTextPanel.AutoSize := savedAutoSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TQForm.PrepareButtons(const AButtons: array of const): TBtnParamsArray;
|
||||||
|
var
|
||||||
|
i, n: Integer;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
SetLength(Result, Length(AButtons));
|
||||||
|
n := -1;
|
||||||
|
for i := 0 to high(AButtons) do
|
||||||
|
begin
|
||||||
|
if AButtons[i].VType = vtAnsiString then //text
|
||||||
|
begin
|
||||||
|
if SameText(AButtons[i].VPChar, 'IsDefault') then
|
||||||
|
Result[n].IsDefaultOrCancel := 1
|
||||||
|
else if SameText(AButtons[i].VPChar, 'IsCancel') then
|
||||||
|
Result[n].IsDefaultOrCancel := 2
|
||||||
|
else
|
||||||
|
Result[n].Caption := AButtons[i].VPChar
|
||||||
|
end else
|
||||||
|
if AButtons[i].VType = vtInteger then
|
||||||
|
begin
|
||||||
|
inc(n);
|
||||||
|
Result[n].Kind := AButtons[i].VInteger;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
SetLength(Result, n+1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.SetDialogType(AValue: TMsgDlgType);
|
||||||
|
var
|
||||||
|
iconKind: Integer;
|
||||||
|
bmp: TCustomBitmap;
|
||||||
|
begin
|
||||||
|
FDialogType := AValue;
|
||||||
|
iconKind := idDialogBase + 1 + ord(FDialogType);
|
||||||
|
bmp := GetDialogIcon(iconKind);
|
||||||
|
try
|
||||||
|
FImage.Picture.Assign(bmp);
|
||||||
|
finally
|
||||||
|
bmp.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.SetFormPosition(AX, AY: Integer);
|
||||||
|
const
|
||||||
|
NOT_USED = MaxInt;
|
||||||
|
var
|
||||||
|
R: TRect;
|
||||||
|
begin
|
||||||
|
if (AX < 0) and (AY = MaxInt) then
|
||||||
|
begin
|
||||||
|
Position := TPosition(-AX);
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
R := Monitor.WorkAreaRect;
|
||||||
|
Position := poDesigned;
|
||||||
|
if AY = NOT_USED then // Screen Center Y
|
||||||
|
Top := (R.Top + R.Bottom - Height) div 2
|
||||||
|
else
|
||||||
|
if (AY + Height) <= (Monitor.WorkareaRect.Bottom - 30) then
|
||||||
|
Top := AY
|
||||||
|
else // prevent displaying outside bottom screen border
|
||||||
|
Top := R.Bottom - Height - 30;
|
||||||
|
|
||||||
|
if AX = NOT_USED then // Screen Center X
|
||||||
|
Left := (R.Left + R.Right - Width) div 2
|
||||||
|
else
|
||||||
|
if (AX + Width) <= Monitor.WorkareaRect.Right then
|
||||||
|
Left := AX
|
||||||
|
else // prevent displaying outside right screen border
|
||||||
|
Left := R.Right - Width;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TQForm.SetMsg(const AValue: String);
|
||||||
|
begin
|
||||||
|
FLabel.Caption := AValue;
|
||||||
|
// MeasureTextPanel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AX, AY: Integer): TForm;
|
||||||
|
var
|
||||||
|
QForm: TQForm;
|
||||||
|
begin
|
||||||
|
QForm := TQForm.CreateNew(Screen.ActiveCustomForm);
|
||||||
|
QForm.Font.Name := QuestionDlgEx_FontName;
|
||||||
|
QForm.Font.Size := QuestionDlgEx_FontSize;
|
||||||
|
QForm.ButtonAlignment := QuestionDlgEx_ButtonAlignment;
|
||||||
|
QForm.TextAlignment := QuestionDlgEx_TextAlignment;
|
||||||
|
QForm.Caption := ACaption;
|
||||||
|
QForm.DialogType := ADlgtype;
|
||||||
|
QForm.Msg := AMsg;
|
||||||
|
QForm.AddButtons(AButtons);
|
||||||
|
QForm.XPos := AX;
|
||||||
|
QForm.YPos := AY;
|
||||||
|
Result := QForm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AX: Integer = MaxInt; AY: Integer = MaxInt): TModalResult;
|
||||||
|
var
|
||||||
|
QForm: TForm;
|
||||||
|
begin
|
||||||
|
QForm := CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, AX, AY);
|
||||||
|
try
|
||||||
|
result := QForm.ShowModal;
|
||||||
|
finally
|
||||||
|
FreeAndNil(QForm);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AHelpCtx, AX, AY: Integer): TModalResult;
|
||||||
|
var
|
||||||
|
QForm: TForm;
|
||||||
|
begin
|
||||||
|
QForm := CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, AX, AY);
|
||||||
|
try
|
||||||
|
QForm.HelpContext := AHelpCtx;
|
||||||
|
result := QForm.ShowModal;
|
||||||
|
finally
|
||||||
|
FreeAndNil(QForm);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||||
|
const AButtons: array of const; AHelpKeyword: String;
|
||||||
|
AX: Integer = MaxInt; AY: Integer= MaxInt): TModalResult; overload;
|
||||||
|
var
|
||||||
|
QForm: TForm;
|
||||||
|
begin
|
||||||
|
QForm:=CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, AX, AY);
|
||||||
|
try
|
||||||
|
QForm.HelpKeyword := AHelpKeyword;
|
||||||
|
result := QForm.ShowModal;
|
||||||
|
finally
|
||||||
|
FreeAndNil(QForm);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user