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

exctrls/exquestiondlg: Avoid flicker due to Activate.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8157 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-23 22:29:16 +00:00
parent 5e350b0270
commit 17a5b7035b
3 changed files with 255 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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