paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 19:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

added QuestionDlg - a MessageDlg with custom buttons

Browse Source 
git-svn-id: trunk@6703 -
This commit is contained in:
mattias 2005-01-27 19:03:51 +00:00
parent a7edaa30c0
commit 948a215e46
7 changed files with 464 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/comctrls.pp
View File

@ -1627,7 +1627,7 @@ type
procedure ExpandParents; procedure ExpandParents;
function Bottom: integer; function Bottom: integer;
function BottomExpanded: integer; function BottomExpanded: integer;
function GetParentNodeOfAbsoluteLevel(AAbsoluteLevel:integer):TTreeNode; function GetParentNodeOfAbsoluteLevel(TheAbsoluteLevel: integer): TTreeNode;
function GetFirstChild: TTreeNode; function GetFirstChild: TTreeNode;
function GetHandle: THandle; function GetHandle: THandle;
function GetLastSibling: TTreeNode; function GetLastSibling: TTreeNode;
@ -2293,6 +2293,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.160 2005/01/27 19:03:51 mattias
added QuestionDlg - a MessageDlg with custom buttons
Revision 1.159 2005/01/27 10:10:25 mattias Revision 1.159 2005/01/27 10:10:25 mattias
added TTreeNode.GetParentNodeOfAbsoluteLevel from Sergio added TTreeNode.GetParentNodeOfAbsoluteLevel from Sergio

9
lcl/dialogs.pp
View File

