paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 23:38:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

- move OnGetDockCaption and friends to TWinControl

Browse Source 
- some improvements to dock header drawing

git-svn-id: trunk@13681 -
This commit is contained in:
paul 2008-01-09 09:08:12 +00:00
parent 3764b56bd3
commit be879539ca
10 changed files with 84 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/comctrls.pp
View File

@ -219,13 +219,10 @@ type
property Width stored False;
end;
TGetDockCaptionEvent = procedure(Sender: TObject; AControl: TControl; var ACaption: String) of Object;
{ TPageControl }
TPageControl = class(TCustomNotebook)
private
FOnGetDockCaption: TGetDockCaptionEvent;
FOnPageChanged: TNotifyEvent;
FPageToUndock: TTabSheet;
function GetActivePageIndex: Integer;
@ -241,8 +238,6 @@ type
procedure DoRemoveDockClient(Client: TControl); override;
function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override;
procedure PositionDockRect(DragDockObject: TDragDockObject); override;
function GetDockCaption(AControl: TControl): String;
procedure DoGetDockCaption(AControl: TControl; var ACaption: String); virtual;
public
constructor Create(TheOwner: TComponent); override;
function FindNextPage(CurPage: TTabSheet;
@ -254,7 +249,7 @@ type
property Pages[Index: Integer]: TTabSheet read GetTabSheet;
published
property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet;
property OnGetDockCaption: TGetDockCaptionEvent read FOnGetDockCaption write FOnGetDockCaption;
property OnGetDockCaption;
property Align;
property Anchors;

24
lcl/controls.pp
View File

@ -302,14 +302,17 @@ type
TKeyPressEvent = procedure(Sender: TObject; var Key: char) of Object;
TUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char) of Object;
TMouseEvent = Procedure(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer) of object;
TMouseMoveEvent = Procedure(Sender: TObject; Shift: TShiftState;
X, Y: Integer) of object;
TMouseWheelEvent = Procedure(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of object;
TMouseWheelUpDownEvent = Procedure(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean) of object;
TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer) of Object;
TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
X, Y: Integer) of Object;
TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of Object;
TMouseWheelUpDownEvent = procedure(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean) of Object;
TGetDockCaptionEvent = procedure(Sender: TObject; AControl: TControl;
var ACaption: String) of Object;
{ TDragObject }
@ -1006,6 +1009,7 @@ type
var Accept: Boolean); dynamic;
procedure PositionDockRect(DragDockObject: TDragDockObject); dynamic;
procedure SetDragMode(Value: TDragMode); virtual;
function GetDefaultDockCaption: String; virtual;
//procedure SendDockNotification; virtual; MG: probably not needed
protected
// key and mouse
@ -1484,6 +1488,7 @@ type
FAdjustClientRectRealized: TRect;
FChildSizing: TControlChildSizing;
FControls: TFPList; // the child controls (only TControl, no TWinControl)
FOnGetDockCaption: TGetDockCaptionEvent;
FWinControls: TFPList; // the child controls (only TWinControl, no TControl)
FDefWndProc: Pointer;
FDockClients: TFPList;
@ -1620,6 +1625,7 @@ type
var AControl: TControl); dynamic;
function CreateDockManager: TDockManager; dynamic;
procedure DoFloatMsg(ADockSource: TDragDockObject); override;//CM_FLOAT
procedure DoGetDockCaption(AControl: TControl; var ACaption: String); virtual;
protected
// mouse and keyboard
procedure DoEnter; dynamic;
@ -1688,6 +1694,7 @@ type
// properties which are not supported by all descendents
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo;
property OnGetDockCaption: TGetDockCaptionEvent read FOnGetDockCaption write FOnGetDockCaption;
public
// properties which are supported by all descendents
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
@ -1774,6 +1781,7 @@ type
procedure SetFocus; virtual;
function FindChildControl(const ControlName: String): TControl;
procedure FlipChildren(AllLevels: Boolean); dynamic;
function GetDockCaption(AControl: TControl): String; virtual;
procedure GetTabOrderList(List: TFPList);
function HandleAllocated: Boolean;
procedure HandleNeeded;

2
lcl/extctrls.pp
View File

@ -1005,6 +1005,7 @@ type
procedure AdjustClientRect(var Rect: TRect); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
function GetDefaultDockCaption: String; override;
procedure Loaded; override;
procedure RealSetText(const Value: TCaption); override;
procedure Paint; override;
@ -1072,6 +1073,7 @@ type
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnGetDockCaption;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;

1
lcl/forms.pp
View File

