From 17a5b7035b07a6e723cfccabb9390aff4bcc10e7 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 23 Nov 2021 22:29:16 +0000 Subject: [PATCH] exctrls/exquestiondlg: Avoid flicker due to Activate. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8157 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../exctrls/examples/QuestionDlgEx/main.lfm | 382 +++++++++--------- .../exctrls/examples/QuestionDlgEx/main.pas | 35 +- components/exctrls/source/exquestiondlg.pas | 63 ++- 3 files changed, 255 insertions(+), 225 deletions(-) diff --git a/components/exctrls/examples/QuestionDlgEx/main.lfm b/components/exctrls/examples/QuestionDlgEx/main.lfm index dce20758f..843362ff9 100644 --- a/components/exctrls/examples/QuestionDlgEx/main.lfm +++ b/components/exctrls/examples/QuestionDlgEx/main.lfm @@ -2,11 +2,11 @@ object DemoForm: TDemoForm Left = 257 Height = 585 Top = 128 - Width = 708 + Width = 752 AutoSize = True Caption = 'Test QuestionDlgEx' ClientHeight = 585 - ClientWidth = 708 + ClientWidth = 752 OnCreate = FormCreate LCLVersion = '2.3.0.0' object rgButtons: TRadioGroup @@ -16,11 +16,11 @@ object DemoForm: TDemoForm AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = rgMessage AnchorSideBottom.Side = asrBottom - Left = 235 - Height = 96 - Top = 298 + Left = 231 + Height = 108 + Top = 252 Width = 112 - Anchors = [akTop, akLeft, akRight, akBottom] + Anchors = [akLeft, akRight, akBottom] AutoFill = True Caption = 'Buttons' ChildSizing.LeftRightSpacing = 12 @@ -30,7 +30,7 @@ object DemoForm: TDemoForm ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 76 + ClientHeight = 88 ClientWidth = 108 ItemIndex = 1 Items.Strings = ( @@ -42,28 +42,30 @@ object DemoForm: TDemoForm TabOrder = 0 end object rgMessage: TRadioGroup - AnchorSideLeft.Control = gbTest + AnchorSideLeft.Control = gbTextAlignmentLayout AnchorSideTop.Control = gbTextAlignmentLayout AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbTextAlignmentLayout AnchorSideRight.Side = asrBottom - Left = 24 - Height = 96 - Top = 298 - Width = 179 + Left = 16 + Height = 108 + Top = 252 + Width = 191 AutoFill = True AutoSize = True - BorderSpacing.Top = 24 + BorderSpacing.Top = 16 Caption = 'Message' ChildSizing.LeftRightSpacing = 12 + ChildSizing.HorizontalSpacing = 12 + ChildSizing.VerticalSpacing = 4 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 - ClientHeight = 76 - ClientWidth = 175 + ClientHeight = 88 + ClientWidth = 187 Columns = 2 ItemIndex = 2 Items.Strings = ( @@ -78,28 +80,30 @@ object DemoForm: TDemoForm TabOrder = 1 end object gbFont: TGroupBox - AnchorSideLeft.Control = rgBtnAlignment - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Bevel1 - AnchorSideTop.Side = asrBottom + AnchorSideLeft.Control = rgGlyphShowMode + AnchorSideTop.Control = rgBtnAlignment + AnchorSideRight.Control = gbMaxWidth + AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = gbTextAlignmentLayout AnchorSideBottom.Side = asrBottom - Left = 379 + Left = 367 Height = 95 - Top = 179 + Top = 141 Width = 322 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Left = 32 - BorderSpacing.Right = 24 + Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Font' ClientHeight = 75 ClientWidth = 318 TabOrder = 2 object cbDefaultFont: TCheckBox - Left = 22 + AnchorSideLeft.Control = gbFont + AnchorSideTop.Control = gbFont + Left = 24 Height = 19 - Top = 0 + Top = 8 Width = 55 + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 Caption = 'default' Checked = True OnChange = cbDefaultFontChange @@ -107,23 +111,29 @@ object DemoForm: TDemoForm TabOrder = 0 end object cbFontName: TComboBox + AnchorSideLeft.Control = gbFont + AnchorSideTop.Control = cbDefaultFont + AnchorSideTop.Side = asrBottom AnchorSideRight.Control = seFontSize - Left = 22 + Left = 24 Height = 23 - Top = 24 - Width = 206 + Top = 31 + Width = 204 Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 24 + BorderSpacing.Top = 4 BorderSpacing.Right = 16 ItemHeight = 15 TabOrder = 1 Text = 'cbFontName' end object seFontSize: TSpinEdit + AnchorSideTop.Control = cbFontName AnchorSideRight.Control = gbFont AnchorSideRight.Side = asrBottom Left = 244 Height = 23 - Top = 24 + Top = 31 Width = 58 Alignment = taRightJustify Anchors = [akTop, akRight] @@ -133,20 +143,19 @@ object DemoForm: TDemoForm end end object rgBtnAlignment: TRadioGroup - AnchorSideLeft.Control = gbTextAlignmentLayout + AnchorSideLeft.Control = rgMessage AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Bevel1 - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = gbTextAlignmentLayout AnchorSideBottom.Control = gbTextAlignmentLayout AnchorSideBottom.Side = asrBottom - Left = 235 + Left = 231 Height = 95 - Top = 179 + Top = 141 Width = 112 Anchors = [akTop, akLeft, akBottom] AutoFill = True AutoSize = True - BorderSpacing.Left = 32 + BorderSpacing.Left = 24 Caption = 'Button alignment' ChildSizing.LeftRightSpacing = 12 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize @@ -169,29 +178,30 @@ object DemoForm: TDemoForm AnchorSideLeft.Control = rgGlyphShowMode AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = rgGlyphShowMode - AnchorSideRight.Control = gbFont AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = rgGlyphShowMode AnchorSideBottom.Side = asrBottom - Left = 533 - Height = 96 - Top = 298 + Left = 521 + Height = 108 + Top = 252 Width = 168 - Anchors = [akTop, akLeft, akRight, akBottom] + Anchors = [akTop, akLeft, akBottom] + AutoSize = True BorderSpacing.Left = 24 + BorderSpacing.Right = 16 Caption = 'Dialog size limits' - ClientHeight = 76 + ClientHeight = 88 ClientWidth = 164 TabOrder = 4 object Label1: TLabel AnchorSideLeft.Control = gbMaxWidth AnchorSideTop.Control = seMaxWidth AnchorSideTop.Side = asrCenter - Left = 16 + Left = 12 Height = 15 - Top = 16 + Top = 12 Width = 56 - BorderSpacing.Left = 16 + BorderSpacing.Left = 12 Caption = 'Max width' end object seMaxWidth: TSpinEdit @@ -200,25 +210,27 @@ object DemoForm: TDemoForm AnchorSideTop.Control = gbMaxWidth AnchorSideRight.Control = gbMaxWidth AnchorSideRight.Side = asrBottom - Left = 88 + Left = 84 Height = 23 - Top = 12 - Width = 60 + Top = 8 + Width = 64 Alignment = taRightJustify Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 16 - BorderSpacing.Top = 12 + BorderSpacing.Top = 8 BorderSpacing.Right = 16 + Constraints.MinWidth = 64 MaxValue = 10000 TabOrder = 0 Value = 500 end object Label2: TLabel + AnchorSideLeft.Control = Label1 AnchorSideTop.Control = seMinWidth AnchorSideTop.Side = asrCenter - Left = 16 + Left = 12 Height = 15 - Top = 55 + Top = 43 Width = 54 Caption = 'Min width' end @@ -228,13 +240,13 @@ object DemoForm: TDemoForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbMaxWidth AnchorSideRight.Side = asrBottom - Left = 88 + Left = 84 Height = 23 - Top = 51 - Width = 60 + Top = 39 + Width = 64 Alignment = taRightJustify Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 16 + BorderSpacing.Top = 8 BorderSpacing.Right = 16 MaxValue = 10000 TabOrder = 1 @@ -244,14 +256,14 @@ object DemoForm: TDemoForm object rgPosition: TRadioGroup AnchorSideLeft.Control = rgBtnAlignment AnchorSideTop.Control = rgMsgType - AnchorSideRight.Control = gbFont + AnchorSideRight.Control = gbMaxWidth AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = rgMsgType AnchorSideBottom.Side = asrBottom - Left = 235 - Height = 115 - Top = 418 - Width = 466 + Left = 231 + Height = 123 + Top = 376 + Width = 458 Anchors = [akTop, akLeft, akRight, akBottom] AutoFill = True AutoSize = True @@ -265,8 +277,8 @@ object DemoForm: TDemoForm ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 3 - ClientHeight = 95 - ClientWidth = 462 + ClientHeight = 103 + ClientWidth = 454 Columns = 3 ItemIndex = 9 Items.Strings = ( @@ -283,47 +295,48 @@ object DemoForm: TDemoForm ) TabOrder = 5 object edX: TEdit - Left = 162 + Left = 159 Height = 23 - Top = 64 - Width = 142 + Top = 69 + Width = 139 TabOrder = 0 TextHint = 'Enter X value' end object edY: TEdit - Left = 320 + Left = 314 Height = 23 - Top = 64 - Width = 130 + Top = 69 + Width = 128 TabOrder = 1 TextHint = 'Enter Y value' end end object rgMsgType: TRadioGroup - AnchorSideLeft.Control = gbTest + AnchorSideLeft.Control = gbTextAlignmentLayout AnchorSideTop.Control = rgMessage AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbTextAlignmentLayout + AnchorSideRight.Control = rgMessage AnchorSideRight.Side = asrBottom - Left = 24 - Height = 115 - Top = 418 - Width = 179 + Left = 16 + Height = 123 + Top = 376 + Width = 191 Anchors = [akTop, akLeft, akRight] AutoFill = True AutoSize = True - BorderSpacing.Top = 24 - BorderSpacing.Bottom = 24 + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 16 Caption = 'Message type' ChildSizing.LeftRightSpacing = 12 + ChildSizing.VerticalSpacing = 2 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 95 - ClientWidth = 175 + ClientHeight = 103 + ClientWidth = 187 ItemIndex = 0 Items.Strings = ( 'mtWarning' @@ -335,19 +348,19 @@ object DemoForm: TDemoForm TabOrder = 6 end object rgGlyphShowMode: TRadioGroup - AnchorSideLeft.Control = gbFont - AnchorSideTop.Control = gbFont - AnchorSideTop.Side = asrBottom + AnchorSideLeft.Control = rgBtnAlignment + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rgMessage AnchorSideBottom.Control = rgMessage AnchorSideBottom.Side = asrBottom - Left = 379 - Height = 96 - Top = 298 + Left = 367 + Height = 108 + Top = 252 Width = 130 Anchors = [akTop, akLeft, akBottom] AutoFill = True AutoSize = True - BorderSpacing.Top = 24 + BorderSpacing.Left = 24 Caption = 'GlyphShowMode' ChildSizing.LeftRightSpacing = 12 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize @@ -356,7 +369,7 @@ object DemoForm: TDemoForm ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 76 + ClientHeight = 88 ClientWidth = 126 ItemIndex = 2 Items.Strings = ( @@ -367,121 +380,77 @@ object DemoForm: TDemoForm ) TabOrder = 7 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 = 8 - 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' - end - end object gbTestStd: TGroupBox - AnchorSideLeft.Control = gbFont - AnchorSideTop.Control = gbTest - AnchorSideRight.Control = gbFont + AnchorSideLeft.Control = rgGlyphShowMode + AnchorSideTop.Control = Owner + AnchorSideRight.Control = gbMaxWidth AnchorSideRight.Side = asrBottom - Left = 379 - Height = 104 - Top = 24 + Left = 367 + Height = 90 + Top = 16 Width = 322 Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 16 Caption = 'Test standard dialogs' - ClientHeight = 84 + ClientHeight = 70 ClientWidth = 318 - TabOrder = 9 + TabOrder = 8 object btnQuestionDlg: TButton + AnchorSideLeft.Control = gbTestStd AnchorSideTop.Control = gbTestStd - Left = 32 + Left = 16 Height = 25 - Top = 0 + Top = 8 Width = 92 AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 Caption = 'QuestionDlg' OnClick = btnQuestionDlgClick TabOrder = 0 end object btnDefaultQuestionDlg: TButton + AnchorSideLeft.Control = btnQuestionDlg + AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = gbTestStd - Left = 160 + Left = 156 Height = 25 - Top = 0 + Top = 8 Width = 130 AutoSize = True + BorderSpacing.Left = 48 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 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' - end object btnMessageDlg: TButton AnchorSideLeft.Control = btnQuestionDlg AnchorSideTop.Control = btnQuestionDlg AnchorSideTop.Side = asrBottom AnchorSideRight.Control = btnQuestionDlg AnchorSideRight.Side = asrBottom - Left = 32 + Left = 16 Height = 25 - Top = 27 + Top = 37 Width = 92 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 2 + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 8 Caption = 'MessageDlg' OnClick = btnMessageDlgClick TabOrder = 2 end object btnDefaultPromptDlg: TButton AnchorSideLeft.Control = btnDefaultQuestionDlg - AnchorSideTop.Control = btnDefaultQuestionDlg - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = btnMessageDlg AnchorSideRight.Control = btnDefaultQuestionDlg AnchorSideRight.Side = asrBottom - Left = 160 + Left = 156 Height = 25 - Top = 27 + Top = 39 Width = 130 Anchors = [akTop, akLeft, akRight] AutoSize = True @@ -492,35 +461,34 @@ object DemoForm: TDemoForm end end object Bevel1: TBevel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = gbTest + AnchorSideTop.Control = gbTestStd AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner + AnchorSideRight.Control = gbTestStd AnchorSideRight.Side = asrBottom - Left = 24 + Left = 0 Height = 3 - Top = 152 - Width = 660 + Top = 122 + Width = 689 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 24 + BorderSpacing.Top = 16 Shape = bsTopLine end object gbTextAlignmentLayout: TGroupBox - AnchorSideLeft.Control = gbTest + AnchorSideLeft.Control = Owner AnchorSideTop.Control = Bevel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = rgMessage AnchorSideRight.Side = asrBottom - Left = 24 + Left = 16 Height = 95 - Top = 179 - Width = 179 - Anchors = [akTop, akLeft, akRight] - AutoSize = True + Top = 141 + Width = 192 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 Caption = 'Text alignment/layout' ClientHeight = 75 - ClientWidth = 175 - TabOrder = 10 + ClientWidth = 188 + TabOrder = 9 object Panel1: TPanel AnchorSideLeft.Control = gbTextAlignmentLayout AnchorSideTop.Control = gbTextAlignmentLayout @@ -529,20 +497,20 @@ object DemoForm: TDemoForm AnchorSideBottom.Control = gbTextAlignmentLayout AnchorSideBottom.Side = asrBottom Left = 8 - Height = 69 + Height = 65 Top = 0 - Width = 72 + Width = 80 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Left = 8 BorderSpacing.Right = 8 BorderSpacing.Bottom = 6 BevelOuter = bvNone - ChildSizing.VerticalSpacing = 6 + ChildSizing.VerticalSpacing = 4 ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 69 - ClientWidth = 72 + ClientHeight = 65 + ClientWidth = 80 TabOrder = 0 object rbLeftJustify: TRadioButton Left = 0 @@ -558,7 +526,7 @@ object DemoForm: TDemoForm Tag = 2 Left = 0 Height = 19 - Top = 25 + Top = 23 Width = 63 Caption = 'h-center' TabOrder = 0 @@ -567,7 +535,7 @@ object DemoForm: TDemoForm Tag = 1 Left = 0 Height = 19 - Top = 50 + Top = 46 Width = 63 Caption = 'right' TabOrder = 1 @@ -580,7 +548,7 @@ object DemoForm: TDemoForm AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = gbTextAlignmentLayout AnchorSideBottom.Side = asrBottom - Left = 100 + Left = 108 Height = 69 Top = 0 Width = 62 @@ -630,30 +598,62 @@ object DemoForm: TDemoForm AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom - Left = 86 + Left = 92 Height = 69 Top = 0 - Width = 2 + Width = 4 Anchors = [akTop, akLeft, akBottom] + Shape = bsSpacer + end + end + object gbTest: TGroupBox + AnchorSideLeft.Control = gbTextAlignmentLayout + AnchorSideTop.Control = gbTestStd + AnchorSideRight.Control = rgBtnAlignment + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = gbTestStd + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 90 + Top = 16 + Width = 327 + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = 'Test QuestionDlgEx' + ClientHeight = 70 + ClientWidth = 323 + TabOrder = 10 + object btnQuestionDlgEx: TButton + Left = 8 + Height = 54 + Top = 8 + Width = 307 + Align = alClient + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Around = 8 + BorderSpacing.InnerBorder = 8 + Caption = 'QuestionDlgEx' + OnClick = btnQuestionDlgExClick + TabOrder = 0 end end object FontDialog1: TFontDialog MinFontSize = 0 MaxFontSize = 0 - Left = 480 + Left = 584 Top = 136 end - object HTMLHelpDatabase1: THTMLHelpDatabase + object HTMLHelpDatabase: THTMLHelpDatabase BaseURL = 'file://html/' AutoRegister = True KeywordPrefix = 'HTML/' - Left = 136 - Top = 112 + Left = 312 + Top = 80 end - object HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer + object HTMLBrowserHelpViewer: THTMLBrowserHelpViewer BrowserParams = '%s' AutoRegister = True - Left = 240 - Top = 112 + Left = 168 + Top = 80 end end diff --git a/components/exctrls/examples/QuestionDlgEx/main.pas b/components/exctrls/examples/QuestionDlgEx/main.pas index c8a2f95c5..1b45e815c 100644 --- a/components/exctrls/examples/QuestionDlgEx/main.pas +++ b/components/exctrls/examples/QuestionDlgEx/main.pas @@ -27,8 +27,8 @@ type FontDialog1: TFontDialog; gbFont: TGroupBox; gbMaxWidth: TGroupBox; - gbTest: TGroupBox; gbTestStd: TGroupBox; + gbTest: TGroupBox; Panel1: TPanel; Panel2: TPanel; rbLeftJustify: TRadioButton; @@ -38,12 +38,10 @@ type rbVCenter: TRadioButton; rbBottom: TRadioButton; gbTextAlignmentLayout: TGroupBox; - HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer; - HTMLHelpDatabase1: THTMLHelpDatabase; + HTMLBrowserHelpViewer: THTMLBrowserHelpViewer; + HTMLHelpDatabase: THTMLHelpDatabase; Label1: TLabel; Label2: TLabel; - lblResult: TLabel; - lblResultStd: TLabel; rgGlyphShowMode: TRadioGroup; rgMsgType: TRadioGroup; rgPosition: TRadioGroup; @@ -79,6 +77,7 @@ uses {$IF FPC_FullVersion >= 30202}System.{$IFEND}UITypes; const + FORM_CAPTION = 'Test QuestionDlgEx'; DLG_TITLE = 'This is the caption of the dialog'; MSG_TEXT: array[0..6] of String = ( 'msg', @@ -100,8 +99,7 @@ var mt: Dialogs.TMsgDlgType; res: TModalResult; begin - lblResult.Caption := ''; - + Caption := FORM_CAPTION; QuestionDlgEx_MaxWidth := seMaxWidth.Value; QuestionDlgEx_MinWidth := seMinWidth.Value; QuestionDlgEx_ButtonAlignment := TAlignment(rgBtnAlignment.ItemIndex); @@ -151,7 +149,7 @@ begin 3: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel', mbClose, 'Close it', mbHelp, 'I need help'], 'HTML/index.html', X, Y); end; - lblResult.Caption := GetModalResultStr(res); + Caption := GetModalResultStr(res); end; procedure TDemoForm.btnMessageDlgClick(Sender: TObject); @@ -161,7 +159,7 @@ var msg: String; helpkwd: String; begin - lblResultStd.Caption := ''; + Caption := FORM_CAPTION; mt := TMsgDlgType(rgMsgType.ItemIndex); msg := MSG_TEXT[rgMessage.ItemIndex]; helpkwd := 'HTML/index.html'; @@ -173,7 +171,7 @@ begin 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); + Caption := GetModalResultStr(res); end; procedure TDemoForm.btnQuestionDlgClick(Sender: TObject); @@ -183,7 +181,7 @@ var msg: String; helpkwd: String; begin - lblResultStd.Caption := ''; + Caption := FORM_CAPTION; mt := TMsgDlgType(rgMsgType.ItemIndex); msg := MSG_TEXT[rgMessage.ItemIndex]; helpkwd := 'HTML/index.html'; @@ -193,7 +191,7 @@ begin 2: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel'], helpkwd); 3: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel', mbClose, 'Schließen', mbHelp, 'Hilfe'], helpkwd); end; - lblResultStd.Caption := GetModalResultStr(res); + Caption := GetModalResultStr(res); end; procedure TDemoForm.btnDefaultPromptDlgClick(Sender: TObject); @@ -216,7 +214,7 @@ var X, Y: Integer; s: String; begin - lblResultStd.Caption := ''; + Caption := FORM_CAPTION; mt := idDialogBase + 1 + rgMsgType.ItemIndex; msg := MSG_TEXT[rgMessage.ItemIndex]; if not TryStrToInt(edX.Text, X) then X := 0; @@ -230,7 +228,7 @@ begin 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]; + Caption := FORM_CAPTION + '- Result: ' +BUTTON_NAMES[res]; end; procedure TDemoForm.cbDefaultFontChange(Sender: TObject); @@ -255,7 +253,7 @@ var end; begin - lblResultStd.Caption := ''; + Caption := FORM_CAPTION; btns := TDialogButtons.Create(TDialogButton); case rgButtons.ItemIndex of @@ -290,24 +288,23 @@ begin btns, 0 ); - lblResultStd.Caption := GetModalResultStr(res); + Caption := GetModalResultStr(res); btns.Free; end; procedure TDemoForm.FormCreate(Sender: TObject); begin + Caption := FORM_CAPTION; cbFontName.Items.Assign(Screen.Fonts); cbFontName.ItemIndex := Max(0, cbFontName.Items.IndexOf('Liberation Sans')); 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]; + Result := FORM_CAPTION + ' - ModalResult: ' + {$IF FPC_FullVersion>=30202}System.{$IFEND}UITypes.ModalResultStr[res]; end; end. diff --git a/components/exctrls/source/exquestiondlg.pas b/components/exctrls/source/exquestiondlg.pas index 1494e1234..a2ebb5b1e 100644 --- a/components/exctrls/source/exquestiondlg.pas +++ b/components/exctrls/source/exquestiondlg.pas @@ -87,6 +87,9 @@ begin end; type + + { TQForm } + TQForm = class(TForm) private type @@ -112,7 +115,7 @@ type FXPos, FYPos: Integer; procedure SetDialogType(AValue: TMsgDlgType); protected - procedure Activate; override; +// procedure Activate; override; procedure AdjustForm; procedure ApplyButtonAlignment; procedure CreateButtonPanel; @@ -129,6 +132,7 @@ type constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; destructor Destroy; override; procedure AddButtons(const AButtons: array of const); + function ShowModal: TModalResult; override; property ButtonAlignment: TAlignment read FButtonAlignment write FButtonAlignment; property DialogType: TMsgDlgType read FDialogType write SetDialogType; property Msg: String read FText write FText; @@ -141,8 +145,7 @@ type constructor TQForm.CreateNew(AOwner: TComponent; Num: Integer = 0); begin inherited; - BorderStyle := bsSingle; // In gtk2, bsDialog "glues" the dialog to the calling form - BorderIcons := [biSystemMenu]; + BorderStyle := bsDialog; Color := clWindow; PopupMode := pmAuto; @@ -162,13 +165,14 @@ begin inherited; end; +{ procedure TQForm.Activate; begin AdjustForm; SetFormPosition(FXPos, FYPos); inherited; end; - +} procedure TQForm.AddButtons(const AButtons: array of const); const MsgDlgBtnStr : array [0..11] of string = ( @@ -200,7 +204,9 @@ begin btn.Default := (btnParams[i].IsDefaultOrCancel = 1); if btn.Default then ActiveControl := btn; btn.AutoSize := true; - btn.BorderSpacing.Around := Scale96ToFont(BUTTON_SPACING); + btn.BorderSpacing.Left := Scale96ToFont(BUTTON_SPACING); + btn.BorderSpacing.Right := Scale96ToFont(BUTTON_SPACING); +// btn.BorderSpacing.Around := Scale96ToFont(BUTTON_SPACING); if i = 0 then btn.AnchorSideLeft.Control := FInnerButtonPanel else @@ -211,8 +217,6 @@ begin btn.AnchorSideTop.Control := FInnerButtonPanel; FButtons[i] := btn; end; - -// MeasureButtonPanel; end; procedure TQForm.AdjustForm; @@ -245,10 +249,11 @@ begin end; FTextPanel.SetBounds(0, 0, textPanelWidth, textPanelHeight); + FInnerButtonPanel.SetBounds(0, 0, buttonPanelWidth, buttonPanelHeight); FButtonPanel.SetBounds(0, textPanelHeight, textPanelWidth, buttonPanelHeight); - Width := textPanelWidth; - Height := textPanelHeight + buttonPanelHeight; + ClientWidth := textPanelWidth; + ClientHeight := textPanelHeight + buttonPanelHeight; ApplyButtonAlignment; end; @@ -289,9 +294,11 @@ begin begin AnchorSideLeft.Control := FButtonPanel; AnchorSideTop.Control := FButtonPanel; - AnchorSideRight.Control := FButtonPanel; - AnchorSideRight.Side := asrBottom; +// AnchorSideRight.Control := FButtonPanel; +// AnchorSideRight.Side := asrBottom; BevelOuter := bvNone; + BorderSpacing.Top := Scale96ToFont(BUTTON_SPACING); + BorderSpacing.Bottom := Scale96ToFont(BUTTON_SPACING); Caption := ''; AutoSize := true; Parent := FButtonPanel; @@ -317,14 +324,26 @@ begin end; procedure TQForm.MeasureButtonPanel(var AWidth, AHeight: Integer); +var + dy1, dy2: Integer; begin AWidth := 0; AHeight := 0; - FButtonPanel.HandleNeeded; - FButtonPanel.GetPreferredSize(AWidth, AHeight); - if QuestionDlgEx_MinWidth > AWidth then AWidth := QuestionDlgEx_MinWidth; + + FInnerButtonPanel.HandleNeeded; + FInnerButtonPanel.GetPreferredSize(AWidth, AHeight); + + dy1 := Max(FInnerButtonPanel.BorderSpacing.Top, FInnerButtonPanel.BorderSpacing.Around); + dy2 := Max(FInnerButtonPanel.BorderSpacing.Bottom, FInnerButtonPanel.BorderSpacing.Around); + inc(AHeight, dy1 + dy2); + + if QuestionDlgEx_MinWidth > AWidth then + AWidth := QuestionDlgEx_MinWidth; end; +{ Measures width and height of the message text. + The max text width is given as input parameter AWidth. When the text is wider + it is wrapped. } procedure TQForm.MeasureText(var AWidth, AHeight: Integer); var R: TRect; @@ -337,6 +356,13 @@ begin AHeight := R.Bottom; end; +{ Measures the total width and heigth of the text panel including icon and + borders. + Is called twice: + - When Wrapped is false the max width is determine so that wrapping does not + occur. + - When wrapped is true the parameter AWidth on input defines the width into + which the text must fit; when it is wider it is wrapped. } procedure TQForm.MeasureTextPanel(Wrapped: Boolean; var AWidth, AHeight: Integer); var R: TRect; @@ -368,9 +394,10 @@ begin AHeight := QuestionDlgEx_MinHeight; end; +{ The TextPanels OnPaint handler. It draws the icon and the text. } procedure TQForm.PaintTextPanelHandler(Sender: TObject); var - x, y: Integer; + x: Integer; R: TRect; flags: Integer; w, h: Integer; @@ -474,6 +501,12 @@ begin end; end; +function TQForm.ShowModal: TModalResult; +begin + AdjustForm; + SetFormPosition(FXPos, FYPos); + Result := inherited; +end; function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType; const AButtons: array of const; AX, AY: Integer): TForm;