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

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.Top = 12
-    BorderSpacing.Bottom = 16
     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
+    Left = 296
-    Top = 80
+    Top = 16
   end
   object HTMLBrowserHelpViewer: THTMLBrowserHelpViewer
     BrowserParams = '%s'
     AutoRegister = True
-    Left = 168
+    Left = 296
-    Top = 80
+    Top = 72
   end
 end

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);
+    0: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir'], helpkwd);
-    1: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbNo, 'No sir', 'IsDefault', mbCancel, 'Changed my mind'], 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, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel'], 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, [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);
+    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];

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;