@ -302,8 +302,8 @@ type
read FOnApplyClicked write FOnApplyClicked; read FOnApplyClicked write FOnApplyClicked;
property PreviewText: string read FPreviewText write FPreviewText; property PreviewText: string read FPreviewText write FPreviewText;
end; end;
{ MessageDlg } { MessageDlg }
function MessageDlg(const aMsg: string; DlgType: TMsgDlgType; function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
@ -315,6 +315,8 @@ function MessageDlgPos(const aMsg: string; DlgType: TMsgDlgType;
function MessageDlgPosHelp(const aMsg: string; DlgType: TMsgDlgType; function MessageDlgPosHelp(const aMsg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
const HelpFileName: string): Integer; const HelpFileName: string): Integer;
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
Buttons: array of const; HelpCtx: Longint): TModalResult;
procedure ShowMessage(const aMsg: string); procedure ShowMessage(const aMsg: string);
procedure ShowMessageFmt(const aMsg: string; Params: array of const); procedure ShowMessageFmt(const aMsg: string; Params: array of const);
@ -421,6 +423,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.58 2005/01/27 19:03:51 mattias
added QuestionDlg - a MessageDlg with custom buttons
Revision 1.57 2004/12/27 19:40:59 mattias Revision 1.57 2004/12/27 19:40:59 mattias
published BorderSpacing for many controls published BorderSpacing for many controls

4
lcl/forms.pp
View File

@ -165,6 +165,7 @@ type
procedure PaintWindow(dc : Hdc); override; procedure PaintWindow(dc : Hdc); override;
procedure UpdateScrollbars; virtual; procedure UpdateScrollbars; virtual;
function HasVisibleScrollbars: boolean; virtual; function HasVisibleScrollbars: boolean; virtual;
procedure DestroyWnd; override;
property Canvas: TControlCanvas read FCanvas; property Canvas: TControlCanvas read FCanvas;
published published
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll; property AutoScroll: Boolean read FAutoScroll write SetAutoScroll;
@ -334,6 +335,7 @@ type
TFormState = set of TFormStateType; TFormState = set of TFormStateType;
TModalResult = low(Integer)..high(Integer); TModalResult = low(Integer)..high(Integer);
PModalResult = ^TModalResult;
TFormHandlerType = ( TFormHandlerType = (
fhtFirstShow, fhtFirstShow,
@ -471,7 +473,7 @@ type
procedure SetFocus; override; procedure SetFocus; override;
function SetFocusedControl(Control: TWinControl): Boolean ; Virtual; function SetFocusedControl(Control: TWinControl): Boolean ; Virtual;
procedure FocusControl(WinControl: TWinControl); procedure FocusControl(WinControl: TWinControl);
function ShowModal: Integer; function ShowModal: Integer; virtual;
procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer); procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer);
function GetRolesForControl(AControl: TControl): TControlRolesForForm; function GetRolesForControl(AControl: TControl): TControlRolesForForm;
procedure RemoveAllHandlersOfObject(AnObject: TObject); override; procedure RemoveAllHandlersOfObject(AnObject: TObject); override;

489
lcl/include/promptdialog.inc
View File

@ -35,9 +35,6 @@ type
TPromptDialog = class(TForm) TPromptDialog = class(TForm)
procedure PromptDialogKeyDown(Sender: TObject; var Key: Word; procedure PromptDialogKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
function GetDialogCaption(idDiag : Integer) : String;
function GetDialogButtonText(idBut : Integer): string;
public public
TheDefaultIndex : Longint; TheDefaultIndex : Longint;
@ -56,6 +53,38 @@ type
Destructor Destroy; Override; Destructor Destroy; Override;
end; end;
{** Return the localized or not title of dialog}
function GetDialogCaption(idDiag: Integer): String;
begin
Result:='?';
Case idDiag of
idDialogWarning : Result:=rsMtWarning;
idDialogError : Result:=rsMtError;
idDialogInfo : Result:=rsMtInformation;
idDialogConfirm : Result:=rsMtConfirmation;
end;
end;
{** Return the text associed a an standard button}
function GetDialogButtonText(idBut: Integer): string;
begin
Result:='';
Case idBut of
idButtonOk : Result:=rsmbOk;
idButtonCancel : Result:=rsmbCancel;
idButtonHelp : Result:=rsmbHelp;
idButtonYes : Result:=rsmbYes;
idButtonNo : Result:=rsmbNo;
idButtonClose : Result:=rsmbClose;
idButtonAbort : Result:=rsmbAbort;
idButtonRetry : Result:=rsmbRetry;
idButtonIgnore : Result:=rsmbIgnore;
idButtonAll : Result:=rsmbAll;
idButtonYesToAll : Result:=rsmbYesToAll;
idButtonNoToAll : Result:=rsmbNoToAll;
end;
end;
procedure TPromptDialog.PromptDialogKeyDown(Sender: TObject; var Key: Word; procedure TPromptDialog.PromptDialogKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
var var
@ -112,38 +141,6 @@ begin
end; end;
end; end;
{** Return the localized or not title of dialog}
function TPromptDialog.GetDialogCaption(idDiag: Integer): String;
begin
Result:='?';
Case idDiag of
idDialogWarning : Result:=rsMtWarning;
idDialogError : Result:=rsMtError;
idDialogInfo : Result:=rsMtInformation;
idDialogConfirm : Result:=rsMtConfirmation;
end;
end;
{** Return the text associed a an standard button}
function TPromptDialog.GetDialogButtonText(idBut: Integer): string;
begin
Result:='';
Case idBut of
idButtonOk : Result:=rsmbOk;
idButtonCancel : Result:=rsmbCancel;
idButtonHelp : Result:=rsmbHelp;
idButtonYes : Result:=rsmbYes;
idButtonNo : Result:=rsmbNo;
idButtonClose : Result:=rsmbClose;
idButtonAbort : Result:=rsmbAbort;
idButtonRetry : Result:=rsmbRetry;
idButtonIgnore : Result:=rsmbIgnore;
idButtonAll : Result:=rsmbAll;
idButtonYesToAll : Result:=rsmbYesToAll;
idButtonNoToAll : Result:=rsmbNoToAll;
end;
end;
procedure TPromptDialog.Paint; procedure TPromptDialog.Paint;
begin begin
Inherited Paint; Inherited Paint;
@ -303,36 +300,36 @@ begin
begin begin
inc(ButtonIndex); inc(ButtonIndex);
with TBitBtn.Create(Self) do with TBitBtn.Create(Self) do
begin begin
Parent:= Self; Parent:= Self;
SetBounds (ButtonLeft, 2 * cLabelSpacing + reqHeight, cBtnWidth, cBtnHeight); SetBounds (ButtonLeft, 2 * cLabelSpacing + reqHeight, cBtnWidth, cBtnHeight);
inc(ButtonLeft, cBtnDist); inc(ButtonLeft, cBtnDist);
Layout := blGlyphLeft; Layout := blGlyphLeft;
OnKeyDown := @PromptDialogKeyDown; OnKeyDown := @PromptDialogKeyDown;
Case Buttons[curBtn] of Case Buttons[curBtn] of
idButtonYesToAll, idButtonYesToAll,
idButtonNoToAll : idButtonNoToAll :
begin
Glyph.Handle := LoadStockPixmap(Buttons[curBtn]);
If Buttons[curBtn] = idButtonYesToAll then
begin begin
Glyph.Handle := LoadStockPixmap(Buttons[curBtn]); ModalResult := mrYesToAll;
If Buttons[curBtn] = idButtonYesToAll then Caption := rsmbYesToAll;
begin end
ModalResult := mrYesToAll; else
Caption := rsmbYesToAll; begin
end ModalResult := mrNoToAll;
else Caption := rsmbNoToAll;
begin
ModalResult := mrNoToAll;
Caption := rsmbNoToAll;
end;
end; end;
else end;
Kind := DialogButtonKind[Buttons[curBtn]]; else
end; Kind := DialogButtonKind[Buttons[curBtn]];
if Height < Glyph.Height + 5 then end;
Height := Glyph.Height + 5; if Height < Glyph.Height + 5 then
if ButtonIndex = TheDefaultIndex then Default := true; Height := Glyph.Height + 5;
Visible:=true; if ButtonIndex = TheDefaultIndex then Default := true;
Visible:=true;
end; end;
end; end;
end; end;
@ -377,10 +374,376 @@ begin
end; end;
type
{ TQuestionDlg }
TQuestionDlg = class(TForm)
procedure ButtonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
FButtons: TList;
FBitmap: TBitmap;
FBitmapX, FBitmapY: Integer;
public
TextBox : TRect;
TextStyle : TTextStyle;
MessageTxt: String;
constructor CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
destructor Destroy; override;
procedure Paint; override;
procedure LayoutDialog;
function ShowModal: TModalResult; override;
function FindButton(Order: array of TModalResult): TBitBtn;
procedure CalcButtonSize(AButton: TBitBtn; var w, h: Integer);
end;
{ TQuestionDlg }
procedure TQuestionDlg.Paint;
begin
Inherited Paint;
//Canvas.Brush.Color := clRed;
//Canvas.FillRect(TextBox);
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
if Assigned(FBitmap) then begin
//Canvas.Brush.Color := clBlue;
//Canvas.FillRect(Bounds(FBitmapX,FBitmapY,FBitmap.Width,FBitmap.Height));
Canvas.CopyRect(Bounds(FBitmapX,FBitmapY,FBitmap.Width,FBitmap.Height),
FBitmap.Canvas, Rect(0,0,FBitmap.Width,FBitmap.Height));
end;
end;
procedure TQuestionDlg.LayoutDialog;
const
cBtnDist = 10; // distance between buttons
cLabelSpacing = 8; // space around label
var
Flags: Cardinal;
i: Integer;
CurButton: TBitBtn;
CurBtnWidth, CurBtnHeight: Integer;
reqBtnWidth: Integer;
reqWidth: LongInt;
cMinLeft: Integer;
ButtonLeft: Integer;
reqHeight: LongInt;
CurBtnPos: Integer;
begin
FillChar(TextStyle, SizeOf(TTextStyle), 0);
With TextStyle do
begin
Clipping := True;
Wordbreak := True;
SystemFont := True;
Opaque := False;
end;
// 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);
Flags:=DT_CalcRect or DT_NoPrefix or DT_WordBreak;
DrawText(Canvas.GetUpdatedHandle([csHandleValid,csFontValid]),
PChar(MessageTxt),Length(MessageTxt),TextBox,Flags);
// calculate the width we need to display the buttons
reqBtnWidth:=0;
CurBtnHeight:=25;
if FButtons<>nil then
for i:=0 to FButtons.Count-1 do begin
if i>0 then
Inc(reqBtnWidth, cBtnDist);
CurButton:=TBitBtn(FButtons[i]);
CalcButtonSize(CurButton,CurBtnWidth,CurBtnHeight);
Inc(reqBtnWidth, CurBtnWidth);
end;
// calculate the width of the dialog
If FBitmap <> nil then
cMinLeft := cLabelSpacing + max(20,FBitmap.Width) + cLabelSpacing
else
cMinLeft := cLabelSpacing;
reqWidth:= reqBtnWidth + 2*cBtnDist;
if reqWidth < (TextBox.Right + cMinLeft + cLabelSpacing) then
reqWidth:= TextBox.Right + cMinLeft + cLabelSpacing;
ButtonLeft := ((reqWidth - reqBtnWidth) div 2);
// calculate the height of the dialog
reqHeight:= TextBox.Bottom;
if (FBitmap <> nil) and (FBitmap.Height > reqHeight) then
reqHeight := FBitmap.Height;
inc(reqHeight,CurBtnHeight+3*cLabelSpacing);
// calculate the text position
OffsetRect(TextBox,
((reqWidth-cMinLeft-TextBox.Right-cLabelSpacing) div 2) + cMinLeft,
cLabelSpacing);
// calculate the icon position
if FBitmap<>nil then begin
FBitmapX:=cLabelSpacing;
FBitmapY:=(reqHeight-CurBtnHeight-FBitmap.Height-cLabelSpacing) div 2;
end;
// set size of form
SetBounds((Screen.Width-reqWidth-10) div 2, (Screen.Height-reqHeight-50) div 2,
reqWidth,reqHeight);
// position buttons
CurBtnPos:=ButtonLeft;
if FButtons<>nil then
for i:=0 to FButtons.Count-1 do begin
if i>0 then
Inc(CurBtnPos,cBtnDist);
CurButton:=TBitBtn(FButtons[i]);
CalcButtonSize(CurButton,CurBtnWidth,CurBtnHeight);
CurButton.SetBounds(CurBtnPos,ClientHeight-CurBtnHeight-cLabelSpacing,
CurBtnWidth,CurBtnHeight);
Inc(CurBtnPos,CurBtnWidth);
end;
end;
function TQuestionDlg.ShowModal: TModalResult;
begin
LayoutDialog;
Result:=inherited ShowModal;
end;
function TQuestionDlg.FindButton(Order: array of TModalResult): TBitBtn;
var
i: Integer;
CurValue: TModalResult;
j: Integer;
begin
if FButtons=nil then begin
Result:=nil;
exit;
end;
for i:=Low(Order) to High(Order) do begin
CurValue:=Order[i];
for j:=0 to FButtons.Count-1 do begin
Result:=TBitBtn(FButtons[j]);
if Result.ModalResult=CurValue then exit;
end;
end;
Result:=nil;
end;
procedure TQuestionDlg.CalcButtonSize(AButton: TBitBtn; var w, h: Integer);
begin
w:=length(AButton.Caption)*10;
h:=25;
Canvas.GetTextSize(AButton.Caption,w,h);
if AButton.Kind<>bkCustom then begin
inc(w,22); // icon
end;
h:=Max(h,22); // icon
inc(w,12); // borders
inc(h,6); // borders
end;
procedure TQuestionDlg.ButtonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Handled: Boolean;
begin
if Shift<>[] then exit;
Handled:=true;
if (Key=VK_ESCAPE) and (CancelControl<>nil) then
CancelControl.ExecuteCancelAction
else if (Key in [VK_RETURN,VK_SPACE]) and (Sender is TBitBtn) then
ModalResult:=TBitBtn(Sender).ModalResult
else if (Key=VK_RETURN) and (DefaultControl<>nil) then
DefaultControl.ExecuteDefaultAction
else if (Key=VK_LEFT) then
TWinControl(Sender).PerformTab(false)
else if (Key=VK_RIGHT) then
TWinControl(Sender).PerformTab(true)
else
Handled:=false;
if Handled then Key:=VK_UNKNOWN;
end;
constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
var
i: Integer;
CurBtnValue: TModalResult;
CurBtnCaption: String;
NewButton: TBitBtn;
NewKind: TBitBtnKind;
NewCaption: String;
dlgId: LongInt;
ok: Boolean;
begin
inherited Create(nil);
MessageTxt:=aMsg;
HelpContext:=HelpCtx;
OnKeyDown:=@ButtonKeyDown;
ok:=false;
try
i:=Low(Buttons);
while i<=High(Buttons) do begin
if Buttons[i].VType=vtInteger then begin
// get TModalResult
CurBtnValue:=Buttons[i].VInteger;
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue));
inc(i);
// get button caption
CurBtnCaption:='';
if (i<=High(Buttons)) then begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
case Buttons[i].VType of
vtString: CurBtnCaption:=Buttons[i].VString^;
vtAnsiString: CurBtnCaption:=AnsiString(Buttons[i].VAnsiString);
vtChar: CurBtnCaption:=Buttons[i].VChar;
vtPChar: CurBtnCaption:=Buttons[i].VPChar;
{$ifndef VER1_0}
vtPWideChar: CurBtnCaption:=Buttons[i].VPWideChar;
vtWideChar: CurBtnCaption:=Buttons[i].VWideChar;
vtWidestring: CurBtnCaption:=WideString(Buttons[i].VWideString);
{$endif VER1_0}
else
dec(i);
end;
inc(i);
end;
if CurBtnCaption='' then begin
// find default caption
Case CurBtnValue of
mrOk : CurBtnCaption:=rsmbOk;
mrCancel : CurBtnCaption:=rsmbCancel;
mrYes : CurBtnCaption:=rsmbYes;
mrNo : CurBtnCaption:=rsmbNo;
mrAbort : CurBtnCaption:=rsmbAbort;
mrRetry : CurBtnCaption:=rsmbRetry;
mrIgnore : CurBtnCaption:=rsmbIgnore;
mrAll : CurBtnCaption:=rsmbAll;
mrYesToAll : CurBtnCaption:=rsmbYesToAll;
mrNoToAll : CurBtnCaption:=rsmbNoToAll;
end;
end;
if CurBtnCaption='' then begin
raise Exception.Create(
'TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
end;
// get button kind
case curBtnValue of
mrOk: NewKind:=bkOK;
mrCancel: NewKind:=bkCancel;
mrYes: NewKind:=bkYes;
mrNo: NewKind:=bkNo;
mrAbort: NewKind:=bkAbort;
mrRetry: NewKind:=bkRetry;
mrIgnore: NewKind:=bkIgnore;
mrAll: NewKind:=bkAll;
mrNoToAll: NewKind:=bkNoToAll;
mrYesToAll: NewKind:=bkYesToAll;
else NewKind:=bkCustom;
end;
// add button
if FButtons=nil then FButtons:=TList.Create;
NewButton:=TBitBtn.Create(Self);
with NewButton do begin
AutoSize:=false;
ModalResult:=curBtnValue;
Caption:=curBtnCaption;
Layout:=blGlyphLeft;
Kind:=NewKind;
Parent:=Self;
OnKeyDown:=@ButtonKeyDown;
end;
FButtons.Add(NewButton);
end else
raise Exception.Create(
'TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
end;
ok:=true;
finally
if not Ok then
FreeAndNil(FButtons);
end;
FBitmap := nil;
NewCaption:=ACaption;
FBitmap := TBitmap.Create;
Case DlgType of
mtWarning, mtError, mtInformation, mtConfirmation:
begin
dlgId:=DialogIds[DlgType];
FBitmap.Handle := LoadStockPixmap(dlgId);
if NewCaption='' then
NewCaption := GetDialogCaption(dlgId);
end;
else begin
FBitmap.Handle := LoadStockPixmap(idDialogInfo);
end
end;
if NewCaption='' then
NewCaption := Application.Title;
Caption:=NewCaption;
// find default and cancel button
DefaultControl:=FindButton([mrYes,mrOk,mrYesToAll,mrAll,mrRetry,mrCancel,
mrNo,mrNoToAll,mrAbort,mrIgnore]);
CancelControl:=FindButton([mrNo,mrAbort,mrCancel,mrIgnore,mrNoToAll,mrYes,
mrOk,mrRetry,mrAll,mrYesToAll])
end;
destructor TQuestionDlg.Destroy;
begin
FreeAndNil(FButtons);
FreeAndNil(FBitmap);
inherited Destroy;
end;
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
Buttons: array of const; HelpCtx: Longint): TModalResult;
{ Show a dialog with aCaption as Title, aMsg as Text, DlgType as Icon,
HelpCtx as Help context and Buttons to define the shown buttons and their
TModalResult.
Buttons is a list of TModalResult and strings. For each number a button is
created. To set a custom caption, add a string after a button.
The default TModalResults defined in controls.pp (mrNone..mrLast) don't need
a caption. The default captions will be used.
Examples for Buttons:
[mrOk,mrCancel,'Cancel now',mrIgnore,300,'Do it']
This will result in 4 buttons:
'Ok' returning mrOk
'Cancel now' returning mrCancel
'Ignore' returning mrIgnore
'Do it' returning 300
}
var
QuestionDialog: TQuestionDlg;
begin
QuestionDialog:=TQuestionDlg.CreateQuestionDlg(aCaption,aMsg,DlgType,Buttons,
HelpCtx);
try
Result:=QuestionDialog.ShowModal;
finally
QuestionDialog.Free;
end;
end;
// included by dialogs.pp // included by dialogs.pp
{ {
$Log$ $Log$
Revision 1.18 2005/01/27 19:03:51 mattias
added QuestionDlg - a MessageDlg with custom buttons
Revision 1.17 2004/09/24 13:45:32 mattias Revision 1.17 2004/09/24 13:45:32 mattias
fixed TCanvas.TextRect Delphi compatible Rect and added TBarChart from Michael VC fixed TCanvas.TextRect Delphi compatible Rect and added TBarChart from Michael VC

7
lcl/include/scrollingwincontrol.inc
View File

@ -114,6 +114,13 @@ begin
Result:=VertScrollBar.Visible and HorzScrollBar.Visible; Result:=VertScrollBar.Visible and HorzScrollBar.Visible;
end; end;
procedure TScrollingWinControl.DestroyWnd;
begin
inherited DestroyWnd;
if Canvas<>nil then
Canvas.Handle:=0;
end;
Function TScrollingWinControl.StoreScrollBars : Boolean; Function TScrollingWinControl.StoreScrollBars : Boolean;
begin begin
Result := Not AutoScroll; Result := Not AutoScroll;

12
lcl/include/treeview.inc
View File

@ -223,15 +223,19 @@ begin
Result := 0; Result := 0;
end; end;
function TTreeNode.GetParentNodeOfAbsoluteLevel(AAbsoluteLevel:integer):TTreeNode; function TTreeNode.GetParentNodeOfAbsoluteLevel(
var i, x : integer; TheAbsoluteLevel: integer): TTreeNode;
var
i: integer;
l: LongInt;
begin begin
if (AAbsoluteLevel > Level) OR (AAbsoluteLevel < 0) then l:=Level;
if (TheAbsoluteLevel > l) or (TheAbsoluteLevel < 0) then
Result := nil Result := nil
else else
begin begin
Result := Self; Result := Self;
for i := AAbsoluteLevel to Level-1 do for i := TheAbsoluteLevel to l-1 do
Result := Result.Parent; Result := Result.Parent;
end; end;
end; end;

9
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -2784,6 +2784,9 @@ var
theRect.Right := theRect.Left + LineWidth; theRect.Right := theRect.Left + LineWidth;
theRect.Bottom := theRect.Top + NumLines*TM.tmHeight; theRect.Bottom := theRect.Top + NumLines*TM.tmHeight;
if NumLines>1 then
Inc(theRect.Bottom, (NumLines-1)*TM.tmDescent);// space between lines
//debugln('TGtkWidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines)); //debugln('TGtkWidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
end; end;
@ -2905,6 +2908,9 @@ begin
end end
else If (Lines <> nil) and (NumLines <> 0) then begin else If (Lines <> nil) and (NumLines <> 0) then begin
For I := 0 to NumLines - 1 do begin For I := 0 to NumLines - 1 do begin
if I>0 then
Inc(theRect.Top, TM.tmDescent);// space between lines
If (((Flags and DT_EditControl) = DT_EditControl) and If (((Flags and DT_EditControl) = DT_EditControl) and
(tm.tmHeight > (theRect.Bottom - theRect.Top))) or (tm.tmHeight > (theRect.Bottom - theRect.Top))) or
(theRect.Top > theRect.Bottom) (theRect.Top > theRect.Bottom)
@ -8857,6 +8863,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.389 2005/01/27 19:03:51 mattias
added QuestionDlg - a MessageDlg with custom buttons
Revision 1.388 2005/01/22 23:53:43 mattias Revision 1.388 2005/01/22 23:53:43 mattias
fixed gtk2 intf from Peter Vreman fixed gtk2 intf from Peter Vreman