paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 11:29:29 +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

41
lcl/include/promptdialog.inc
View File

@ -549,9 +549,10 @@ type
FButtons: TList;
FBitmap: TCustomBitmap;
FBitmapX, FBitmapY: Integer;
FMsgMemo: TMemo;
public
TextBox : TRect;
TextStyle : TTextStyle;
TextBox: TRect;
TextStyle: TTextStyle;
MessageTxt: String;
constructor CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
@ -569,8 +570,11 @@ var
begin
inherited Paint;
// draw the text
Canvas.Brush := Brush;
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
if FMsgMemo=nil then
begin
Canvas.Brush := Brush;
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
end;
// draw the icon
if Assigned (FBitmap) then
begin
@ -598,7 +602,7 @@ var
CurBtnPos: Integer;
CurBtnSize: TPoint;
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;
begin
@ -627,11 +631,32 @@ begin
// calculate the width & height we need to display the Message
if MessageTxt = '' then
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;
SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
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
MinBtnWidth:=Max(25,MinimumDialogButtonWidth);
MinBtnHeight:=Max(15,MinimumDialogButtonHeight);
@ -679,6 +704,10 @@ begin
SetBounds((Screen.Width - reqWidth-10) div 2, (Screen.Height - reqHeight-50) div 2,
reqWidth, reqHeight);
// position memo
if FMsgMemo.Visible then
FMsgMemo.BoundsRect:=TextBox;
// position buttons
CurBtnPos := ButtonLeft;
if FButtons <> nil then