pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls/QuestionDlgEx: Add variable for text background color.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8158 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-24 20:28:10 +00:00
parent 17a5b7035b
commit cb744ff5de
3 changed files with 100 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
components/exctrls/examples/QuestionDlgEx/main.lfm
View File

@ -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

57
components/exctrls/examples/QuestionDlgEx/main.pas
View File

@ -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,7 +185,7 @@ end;
procedure TDemoForm.btnQuestionDlgClick(Sender: TObject);
var
mt: TMsgDlgType;
res: TModalResult;
res: Integer;
msg: String;
helpkwd: String;
begin
@ -185,23 +193,28 @@ begin
mt := TMsgDlgType(rgMsgType.ItemIndex);
msg := MSG_TEXT[rgMessage.ItemIndex];
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);
(*
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];

18
components/exctrls/source/exquestiondlg.pas
View File

@ -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;