From cb744ff5de84ae99e5c21cb00164a881211e04a0 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 24 Nov 2021 20:28:10 +0000 Subject: [PATCH] ExCtrls/QuestionDlgEx: Add variable for text background color. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8158 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../exctrls/examples/QuestionDlgEx/main.lfm | 76 +++++++++++++------ .../exctrls/examples/QuestionDlgEx/main.pas | 61 ++++++++++----- components/exctrls/source/exquestiondlg.pas | 18 ++--- 3 files changed, 100 insertions(+), 55 deletions(-) diff --git a/components/exctrls/examples/QuestionDlgEx/main.lfm b/components/exctrls/examples/QuestionDlgEx/main.lfm index 843362ff9..6afb87520 100644 --- a/components/exctrls/examples/QuestionDlgEx/main.lfm +++ b/components/exctrls/examples/QuestionDlgEx/main.lfm @@ -18,7 +18,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 231 Height = 108 - Top = 252 + Top = 244 Width = 112 Anchors = [akLeft, akRight, akBottom] AutoFill = True @@ -49,11 +49,11 @@ object DemoForm: TDemoForm AnchorSideRight.Side = asrBottom Left = 16 Height = 108 - Top = 252 + Top = 244 Width = 191 AutoFill = True AutoSize = True - BorderSpacing.Top = 16 + BorderSpacing.Top = 12 Caption = 'Message' ChildSizing.LeftRightSpacing = 12 ChildSizing.HorizontalSpacing = 12 @@ -88,7 +88,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 367 Height = 95 - Top = 141 + Top = 137 Width = 322 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Font' @@ -150,7 +150,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 231 Height = 95 - Top = 141 + Top = 137 Width = 112 Anchors = [akTop, akLeft, akBottom] AutoFill = True @@ -183,7 +183,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 521 Height = 108 - Top = 252 + Top = 244 Width = 168 Anchors = [akTop, akLeft, akBottom] AutoSize = True @@ -262,7 +262,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 231 Height = 123 - Top = 376 + Top = 364 Width = 458 Anchors = [akTop, akLeft, akRight, akBottom] AutoFill = True @@ -319,13 +319,12 @@ object DemoForm: TDemoForm AnchorSideRight.Side = asrBottom Left = 16 Height = 123 - Top = 376 + Top = 364 Width = 191 Anchors = [akTop, akLeft, akRight] AutoFill = True AutoSize = True - BorderSpacing.Top = 16 - BorderSpacing.Bottom = 16 + BorderSpacing.Top = 12 Caption = 'Message type' ChildSizing.LeftRightSpacing = 12 ChildSizing.VerticalSpacing = 2 @@ -355,7 +354,7 @@ object DemoForm: TDemoForm AnchorSideBottom.Side = asrBottom Left = 367 Height = 108 - Top = 252 + Top = 244 Width = 130 Anchors = [akTop, akLeft, akBottom] AutoFill = True @@ -445,16 +444,17 @@ object DemoForm: TDemoForm end object btnDefaultPromptDlg: TButton AnchorSideLeft.Control = btnDefaultQuestionDlg - AnchorSideTop.Control = btnMessageDlg + AnchorSideTop.Control = btnDefaultQuestionDlg + AnchorSideTop.Side = asrBottom AnchorSideRight.Control = btnDefaultQuestionDlg AnchorSideRight.Side = asrBottom Left = 156 Height = 25 - Top = 39 + Top = 37 Width = 130 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Top = 2 + BorderSpacing.Top = 4 Caption = 'DefaultPromptDlg' OnClick = btnDefaultPromptDlgClick TabOrder = 3 @@ -481,10 +481,10 @@ object DemoForm: TDemoForm AnchorSideRight.Side = asrBottom Left = 16 Height = 95 - Top = 141 + Top = 137 Width = 192 BorderSpacing.Left = 16 - BorderSpacing.Top = 16 + BorderSpacing.Top = 12 Caption = 'Text alignment/layout' ClientHeight = 75 ClientWidth = 188 @@ -629,7 +629,6 @@ object DemoForm: TDemoForm Width = 307 Align = alClient Anchors = [akTop, akLeft, akRight] - AutoSize = True BorderSpacing.Around = 8 BorderSpacing.InnerBorder = 8 Caption = 'QuestionDlgEx' @@ -637,7 +636,40 @@ object DemoForm: TDemoForm TabOrder = 0 end end - object FontDialog1: TFontDialog + object rgTextBkColor: TRadioGroup + AnchorSideLeft.Control = gbTextAlignmentLayout + AnchorSideTop.Control = rgMsgType + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rgMessage + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 52 + Top = 499 + Width = 191 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + BorderSpacing.Top = 12 + BorderSpacing.Bottom = 16 + Caption = 'Text background color' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 32 + ClientWidth = 187 + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'clWindow' + 'clForm' + ) + OnClick = rgTextBkColorClick + TabOrder = 11 + end + object FontDialog: TFontDialog MinFontSize = 0 MaxFontSize = 0 Left = 584 @@ -647,13 +679,13 @@ object DemoForm: TDemoForm BaseURL = 'file://html/' AutoRegister = True KeywordPrefix = 'HTML/' - Left = 312 - Top = 80 + Left = 296 + Top = 16 end object HTMLBrowserHelpViewer: THTMLBrowserHelpViewer BrowserParams = '%s' AutoRegister = True - Left = 168 - Top = 80 + Left = 296 + Top = 72 end end diff --git a/components/exctrls/examples/QuestionDlgEx/main.pas b/components/exctrls/examples/QuestionDlgEx/main.pas index 1b45e815c..386363c5c 100644 --- a/components/exctrls/examples/QuestionDlgEx/main.pas +++ b/components/exctrls/examples/QuestionDlgEx/main.pas @@ -24,13 +24,14 @@ type cbFontName: TComboBox; edX: TEdit; edY: TEdit; - FontDialog1: TFontDialog; + FontDialog: TFontDialog; gbFont: TGroupBox; gbMaxWidth: TGroupBox; gbTestStd: TGroupBox; gbTest: TGroupBox; Panel1: TPanel; Panel2: TPanel; + rgTextBkColor: TRadioGroup; rbLeftJustify: TRadioButton; rbHCenter: TRadioButton; rbRightJustify: TRadioButton; @@ -51,13 +52,14 @@ type 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 btnMessageDlgClick(Sender: TObject); + procedure btnQuestionDlgClick(Sender: TObject); + procedure btnQuestionDlgExClick(Sender: TObject); + procedure cbDefaultFontChange(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure rgTextBkColorClick(Sender: TObject); private function GetModalResultStr(res: TModalResult): String; @@ -73,7 +75,7 @@ implementation {$R *.lfm} uses - LCLIntf, LCLType, InterfaceBase, TypInfo, Math, + LCLIntf, LCLType, InterfaceBase, TypInfo, Math, Buttons, {$IF FPC_FullVersion >= 30202}System.{$IFEND}UITypes; const @@ -88,6 +90,12 @@ const 'Line 1' + LineEnding + 'Line 2' + LineEnding + 'Line 3' + LineEnding + 'Line 4' + LineEnding + 'Line 5', 'This is a long long long long text.' + LineEnding + 'Short text.' + 'This is a very very very very very very very very very very very very very very long text.' ); + BUTTON_NAMES: array[idButtonOK..idButtonShield] of string = ( + 'idButtonOk', 'idButtonCancel', 'idButtonHelp', 'idButtonYes', 'idButtonNo', + 'idButtonClose', 'idButtonAbort', 'idButtonRetry', 'idButtonIgnore', + 'idButtonAll', 'idButtonYesToAll', 'idButtonNoToAll', 'idButtonOpen', + 'idButtonSave', 'idButtonShield' + ); { TDemoForm } @@ -177,31 +185,36 @@ end; procedure TDemoForm.btnQuestionDlgClick(Sender: TObject); var mt: TMsgDlgType; - res: TModalResult; + res: Integer; msg: String; helpkwd: String; begin Caption := FORM_CAPTION; mt := TMsgDlgType(rgMsgType.ItemIndex); msg := MSG_TEXT[rgMessage.ItemIndex]; - helpkwd := 'HTML/index.html'; + helpkwd := 'HTML/index.html'; + // There are two ways to work with this dialog: + // - use the Delphi compatible mrXXX constants (DO NOT USE THE mbXXX CONSTANTS!) + // - use the LCL idButtonXXX constants case rgButtons.ItemIndex of - 0: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir'], helpkwd); - 1: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbNo, 'No sir', 'IsDefault', mbCancel, 'Changed my mind'], helpkwd); - 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); + 0: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir'], helpkwd); + 1: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrNo, 'No sir', 'IsDefault', mrCancel, 'Changed my mind'], helpkwd); + 2: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel'], helpkwd); + 3: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel', mrClose, 'Schließen', mrNone, 'Hilfe'], helpkwd); end; - Caption := GetModalResultStr(res); + Caption := GetModalResultStr(res); + (* + case rgButtons.ItemIndex of + 0: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir'], helpkwd); + 1: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonNo, 'No sir', 'IsDefault', idButtonCancel, 'Changed my mind'], helpkwd); + 2: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel'], helpkwd); + 3: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel', idButtonClose, 'Schließen', idButtonHelp, 'Hilfe'], helpkwd); + end; + Caption := FORM_CAPTION + ' - Result: ' + BUTTON_NAMES[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; @@ -302,6 +315,14 @@ begin seFontSize.Enabled := false; end; +procedure TDemoForm.rgTextBkColorClick(Sender: TObject); +begin + case rgTextBkColor.ItemIndex of + 0: QuestionDlgEx_TextBkColor := clWindow; + 1: QuestionDlgEx_TextBkColor := clBtnFace; + end; +end; + function TDemoForm.GetModalResultStr(res: TModalResult): String; begin Result := FORM_CAPTION + ' - ModalResult: ' + {$IF FPC_FullVersion>=30202}System.{$IFEND}UITypes.ModalResultStr[res]; diff --git a/components/exctrls/source/exquestiondlg.pas b/components/exctrls/source/exquestiondlg.pas index a2ebb5b1e..4bf349930 100644 --- a/components/exctrls/source/exquestiondlg.pas +++ b/components/exctrls/source/exquestiondlg.pas @@ -56,6 +56,7 @@ var QuestionDlgEx_MinHeight: Integer = 50; // Text part only QuestionDlgEx_ButtonAlignment: TAlignment = taCenter; QuestionDlgEx_TextAlignment: TAlignment = taLeftJustify; + QuestionDlgEx_TextBkColor: TColor = clWindow; QuestionDlgEx_TextLayout: TTextLayout = tlCenter; QuestionDlgEx_FontName: String = ''; // the same as "default" QuestionDlgEx_FontSize: Integer = 0; @@ -110,12 +111,12 @@ type FText: String; FTextBorder: TSize; FTextAlignment: TAlignment; + FTextBkColor: TColor; FTextLayout: TTextLayout; FTextPanel: TPanel; FXPos, FYPos: Integer; procedure SetDialogType(AValue: TMsgDlgType); protected -// procedure Activate; override; procedure AdjustForm; procedure ApplyButtonAlignment; procedure CreateButtonPanel; @@ -137,6 +138,7 @@ type property DialogType: TMsgDlgType read FDialogType write SetDialogType; property Msg: String read FText write FText; property TextAlignment: TAlignment read FTextAlignment write FTextAlignment; + property TextBkColor: TColor read FTextBkColor write FTextBkColor; property TextLayout: TTextLayout read FTextLayout write FTextLayout; property XPos: Integer read FXPos write FXPos; property YPos: Integer read FYPos write FYPos; @@ -146,7 +148,6 @@ constructor TQForm.CreateNew(AOwner: TComponent; Num: Integer = 0); begin inherited; BorderStyle := bsDialog; - Color := clWindow; PopupMode := pmAuto; FImageBorder.CX := Scale96ToFont(DEFAULT_IMAGE_BORDER_X); @@ -165,14 +166,6 @@ 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 = ( @@ -294,8 +287,6 @@ begin begin AnchorSideLeft.Control := FButtonPanel; AnchorSideTop.Control := FButtonPanel; -// AnchorSideRight.Control := FButtonPanel; -// AnchorSideRight.Side := asrBottom; BevelOuter := bvNone; BorderSpacing.Top := Scale96ToFont(BUTTON_SPACING); BorderSpacing.Bottom := Scale96ToFont(BUTTON_SPACING); @@ -312,7 +303,7 @@ begin begin BevelOuter := bvNone; Caption := ''; - Color := clWindow; + Color := QuestionDlgEx_TextBkColor; Parent := Self; OnPaint := @PaintTextPanelHandler; end; @@ -521,6 +512,7 @@ begin QForm.Font.Size := QuestionDlgEx_FontSize; QForm.ButtonAlignment := QuestionDlgEx_ButtonAlignment; QForm.TextAlignment := QuestionDlgEx_TextAlignment; + QForm.TextBkColor := QuestionDlgEx_TextBkColor; QForm.TextLayout := QuestionDlgEx_TextLayout; QForm.Caption := ACaption; QForm.DialogType := ADlgtype;