paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 21:20:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: default QuestionDlg: use TMemo when text too big

Browse Source 
git-svn-id: branches/fixes_1_6@50571 -
This commit is contained in:
mattias 2015-12-02 14:21:27 +00:00
parent 65048638b8
commit 1523a8b514
1 changed files with 35 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
lcl/include/promptdialog.inc
View File

@ -549,9 +549,10 @@ type
FButtons: TList; FButtons: TList;
FBitmap: TCustomBitmap; FBitmap: TCustomBitmap;
FBitmapX, FBitmapY: Integer; FBitmapX, FBitmapY: Integer;
FMsgMemo: TMemo;
public public
TextBox : TRect; TextBox: TRect;
TextStyle : TTextStyle; TextStyle: TTextStyle;
MessageTxt: String; MessageTxt: String;
constructor CreateQuestionDlg(const aCaption, aMsg: string; constructor CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint); DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
@ -569,8 +570,11 @@ var
begin begin
inherited Paint; inherited Paint;
// draw the text // draw the text
if FMsgMemo=nil then
begin
Canvas.Brush := Brush; Canvas.Brush := Brush;
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle); Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
end;
// draw the icon // draw the icon
if Assigned (FBitmap) then if Assigned (FBitmap) then
begin begin
@ -598,7 +602,7 @@ var
CurBtnPos: Integer; CurBtnPos: Integer;
CurBtnSize: TPoint; CurBtnSize: TPoint;
MinBtnWidth: Integer; // minimum width for a single button MinBtnWidth: Integer; // minimum width for a single button
MinBtnHeight: Integer; // minimum height for a single button MinBtnHeight, MaxHeight: Integer; // minimum height for a single button
function GetButtonSize(AButton: TBitBtn): TPoint; function GetButtonSize(AButton: TBitBtn): TPoint;
begin begin
@ -627,11 +631,32 @@ begin
// calculate the width & height we need to display the Message // calculate the width & height we need to display the Message
if MessageTxt = '' then if MessageTxt = '' then
MessageTxt := ' '; MessageTxt := ' ';
TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height - 100); TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height);
Flags := DT_CalcRect or DT_WordBreak; Flags := DT_CalcRect or DT_WordBreak;
SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle); SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
DrawText(Canvas.Handle, PChar(MessageTxt), Length(MessageTxt), TextBox, Flags); DrawText(Canvas.Handle, PChar(MessageTxt), Length(MessageTxt), TextBox, Flags);
MaxHeight:=200;//Min(Screen.Height-100,(Screen.Height*4) div 5);
if TextBox.Bottom>MaxHeight then
begin
// does not fit onto the screen => use a TMemo
TextBox.Bottom:=MaxHeight;
if FMsgMemo=nil then
begin
FMsgMemo:=TMemo.Create(Self);
with FMsgMemo do
begin
WordWrap:=true;
ReadOnly:=true;
ScrollBars:=ssAutoBoth;
Text:=MessageTxt;
Parent:=Self;
end;
end;
FMsgMemo.Visible:=true;
end else
FMsgMemo.Visible:=false;
// calculate the width we need to display the buttons // calculate the width we need to display the buttons
MinBtnWidth:=Max(25,MinimumDialogButtonWidth); MinBtnWidth:=Max(25,MinimumDialogButtonWidth);
MinBtnHeight:=Max(15,MinimumDialogButtonHeight); MinBtnHeight:=Max(15,MinimumDialogButtonHeight);
@ -679,6 +704,10 @@ begin
SetBounds((Screen.Width - reqWidth-10) div 2, (Screen.Height - reqHeight-50) div 2, SetBounds((Screen.Width - reqWidth-10) div 2, (Screen.Height - reqHeight-50) div 2,
reqWidth, reqHeight); reqWidth, reqHeight);
// position memo
if FMsgMemo.Visible then
FMsgMemo.BoundsRect:=TextBox;
// position buttons // position buttons
CurBtnPos := ButtonLeft; CurBtnPos := ButtonLeft;
if FButtons <> nil then if FButtons <> nil then