diff --git a/components/exctrls/examples/QuestionDlgEx/demo.lpi b/components/exctrls/examples/QuestionDlgEx/demo.lpi new file mode 100644 index 000000000..27391df98 --- /dev/null +++ b/components/exctrls/examples/QuestionDlgEx/demo.lpi @@ -0,0 +1,86 @@ + + + + + + + + + + + + <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> diff --git a/components/exctrls/examples/QuestionDlgEx/demo.lpr b/components/exctrls/examples/QuestionDlgEx/demo.lpr new file mode 100644 index 000000000..b6881f9bc --- /dev/null +++ b/components/exctrls/examples/QuestionDlgEx/demo.lpr @@ -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. + diff --git a/components/exctrls/examples/QuestionDlgEx/html/index.html b/components/exctrls/examples/QuestionDlgEx/html/index.html new file mode 100644 index 000000000..189f0ed88 --- /dev/null +++ b/components/exctrls/examples/QuestionDlgEx/html/index.html @@ -0,0 +1,6 @@ +<html> +<body> +<p>This is the help file for QuestionDlgEx.</p> +</body> +</html> + diff --git a/components/exctrls/examples/QuestionDlgEx/main.lfm b/components/exctrls/examples/QuestionDlgEx/main.lfm new file mode 100644 index 000000000..08845524f --- /dev/null +++ b/components/exctrls/examples/QuestionDlgEx/main.lfm @@ -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 diff --git a/components/exctrls/examples/QuestionDlgEx/main.pas b/components/exctrls/examples/QuestionDlgEx/main.pas new file mode 100644 index 000000000..3c5fcab35 --- /dev/null +++ b/components/exctrls/examples/QuestionDlgEx/main.pas @@ -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. + diff --git a/components/exctrls/exctrlspkg.lpk b/components/exctrls/exctrlspkg.lpk index 7ef1b82b5..562ceaf56 100644 --- a/components/exctrls/exctrlspkg.lpk +++ b/components/exctrls/exctrlspkg.lpk @@ -19,7 +19,7 @@ - TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images - TColumnComboBoxEx"/> <License Value="LGPL with linking exception (like Lazarus LCL)."/> - <Files Count="6"> + <Files Count="7"> <Item1> <Filename Value="source\excheckctrls.pas"/> <UnitName Value="ExCheckCtrls"/> @@ -45,6 +45,10 @@ <Filename Value="source\excheckcombo.pas"/> <UnitName Value="ExCheckCombo"/> </Item6> + <Item7> + <Filename Value="source\exquestiondlg.pas"/> + <UnitName Value="ExQuestionDlg"/> + </Item7> </Files> <CompatibilityMode Value="True"/> <LazDoc Paths="fpdoc"/> diff --git a/components/exctrls/exctrlspkg.pas b/components/exctrls/exctrlspkg.pas index 997e8d46b..9a06a9daa 100644 --- a/components/exctrls/exctrlspkg.pas +++ b/components/exctrls/exctrlspkg.pas @@ -9,7 +9,7 @@ interface uses ExCheckCtrls, ExEditCtrls, ExCtrlsReg, ExButtons, ExCombo, ExCheckCombo, - LazarusPackageIntf; + ExQuestionDlg, LazarusPackageIntf; implementation diff --git a/components/exctrls/source/exquestiondlg.pas b/components/exctrls/source/exquestiondlg.pas new file mode 100644 index 000000000..bb0d5ff7a --- /dev/null +++ b/components/exctrls/source/exquestiondlg.pas @@ -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. +