@ -477,6 +477,7 @@ type
// drag and dock
procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override;
function GetFloating: Boolean; override;
function GetDefaultDockCaption: String; override;
protected
// actions
procedure CMActionExecute(var Message: TLMessage); message CM_ACTIONEXECUTE;

5
lcl/include/control.inc
View File

@ -2906,6 +2906,11 @@ begin
FDragMode := Value;
end;
function TControl.GetDefaultDockCaption: String;
begin
Result := '';
end;
{------------------------------------------------------------------------------
TControl DockTrackNoTarget
------------------------------------------------------------------------------}

5
lcl/include/customform.inc
View File

@ -1049,6 +1049,11 @@ begin
Result := (HostDockSite = nil) and (FloatingDockSiteClass = ClassType);
end;
function TCustomForm.GetDefaultDockCaption: String;
begin
Result := Caption;
end;
procedure TCustomForm.CMActionExecute(var Message: TLMessage);
begin
if DoExecuteAction(TBasicAction(Message.LParam)) then

5
lcl/include/custompanel.inc
View File

@ -165,6 +165,11 @@ begin
inherited;
end;
function TCustomPanel.GetDefaultDockCaption: String;
begin
Result := Caption;
end;
procedure TCustomPanel.RealSetText(const Value: TCaption);
begin
if Caption <> Value

17
lcl/include/pagecontrol.inc
View File

@ -108,23 +108,6 @@ begin
DragDockObject.DockRect := Rect(P.X, P.Y, P.X + Width, P.Y + Height);
end;
function TPageControl.GetDockCaption(AControl: TControl): String;
begin
// for some usual controls
if AControl is TCustomPanel then
Result := TCustomPanel(AControl).Caption
else
if AControl is TCustomForm then
Result := TCustomForm(AControl).Caption;
DoGetDockCaption(AControl, Result);
end;
procedure TPageControl.DoGetDockCaption(AControl: TControl; var ACaption: String);
begin
if Assigned(FOnGetDockCaption) then
OnGetDockCaption(Self, AControl, ACaption);
end;
constructor TPageControl.Create(TheOwner: TComponent);
begin
PageClass:=TTabSheet;

12
lcl/include/wincontrol.inc
View File

