mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 03:49:41 +02:00
started TCustomDockForm
git-svn-id: trunk@5807 -
This commit is contained in:
mattias
parent
d2c46c3582
commit
8fbf5f70d1
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1064,6 +1064,7 @@ lcl/include/customcheckbox.inc svneol=native#text/pascal
|
||||
lcl/include/customcheckgroup.inc svneol=native#text/pascal
|
||||
lcl/include/customcombobox.inc svneol=native#text/pascal
|
||||
lcl/include/customcontrol.inc svneol=native#text/pascal
|
||||
lcl/include/customdockform.inc svneol=native#text/pascal
|
||||
lcl/include/customedit.inc svneol=native#text/pascal
|
||||
lcl/include/customform.inc svneol=native#text/pascal
|
||||
lcl/include/customframe.inc svneol=native#text/pascal
|
||||
|
||||
67
lcl/forms.pp
67
lcl/forms.pp
@ -138,21 +138,17 @@ type
|
||||
|
||||
TScrollingWinControl = class(TWinControl)
|
||||
private
|
||||
FHorzScrollBar : TControlScrollBar;
|
||||
FVertScrollBar : TControlScrollBar;
|
||||
FAutoScroll : Boolean;
|
||||
|
||||
FHorzScrollBar: TControlScrollBar;
|
||||
FVertScrollBar: TControlScrollBar;
|
||||
FAutoScroll: Boolean;
|
||||
FOnPaint: TNotifyEvent;
|
||||
|
||||
FCanvas : TControlCanvas;
|
||||
|
||||
IsUpdating : Boolean;
|
||||
|
||||
FCanvas: TControlCanvas;
|
||||
FIsUpdating: Boolean;
|
||||
procedure SetAutoScroll(Value: Boolean);
|
||||
procedure SetHorzScrollBar(Value: TControlScrollBar);
|
||||
procedure SetVertScrollBar(Value: TControlScrollBar);
|
||||
Function StoreScrollBars : Boolean;
|
||||
Protected
|
||||
protected
|
||||
procedure AlignControls(AControl: TControl; var ARect: TRect); override;
|
||||
procedure CreateWnd; override;
|
||||
Procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
||||
@ -162,16 +158,13 @@ type
|
||||
Procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
|
||||
procedure ScrollBy(DeltaX, DeltaY: Integer);
|
||||
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
||||
Public
|
||||
public
|
||||
Constructor Create(AOwner : TComponent); Override;
|
||||
Destructor Destroy; Override;
|
||||
|
||||
procedure Paint; dynamic;
|
||||
procedure PaintWindow(dc : Hdc); override;
|
||||
|
||||
procedure UpdateScrollbars; virtual;
|
||||
function HasVisibleScrollbars: boolean; virtual;
|
||||
|
||||
property Canvas: TControlCanvas read FCanvas;
|
||||
published
|
||||
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll;
|
||||
@ -291,15 +284,15 @@ type
|
||||
property OnConstrainedResize;
|
||||
property OnContextPopup;
|
||||
property OnDblClick;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
property OnDockDrop;
|
||||
property OnDockOver;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDock;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
//property OnGetSiteInfo;
|
||||
property OnGetSiteInfo;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
@ -309,7 +302,7 @@ type
|
||||
property OnResize;
|
||||
property OnStartDock;
|
||||
property OnStartDrag;
|
||||
//property OnUnDock;
|
||||
property OnUnDock;
|
||||
end;
|
||||
|
||||
|
||||
@ -436,6 +429,10 @@ type
|
||||
procedure WndProc(var TheMessage : TLMessage); override;
|
||||
function VisibleIsStored: boolean;
|
||||
function ColorIsStored: boolean; override;
|
||||
protected
|
||||
// drag and dock
|
||||
procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override;
|
||||
function GetFloating: Boolean; override;
|
||||
protected
|
||||
// actions
|
||||
procedure CMActionExecute(var Message: TLMessage); message CM_ACTIONEXECUTE;
|
||||
@ -445,7 +442,7 @@ type
|
||||
procedure UpdateActions; virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
constructor CreateNew(AOwner: TComponent; Num : Integer); virtual;
|
||||
constructor CreateNew(AOwner: TComponent; Num : Integer{=0}); virtual;
|
||||
procedure BeforeDestruction; override;
|
||||
function GetIconHandle: HICON;
|
||||
destructor Destroy; override;
|
||||
@ -468,6 +465,9 @@ type
|
||||
procedure RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent);
|
||||
procedure AddHandlerClose(OnCloseHandler: TCloseEvent; AsLast: Boolean);
|
||||
procedure RemoveHandlerClose(OnCloseHandler: TCloseEvent);
|
||||
public
|
||||
// drag and dock
|
||||
procedure Dock(NewDockSite: TWinControl; ARect: TRect); override;
|
||||
public
|
||||
property Active: Boolean read FActive;
|
||||
property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
|
||||
@ -518,6 +518,7 @@ type
|
||||
FClientHandle: HWND;
|
||||
public
|
||||
property ClientHandle: HWND read FClientHandle;
|
||||
property DockManager;
|
||||
published
|
||||
property Action;
|
||||
property ActiveControl;
|
||||
@ -529,6 +530,7 @@ type
|
||||
property ClientWidth;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DockSite;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property FormStyle;
|
||||
@ -543,6 +545,10 @@ type
|
||||
property OnCreate;
|
||||
property OnDeactivate;
|
||||
property OnDestroy;
|
||||
property OnDockDrop;
|
||||
property OnDockOver;
|
||||
property OnEndDock;
|
||||
property OnGetSiteInfo;
|
||||
property OnHide;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
@ -554,6 +560,8 @@ type
|
||||
property OnPaint;
|
||||
property OnResize;
|
||||
property OnShow;
|
||||
property OnStartDock;
|
||||
property OnUnDock;
|
||||
property ParentFont;
|
||||
property PixelsPerInch;
|
||||
property PopupMenu;
|
||||
@ -561,6 +569,7 @@ type
|
||||
property SessionProperties;
|
||||
property ShowHint;
|
||||
property TextHeight;
|
||||
property UseDockManager;
|
||||
property Visible;
|
||||
property WindowState;
|
||||
end;
|
||||
@ -568,6 +577,25 @@ type
|
||||
TFormClass = class of TForm;
|
||||
|
||||
|
||||
{ TCustomDockForm }
|
||||
|
||||
TCustomDockForm = class(TCustomForm)
|
||||
protected
|
||||
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
|
||||
procedure DoRemoveDockClient(Client: TControl); override;
|
||||
procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
|
||||
MousePos: TPoint; var CanDock: Boolean); override;
|
||||
procedure Loaded; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
property AutoScroll default False;
|
||||
property BorderStyle default bsSizeToolWin;
|
||||
property FormStyle default fsStayOnTop;
|
||||
published
|
||||
property PixelsPerInch;
|
||||
end;
|
||||
|
||||
|
||||
{ THintWindow }
|
||||
|
||||
THintWindow = class(TCustomForm)
|
||||
@ -1522,6 +1550,7 @@ end;
|
||||
{$I scrollbox.inc}
|
||||
{$I customframe.inc}
|
||||
{$I customform.inc}
|
||||
{$I customdockform.inc}
|
||||
{$I screen.inc}
|
||||
{$I application.inc}
|
||||
{$I applicationproperties.inc}
|
||||
|
||||
71
lcl/include/customdockform.inc
Normal file
71
lcl/include/customdockform.inc
Normal file
@ -0,0 +1,71 @@
|
||||
{%MainUnit ../forms.pp}
|
||||
|
||||
{******************************************************************************
|
||||
TCustomDockForm
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.LCL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{ TCustomDockForm }
|
||||
|
||||
procedure TCustomDockForm.DoAddDockClient(Client: TControl; const ARect: TRect
|
||||
);
|
||||
begin
|
||||
inherited DoAddDockClient(Client, ARect);
|
||||
Client.Align := alClient;
|
||||
if ([csLoading,csDestroying]*ComponentState=[]) then
|
||||
Visible := True;
|
||||
end;
|
||||
|
||||
procedure TCustomDockForm.DoRemoveDockClient(Client: TControl);
|
||||
begin
|
||||
inherited DoRemoveDockClient(Client);
|
||||
if DockClientCount = 0 then Release;
|
||||
end;
|
||||
|
||||
procedure TCustomDockForm.GetSiteInfo(Client: TControl;
|
||||
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
|
||||
begin
|
||||
CanDock := (DockClientCount=0);
|
||||
end;
|
||||
|
||||
procedure TCustomDockForm.Loaded;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// dock child controls after loading
|
||||
for i:=0 to ControlCount-1 do
|
||||
Controls[i].Dock(Self,ClientRect);
|
||||
inherited Loaded;
|
||||
end;
|
||||
|
||||
constructor TCustomDockForm.Create(TheOwner: TComponent);
|
||||
begin
|
||||
CreateNew(TheOwner,0);
|
||||
AutoScroll := False;
|
||||
BorderStyle := bsSizeToolWin;
|
||||
DockSite := True;
|
||||
FormStyle := fsStayOnTop;
|
||||
end;
|
||||
|
||||
// included by forms.pp
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.1 2004/08/16 22:09:18 mattias
|
||||
started TCustomDockForm
|
||||
|
||||
}
|
||||
@ -1,7 +1,7 @@
|
||||
{%MainUnit ../forms.pp}
|
||||
|
||||
{******************************************************************************
|
||||
TCustomForm
|
||||
TCustomForm
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
@ -825,6 +825,19 @@ begin
|
||||
Result:=(Color<>clBtnFace);
|
||||
end;
|
||||
|
||||
procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect);
|
||||
begin
|
||||
if (NewDockSite<>HostDockSite) then begin
|
||||
|
||||
end;
|
||||
inherited DoDock(NewDockSite, ARect);
|
||||
end;
|
||||
|
||||
function TCustomForm.GetFloating: Boolean;
|
||||
begin
|
||||
Result := (HostDockSite = nil) and (FloatingDockSiteClass = ClassType);
|
||||
end;
|
||||
|
||||
procedure TCustomForm.CMActionExecute(var Message: TLMessage);
|
||||
begin
|
||||
if DoExecuteAction(TBasicAction(Message.LParam)) then
|
||||
@ -1077,8 +1090,8 @@ end;
|
||||
constructor TCustomForm.Create(AOwner : TComponent);
|
||||
begin
|
||||
//DebugLn('[TCustomForm.Create] A Class=',Classname);
|
||||
BeginFormUpdate;
|
||||
try
|
||||
BeginFormUpdate;
|
||||
CreateNew(AOwner, 1);
|
||||
//DebugLn('[TCustomForm.Create] B Class=',Classname);
|
||||
if (ClassType <> TForm) and not (csDesigning in ComponentState) then
|
||||
@ -1098,8 +1111,8 @@ begin
|
||||
Exclude(FFormState, fsCreating);
|
||||
end;
|
||||
end;
|
||||
EndFormUpdate;
|
||||
finally
|
||||
EndFormUpdate;
|
||||
end;
|
||||
//DebugLn('[TCustomForm.Create] END Class=',Classname);
|
||||
end;
|
||||
@ -1660,6 +1673,11 @@ begin
|
||||
RemoveHandler(fhtClose,TMethod(OnCloseHandler));
|
||||
end;
|
||||
|
||||
procedure TCustomForm.Dock(NewDockSite: TWinControl; ARect: TRect);
|
||||
begin
|
||||
inherited Dock(NewDockSite, ARect);
|
||||
end;
|
||||
|
||||
//==============================================================================
|
||||
{$IFNDEF VER1_0}
|
||||
|
||||
@ -1701,6 +1719,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.150 2004/08/16 22:09:18 mattias
|
||||
started TCustomDockForm
|
||||
|
||||
Revision 1.149 2004/08/15 14:39:36 mattias
|
||||
implemented platform independent binary object streamer
|
||||
|
||||
|
||||
@ -112,12 +112,14 @@ end;
|
||||
|
||||
Procedure TScrollingWinControl.UpdateScrollbars;
|
||||
begin
|
||||
If IsUpdating then
|
||||
exit;
|
||||
IsUpdating := True;
|
||||
FVertScrollbar.UpdateScrollbar;
|
||||
FHorzScrollbar.UpdateScrollbar;
|
||||
IsUpdating := False;
|
||||
If FIsUpdating then exit;
|
||||
FIsUpdating := True;
|
||||
try
|
||||
FVertScrollbar.UpdateScrollbar;
|
||||
FHorzScrollbar.UpdateScrollbar;
|
||||
finally
|
||||
FIsUpdating := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TScrollingWinControl.HasVisibleScrollbars: boolean;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user