You've already forked lazarus-ccr
extctrls/exquestiondlg: replace TImage and TLabel by directly drawn bitmap and text.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8154 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -17,7 +17,7 @@ unit ExQuestionDlg;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uses
|
||||
LclIntf, LclType, Types,
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
|
||||
ExtCtrls, Menus;
|
||||
@@ -53,9 +53,11 @@ function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType
|
||||
var
|
||||
QuestionDlgEx_MaxWidth: Integer = 500;
|
||||
QuestionDlgEx_MinWidth: Integer = 250;
|
||||
QuestionDlgEx_MinHeight: Integer = 50; // Text part only
|
||||
QuestionDlgEx_ButtonAlignment: TAlignment = taCenter;
|
||||
QuestionDlgEx_TextAlignment: TAlignment = taLeftJustify;
|
||||
QuestionDlgEx_FontName: String = '';
|
||||
QuestionDlgEx_TextLayout: TTextLayout = tlCenter;
|
||||
QuestionDlgEx_FontName: String = ''; // the same as "default"
|
||||
QuestionDlgEx_FontSize: Integer = 0;
|
||||
QuestionDlgEx_GlyphShowMode: TGlyphShowMode = gsmApplication;
|
||||
|
||||
@@ -64,6 +66,12 @@ implementation
|
||||
uses
|
||||
TypInfo, Math;
|
||||
|
||||
const
|
||||
DEFAULT_IMAGE_BORDER_X = 10;
|
||||
DEFAULT_IMAGE_BORDER_Y = 5;
|
||||
DEFAULT_TEXT_BORDER_X = 10;
|
||||
DEFAULT_TEXT_BORDER_Y = 10;
|
||||
|
||||
function GetBKType(str:string):TBitBtnKind;
|
||||
var
|
||||
value: Integer;
|
||||
@@ -90,37 +98,39 @@ type
|
||||
FButtons: array of TBitBtn;
|
||||
FButtonPanel: TPanel;
|
||||
FDialogType: TMsgDlgType;
|
||||
FImage: TImage;
|
||||
FImage: TCustomBitmap;
|
||||
FImageBorder: TSize;
|
||||
FInnerButtonPanel: TPanel;
|
||||
FLabel: TLabel;
|
||||
FText: String;
|
||||
FTextBorder: TSize;
|
||||
FTextAlignment: TAlignment;
|
||||
FTextLayout: TTextLayout;
|
||||
FTextPanel: TPanel;
|
||||
FXPos, FYPos: Integer;
|
||||
function GetMsg: String;
|
||||
procedure SetDialogType(AValue: TMsgDlgType);
|
||||
procedure SetMsg(const AValue: String);
|
||||
protected
|
||||
procedure Activate; override;
|
||||
procedure AdjustFormSizeAndPosition(AX, AY: Integer);
|
||||
procedure AdjustForm;
|
||||
procedure ApplyButtonAlignment;
|
||||
procedure ApplyTextAlignment;
|
||||
procedure CreateButtonPanel;
|
||||
procedure CreateImage;
|
||||
procedure CreateLabel;
|
||||
procedure CreateInnerButtonPanel;
|
||||
procedure CreateTextPanel;
|
||||
procedure HelpClickHandler(Sender: TObject);
|
||||
function MeasureButtonPanel: Integer;
|
||||
function MeasureTextPanel: Integer;
|
||||
procedure MeasureButtonPanel(var AWidth, AHeight: Integer);
|
||||
procedure MeasureText(var AWidth, AHeight: Integer);
|
||||
procedure MeasureTextPanel(Wrapped: Boolean; var AWidth, AHeight: Integer);
|
||||
procedure PaintTextPanelHandler(Sender: TObject);
|
||||
function PrepareButtons(const AButtons: array of const): TBtnParamsArray;
|
||||
procedure SetFormPosition(AX, AY: Integer);
|
||||
public
|
||||
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
|
||||
destructor Destroy; override;
|
||||
procedure AddButtons(const AButtons: array of const);
|
||||
property ButtonAlignment: TAlignment read FButtonAlignment write FButtonAlignment;
|
||||
property DialogType: TMsgDlgType read FDialogType write SetDialogType;
|
||||
property Msg: String read GetMsg write SetMsg;
|
||||
property Msg: String read FText write FText;
|
||||
property TextAlignment: TAlignment read FTextAlignment write FTextAlignment;
|
||||
property TextLayout: TTextLayout read FTextLayout write FTextLayout;
|
||||
property XPos: Integer read FXPos write FXPos;
|
||||
property YPos: Integer read FYPos write FYPos;
|
||||
end;
|
||||
@@ -128,22 +138,31 @@ type
|
||||
constructor TQForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
|
||||
begin
|
||||
inherited;
|
||||
BorderStyle := bsSingle; // In gth2, bsDialog "glues" the dialog to the calling form
|
||||
BorderStyle := bsSingle; // In gtk2, bsDialog "glues" the dialog to the calling form
|
||||
BorderIcons := [biSystemMenu];
|
||||
Color := clWindow;
|
||||
PopupMode := pmAuto;
|
||||
|
||||
FImageBorder.CX := Scale96ToFont(DEFAULT_IMAGE_BORDER_X);
|
||||
FImageBorder.CY := Scale96ToFont(DEFAULT_IMAGE_BORDER_Y);
|
||||
FTextBorder.CX := Scale96ToFont(DEFAULT_TEXT_BORDER_X);
|
||||
FTextBorder.CY := Scale96ToFont(DEFAULT_TEXT_BORDER_Y);
|
||||
|
||||
CreateTextPanel;
|
||||
CreateImage;
|
||||
CreateLabel;
|
||||
|
||||
CreateButtonPanel;
|
||||
CreateInnerButtonPanel;
|
||||
end;
|
||||
|
||||
destructor TQForm.Destroy;
|
||||
begin
|
||||
FImage.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TQForm.Activate;
|
||||
begin
|
||||
AdjustFormSizeAndPosition(FXPos, FYPos);
|
||||
AdjustForm;
|
||||
SetFormPosition(FXPos, FYPos);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@@ -193,61 +212,50 @@ begin
|
||||
// MeasureButtonPanel;
|
||||
end;
|
||||
|
||||
procedure TQForm.AdjustFormSizeAndPosition(AX, AY: Integer);
|
||||
procedure TQForm.AdjustForm;
|
||||
var
|
||||
buttonPanelWidth, textPanelWidth: Integer;
|
||||
w, h: Integer;
|
||||
buttonPanelWidth: Integer = 0;
|
||||
buttonPanelHeight: Integer = 0;
|
||||
textPanelWidth: Integer = 0;
|
||||
textPanelHeight: Integer = 0;
|
||||
begin
|
||||
if (FTextPanel = nil) or (FLabel = nil) or (FButtonPanel = nil) then
|
||||
begin
|
||||
inherited;
|
||||
if (FTextPanel = nil) or (FButtonPanel = nil) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
FTextPanel.Anchors := [akLeft, akTop];
|
||||
FLabel.Anchors := [akLeft, akTop];
|
||||
FButtonPanel.Anchors := [akLeft, akTop];
|
||||
|
||||
buttonPanelWidth := MeasureButtonPanel;
|
||||
textPanelWidth := MeasureTextPanel;
|
||||
MeasureButtonPanel(buttonPanelWidth, buttonPanelHeight);
|
||||
MeasureTextPanel(false, textPanelWidth, textPanelHeight);
|
||||
|
||||
if buttonPanelWidth > textPanelWidth then
|
||||
begin
|
||||
Constraints.MinWidth := buttonPanelWidth;
|
||||
Constraints.MaxWidth := buttonPanelWidth;
|
||||
Width := buttonPanelWidth;
|
||||
textPanelWidth := buttonPanelWidth;
|
||||
end else
|
||||
begin
|
||||
MeasureTextPanel(true, textPanelWidth, textPanelHeight);
|
||||
if textPanelWidth > QuestionDlgEx_MaxWidth then
|
||||
begin
|
||||
if buttonPanelWidth > QuestionDlgEx_Maxwidth then
|
||||
textPanelWidth := buttonPanelWidth
|
||||
else
|
||||
textPanelWidth := QuestionDlgEx_MaxWidth;
|
||||
MeasureTextPanel(true, textPanelWidth, textPanelheight);
|
||||
end;
|
||||
Constraints.MinWidth := textPanelWidth;
|
||||
Constraints.MaxWidth := textPanelWidth;
|
||||
Width := textPanelWidth;
|
||||
end;
|
||||
|
||||
HandleNeeded;
|
||||
AutoSize := true;
|
||||
|
||||
FTextPanel.Anchors := [akLeft, akRight, akTop];
|
||||
FLabel.Anchors := [akLeft, akRight, akTop];
|
||||
FButtonPanel.Anchors := [akLeft, akRight, akTop];
|
||||
|
||||
ApplyButtonAlignment;
|
||||
ApplyTextAlignment;
|
||||
|
||||
SetFormPosition(AX, AY);
|
||||
FTextPanel.SetBounds(0, 0, textPanelWidth, textPanelHeight);
|
||||
FButtonPanel.SetBounds(0, textPanelHeight, textPanelWidth, buttonPanelHeight);
|
||||
|
||||
Width := textPanelWidth;
|
||||
Height := textPanelHeight + buttonPanelHeight;
|
||||
|
||||
ApplyButtonAlignment;
|
||||
end;
|
||||
|
||||
procedure TQForm.ApplyButtonAlignment;
|
||||
begin
|
||||
// Set button and text alignments
|
||||
case FButtonAlignment of
|
||||
taLeftJustify: ;
|
||||
taLeftJustify:
|
||||
FInnerButtonPanel.AnchorSideLeft.Side := asrLeft;
|
||||
taCenter:
|
||||
FInnerButtonPanel.AnchorSideLeft.Side := asrCenter;
|
||||
taRightJustify:
|
||||
@@ -259,11 +267,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TQForm.ApplyTextAlignment;
|
||||
begin
|
||||
FLabel.Alignment := FTextAlignment;
|
||||
end;
|
||||
|
||||
procedure TQForm.CreateButtonPanel;
|
||||
begin
|
||||
FButtonPanel := TPanel.Create(Self);
|
||||
@@ -272,61 +275,10 @@ begin
|
||||
BevelOuter := bvNone;
|
||||
Caption := '';
|
||||
Color := clBtnFace;
|
||||
AutoSize := true;
|
||||
AnchorSideTop.Control := FTextPanel;
|
||||
AnchorSideTop.Side := asrBottom;
|
||||
AnchorSideLeft.Control := Self;
|
||||
AnchorSideRight.Control := Self;
|
||||
AnchorSideRight.Side := asrBottom;
|
||||
Parent := Self;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TQForm.CreateImage;
|
||||
var
|
||||
lSize: TSize;
|
||||
begin
|
||||
lSize.cx := GetSystemMetrics(SM_CXICON);
|
||||
lSize.cy := GetSystemMetrics(SM_CYICON);
|
||||
|
||||
FImage := TImage.Create(Self);
|
||||
with FImage do
|
||||
begin
|
||||
Parent := FTextPanel;
|
||||
AnchorSideTop.Control := FTextPanel;
|
||||
BorderSpacing.Left := 10;
|
||||
BorderSpacing.Top := 5;
|
||||
BorderSpacing.Bottom := 10;
|
||||
Width:= Min(32, lSize.CY);
|
||||
Height:= Min(32, lSize.CY);
|
||||
Transparent := true;
|
||||
Proportional := true;
|
||||
AntialiasingMode := amON;
|
||||
Center := true;
|
||||
if lSize.CX > Width then
|
||||
Stretch := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TQForm.CreateLabel;
|
||||
begin
|
||||
FLabel := TLabel.Create(Self);
|
||||
with FLabel do
|
||||
begin
|
||||
Parent := FTextPanel;
|
||||
AnchorSideLeft.Control := FImage;
|
||||
AnchorSideLeft.Side := asrBottom;
|
||||
AnchorSideTop.Control := FTextPanel;
|
||||
AnchorSideTop.Side := asrTop;
|
||||
AnchorSideRight.Control := FTextPanel;
|
||||
AnchorSideRight.Side := asrBottom;
|
||||
BorderSpacing.Around := 10;
|
||||
WordWrap := true;
|
||||
Transparent := true;
|
||||
AutoSize := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TQForm.CreateInnerButtonPanel;
|
||||
begin
|
||||
FInnerButtonPanel := TPanel.Create(Self);
|
||||
@@ -348,50 +300,107 @@ begin
|
||||
FTextPanel := TPanel.Create(Self);
|
||||
with FTextPanel do
|
||||
begin
|
||||
AnchorSideLeft.Control := Self;
|
||||
AnchorSideTop.Control := Self;
|
||||
AnchorSideRight.Control := Self;
|
||||
AnchorSideRight.Side := asrBottom;
|
||||
BevelOuter := bvNone;
|
||||
Caption := '';
|
||||
Color := clWindow;
|
||||
AutoSize := true;
|
||||
Parent := Self;
|
||||
OnPaint := @PaintTextPanelHandler;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TQForm.GetMsg: String;
|
||||
begin
|
||||
Result := FLabel.Caption;
|
||||
end;
|
||||
|
||||
procedure TQForm.HelpClickHandler(Sender: TObject);
|
||||
begin
|
||||
ShowHelp;
|
||||
end;
|
||||
|
||||
function TQForm.MeasureButtonPanel: Integer;
|
||||
var
|
||||
h: Integer = 0;
|
||||
procedure TQForm.MeasureButtonPanel(var AWidth, AHeight: Integer);
|
||||
begin
|
||||
Result := 0;
|
||||
AWidth := 0;
|
||||
AHeight := 0;
|
||||
FButtonPanel.HandleNeeded;
|
||||
FButtonPanel.GetPreferredSize(Result, h);
|
||||
Result := Max(QuestionDlgEx_MinWidth, result);
|
||||
FButtonPanel.GetPreferredSize(AWidth, AHeight);
|
||||
if QuestionDlgEx_MinWidth > AWidth then AWidth := QuestionDlgEx_MinWidth;
|
||||
end;
|
||||
|
||||
function TQForm.MeasureTextPanel: Integer;
|
||||
procedure TQForm.MeasureText(var AWidth, AHeight: Integer);
|
||||
var
|
||||
h: Integer = 0;
|
||||
savedAutoSize: Boolean;
|
||||
R: TRect;
|
||||
flags: integer;
|
||||
begin
|
||||
Result := 0;
|
||||
savedAutoSize := FTextPanel.AutoSize;
|
||||
FTextPanel.AutoSize := true;
|
||||
FTextPanel.HandleNeeded;
|
||||
FTextPanel.GetPreferredSize(Result, h);
|
||||
Result := Max(QuestionDlgEx_MinWidth, Result);
|
||||
FTextPanel.AutoSize := savedAutoSize;
|
||||
R := Rect(0, 0, AWidth, AHeight);
|
||||
flags := DT_CALCRECT or DT_WORDBREAK;
|
||||
DrawText(Canvas.Handle, PChar(FText), Length(FText), R, flags);
|
||||
AWidth := R.Right;
|
||||
AHeight := R.Bottom;
|
||||
end;
|
||||
|
||||
procedure TQForm.MeasureTextPanel(Wrapped: Boolean; var AWidth, AHeight: Integer);
|
||||
var
|
||||
R: TRect;
|
||||
x: Integer;
|
||||
flags: Integer;
|
||||
imgHeight: Integer;
|
||||
begin
|
||||
x := FImageBorder.CX;
|
||||
if Assigned(FImage) then
|
||||
inc(x, FImage.Width + Max(FImageBorder.CX, FTextBorder.CX));
|
||||
if not Wrapped then AWidth := 9999;
|
||||
R := Rect(x, FTextBorder.CY, AWidth, 9999);
|
||||
flags := DT_CALCRECT;
|
||||
if Wrapped then flags := flags or DT_WORDBREAK;
|
||||
HandleNeeded;
|
||||
DrawText(Canvas.Handle, PChar(FText), Length(FText), R, flags);
|
||||
inc(R.Bottom, FTextBorder.CY);
|
||||
AWidth := R.Right;
|
||||
if AWidth < QuestionDlgEx_MinWidth then
|
||||
AWidth := QuestionDlgEx_MinWidth;
|
||||
AHeight := R.Bottom;
|
||||
if Assigned(FImage) then
|
||||
imgHeight := FImage.Height
|
||||
else
|
||||
imgHeight := 32;
|
||||
if (AHeight < 2*FImageBorder.CY + imgHeight) then
|
||||
AHeight := 2*FImageBorder.CY + imgHeight;
|
||||
if AHeight < QuestionDlgEx_MinHeight then
|
||||
AHeight := QuestionDlgEx_MinHeight;
|
||||
end;
|
||||
|
||||
procedure TQForm.PaintTextPanelHandler(Sender: TObject);
|
||||
var
|
||||
x, y: Integer;
|
||||
R: TRect;
|
||||
flags: Integer;
|
||||
w, h: Integer;
|
||||
begin
|
||||
with FTextPanel do begin
|
||||
Canvas.Brush.Color := Color;
|
||||
Canvas.FillRect(0, 0, Width, Height);
|
||||
x := FImageBorder.CX;
|
||||
if Assigned(FImage) then
|
||||
begin
|
||||
Canvas.Draw(x, FImageBorder.CY, FImage);
|
||||
inc(x, FImage.Width + Max(FImageBorder.CX, FTextBorder.CX));
|
||||
end;
|
||||
if FText <> '' then
|
||||
begin
|
||||
R := Rect(x, FTextBorder.CY, Width - FTextBorder.CX, Height - FTextBorder.CY);
|
||||
w := R.Right - x;
|
||||
h := R.Bottom - FTextBorder.CY;
|
||||
MeasureText(w, h);
|
||||
flags := DT_WORDBREAK;
|
||||
case FTextAlignment of
|
||||
taLeftJustify: flags := flags or DT_LEFT;
|
||||
taCenter: flags := flags or DT_CENTER;
|
||||
taRightJustify: flags := flags or DT_RIGHT;
|
||||
end;
|
||||
case FTextLayout of
|
||||
tlTop: ;
|
||||
tlCenter: R.Top := (R.Top + R.Bottom - h) div 2;
|
||||
tlBottom: R.Top := R.Bottom - h;
|
||||
end;
|
||||
DrawText(Canvas.Handle, PChar(FText), Length(FText), R, flags);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TQForm.PrepareButtons(const AButtons: array of const): TBtnParamsArray;
|
||||
@@ -424,16 +433,11 @@ end;
|
||||
procedure TQForm.SetDialogType(AValue: TMsgDlgType);
|
||||
var
|
||||
iconKind: Integer;
|
||||
bmp: TCustomBitmap;
|
||||
begin
|
||||
FDialogType := AValue;
|
||||
iconKind := idDialogBase + 1 + ord(FDialogType);
|
||||
bmp := GetDialogIcon(iconKind);
|
||||
try
|
||||
FImage.Picture.Assign(bmp);
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
FImage.Free;
|
||||
FImage := GetDialogIcon(iconKind);
|
||||
end;
|
||||
|
||||
procedure TQForm.SetFormPosition(AX, AY: Integer);
|
||||
@@ -467,12 +471,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TQForm.SetMsg(const AValue: String);
|
||||
begin
|
||||
FLabel.Caption := AValue;
|
||||
// MeasureTextPanel;
|
||||
end;
|
||||
|
||||
|
||||
function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
|
||||
const AButtons: array of const; AX, AY: Integer): TForm;
|
||||
@@ -484,6 +482,7 @@ begin
|
||||
QForm.Font.Size := QuestionDlgEx_FontSize;
|
||||
QForm.ButtonAlignment := QuestionDlgEx_ButtonAlignment;
|
||||
QForm.TextAlignment := QuestionDlgEx_TextAlignment;
|
||||
QForm.TextLayout := QuestionDlgEx_TextLayout;
|
||||
QForm.Caption := ACaption;
|
||||
QForm.DialogType := ADlgtype;
|
||||
QForm.Msg := AMsg;
|
||||
|
||||
Reference in New Issue
Block a user