@ -4855,6 +4855,18 @@ begin
inherited;
end;
function TWinControl.GetDockCaption(AControl: TControl): String;
begin
Result := AControl.GetDefaultDockCaption;
DoGetDockCaption(AControl, Result);
end;
procedure TWinControl.DoGetDockCaption(AControl: TControl; var ACaption: String);
begin
if Assigned(FOnGetDockCaption) then
OnGetDockCaption(Self, AControl, ACaption);
end;
{------------------------------------------------------------------------------
Procedure TWinControl.MainWndProc(Var Message : TLMessage);

68
lcl/ldocktree.pas
View File

@ -72,6 +72,7 @@ type
procedure PaintDockFrame(ACanvas: TCanvas; AControl: TControl;
const ARect: TRect); override;
procedure UndockControlForDocking(AControl: TControl);
function DefaultDockGrabberSize: Integer;
public
constructor Create(TheDockSite: TWinControl); override;
destructor Destroy; override;
@ -205,7 +206,6 @@ type
const
DefaultDockGrabberSize = 15;
DockAlignOrientations: array[TAlign] of TDockOrientation = (
doPages, //alNone,
doVertical, //alTop,
@ -612,6 +612,11 @@ begin
end;
end;
function TLazDockTree.DefaultDockGrabberSize: Integer;
begin
Result := {Abs(DockSite.Font.Height) + 4} 20;
end;
procedure TLazDockTree.BreakAnchors(Zone: TDockZone);
begin
if Zone=nil then exit;
@ -631,7 +636,19 @@ var
BtnRect: TRect;
DrawRect: TRect;
d: integer;
DockCaption: String;
TextStyle: TTextStyle;
begin
DockCaption := DockSite.GetDockCaption(AControl);
TextStyle.Alignment := taLeftJustify;
TextStyle.Layout := tlCenter;
TextStyle.SingleLine := True;
TextStyle.Clipping := True;
TextStyle.Opaque := False;
TextStyle.Wordbreak := False;
TextStyle.SystemFont := False;
TextStyle.RightToLeft := AControl.UseRightToLeftAlignment;
DrawRect := ARect;
InflateRect(DrawRect, -1, -1);
ACanvas.Brush.Color := clBtnShadow;
@ -642,7 +659,6 @@ begin
begin
d := DrawRect.Bottom - DrawRect.Top;
BtnRect := DrawRect;
Dec(BtnRect.Right);
BtnRect.Left := BtnRect.Right - d;
Details := ThemeServices.GetElementDetails(twMDICloseButtonNormal);
ThemeServices.DrawElement(ACanvas.Handle, Details, BtnRect);
@ -656,21 +672,13 @@ begin
DrawRect.Right := BtnRect.Left;
InflateRect(DrawRect, -4, 0);
d := (DrawRect.Bottom + DrawRect.Top) div 2;
ACanvas.Pen.Color := clBtnHighlight;
ACanvas.MoveTo(DrawRect.Left, d - 1);
ACanvas.LineTo(DrawRect.Right, d - 1);
ACanvas.Pen.Color := clBtnShadow;
ACanvas.MoveTo(DrawRect.Left, d);
ACanvas.LineTo(DrawRect.Right, d);
ACanvas.TextRect(DrawRect, DrawRect.Left, DrawRect.Top, DockCaption, TextStyle);
end;
doVertical:
begin
d := DrawRect.Right - DrawRect.Left;
BtnRect := DrawRect;
Inc(BtnRect.Top);
BtnRect.Bottom := BtnRect.Top + d;
Details := ThemeServices.GetElementDetails(twMDICloseButtonNormal);
ThemeServices.DrawElement(ACanvas.Handle, Details, BtnRect);
@ -684,15 +692,8 @@ begin
DrawRect.Top := BtnRect.Bottom;
InflateRect(DrawRect, 0, -4);
d := (DrawRect.Right + DrawRect.Left) div 2;
ACanvas.Pen.Color := clBtnHighlight;
ACanvas.MoveTo(d - 1, DrawRect.Top);
ACanvas.LineTo(d - 1, DrawRect.Bottom);
ACanvas.Pen.Color := clBtnShadow;
ACanvas.MoveTo(d, DrawRect.Top);
ACanvas.LineTo(d, DrawRect.Bottom);
ACanvas.TextRect(DrawRect, DrawRect.Left, DrawRect.Bottom, DockCaption, TextStyle);
end;
end;
end;
@ -757,8 +758,10 @@ procedure TLazDockTree.AdjustDockRect(AControl: TControl; var ARect: TRect);
begin
// offset one of the borders of control rect in order to get space for frame
case AControl.DockOrientation of
doHorizontal: Inc(ARect.Top, DefaultDockGrabberSize);
doVertical : Inc(ARect.Left, DefaultDockGrabberSize);
doHorizontal:
Inc(ARect.Top, DefaultDockGrabberSize);
doVertical:
Inc(ARect.Left, DefaultDockGrabberSize);
end;
end;
@ -805,16 +808,18 @@ begin
// anchor pages
// IMPORTANT: first set the AnchorSide, then set the Anchors
//DebugLn(['TLazDockTree.AnchorDockLayout CurControl.Parent=',DbgSName(CurControl.Parent),' ',CurControl.Visible]);
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
CurControl.AnchorSide[a].Control:=AnchorControls[a];
if (AnchorControls[a]<>nil)
and (AnchorControls[a].Parent=CurControl.Parent) then begin
CurControl.AnchorSide[a].Side:=DefaultSideForAnchorKind[a];
end else begin
CurControl.AnchorSide[a].Side:=DefaultSideForAnchorKind[OppositeAnchor[a]];
end;
for a := Low(TAnchorKind) to High(TAnchorKind) do
begin
CurControl.AnchorSide[a].Control := AnchorControls[a];
if (AnchorControls[a] <> nil) and (AnchorControls[a].Parent = CurControl.Parent) then
CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[a]
else
CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[OppositeAnchor[a]];
end;
CurControl.Anchors:=NewAnchors;
CurControl.Anchors := NewAnchors;
// how to set space for header?
//CurControl.BorderSpacing.Top := CurControl.BoundsRect.Top;
//CurControl.BorderSpacing.Left := CurControl.BoundsRect.Left;
end;
// anchor controls for childs and siblings
@ -895,7 +900,7 @@ procedure TLazDockTree.InsertControl(AControl: TControl; InsertAt: TAlign;
begin
AControl.Align := alNone;
AControl.Anchors := [akLeft, akTop];
for a:=Low(TAnchorKind) to High(TAnchorKind) do
for a := Low(TAnchorKind) to High(TAnchorKind) do
AControl.AnchorSide[a].Control := nil;
AControl.AutoSize := False;
end;
@ -1049,6 +1054,7 @@ begin
// Build dock layout (anchors, splitters, pages)
BuildDockLayout(RootZone as TLazDockZone);
DockSite.Invalidate; // to redraw dock headers
end;
procedure TLazDockTree.BuildDockLayout(Zone: TLazDockZone);