TDockPanel
TDockPanel – a simple native component to provide edge-aligned docking which looks and feels like those used in RAD Studio 2010. Simply drop one or more instance(s) of TDockPanel onto a valid TWinControl descendant (such as a TForm or a TPanel), set the alignment of each TDockPanel to the side onto which you wish to be able to dock qualifying controls. Now, once you set the qualifying objects into Dock mode (DragKind := dkDock), you can drag them onto the desired edges and they will dock just like in Delphi 2010.
At present I haven’t put in handling for the blue overlay (which highlights the area onto which you are dropping the dockable object), so it uses the more “old-fashioned” Rect Border (the Delphi default)… in the near-future I’ll correct this, once time permits.
Now, for your enjoyment, here is the UDockPanel.pas unit’s source code… simply save this, add it to a package (or create a new package), install that package (if necessary), and you’ll have TDockPanel on your component pallet.
unit UDockPanel;
interface
uses
Windows, SysUtils, Classes, Forms, Controls, ExtCtrls, ComCtrls, Graphics, Tabs, DockTabSet;
type
TDockPanel = class(TCustomPanel)
private
{ Members }
FAlign: TAlign;
FDockTabs: TDockTabSet;
FSplitter: TSplitter;
FDockPanel: TPanel;
FOWidth: Integer;
FOHeight: Integer;
FOriginalColor: TColor;
{ Methods }
procedure WhenResized(Sender: TObject);
procedure TabsChanged(Sender: TObject);
procedure DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
procedure DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure GetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
procedure UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
procedure ShowDockPanel(APanel: TPanel; MakeVisible: Boolean; Client: TControl);
protected
procedure Paint; override;
procedure DrawDockStuff;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Splitter: TSplitter read FSplitter;
property Tabs: TDockTabSet read FDockTabs;
property Dock: TPanel read FDockPanel;
end;
procedure Register;
implementation
{ TDockPanel }
constructor TDockPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// SET DEFAULTS
FullRepaint := True;
FAlign := Align;
Caption := 'Dock Target';
ShowCaption := True;
Self.BevelOuter := bvNone;
Self.BevelInner := bvNone;
Self.Align := alBottom;
// CREATE SUB OBJECTS
FDockTabs := TDockTabSet.Create(Self);
FSplitter := TSplitter.Create(Self);
FDockPanel := TPanel.Create(Self);
// PARENT THE SUB OBJECTS
FDockPanel.SetParentComponent(Self);
// CONFIGURE THE DOCK PANEL
FDockPanel.DockSite := True;
FDockPanel.BevelOuter := bvNone;
FDockPanel.BevelInner := bvNone;
FDockPanel.Align := alClient;
// CONFIGURE THE DOCK TABS
FDockTabs.DestinationDockSite := FDockPanel;
FDockTabs.Style := tsStandard;
FDockTabs.SoftTop := True;
FDockTabs.Width := 25;
FDockTabs.Height := 25;
FDockTabs.AutoSelect := True;
FDockTabs.AutoScroll := True;
// CONFIGURE THE SPLITTER
FSplitter.Beveled := True;
FSplitter.Height := 4;
FSplitter.Width := 4;
// SET EVENTS
FDockTabs.OnTabAdded := TabsChanged;
FDockTabs.OnTabRemoved := TabsChanged;
FDockPanel.OnDockDrop := DockDrop;
FDockPanel.OnDockOver := DockOver;
FDockPanel.OnGetSiteInfo := GetSiteInfo;
FDockPanel.OnUnDock := UnDock;
// HIDE ELEMENTS WE DON'T WANT DISPLAYED YET
FSplitter.Visible := False;
FDockTabs.Visible := False;
// REDRAW THE ELEMENT;
// WhenResized(Self);
end;
procedure TDockPanel.WhenResized(Sender: TObject);
begin
if Align = alTop then begin
FSplitter.Top := 0;
Self.Top := 0;
FDockTabs.Top := 0;
end else if Align = alBottom then begin
FSplitter.Top := TWinControl(Self.GetParentComponent).Height;
Self.Top := TWinControl(Self.GetParentComponent).Height;
FDockTabs.Top := TWinControl(Self.GetParentComponent).Height;
end else if Align = alLeft then begin
Self.Left := 0;
FSplitter.Left := 0;
Self.Left := 0;
FDockTabs.Left := 0;
end else if Align = alRight then begin
Self.Left := TWinControl(Self.GetParentComponent).Width;
FSplitter.Left := TWinControl(Self.GetParentComponent).Width;
Self.Left := TWinControl(Self.GetParentComponent).Width;
FDockTabs.Left := TWinControl(Self.GetParentComponent).Width;
end;
Parent.Refresh;
Parent.Repaint;
Parent.Update;
Self.Refresh;
Self.Repaint;
Self.Update;
end;
destructor TDockPanel.Destroy;
begin
inherited Destroy;
end;
procedure TDockPanel.DrawDockStuff;
begin
FAlign := Align;
ShowCaption := False;
FDockTabs.SetParentComponent(Self.GetParentComponent);
FSplitter.SetParentComponent(Self.GetParentComponent);
FOWidth := Self.Width;
FOHeight := Self.Height;
// WE WANT TO HIDE THE CONTROLS PROPERLY IF THERE ARE NO CHILD OBJECTS
if Self.FDockPanel.ControlCount = 0 then begin
if (Align = alTop) or (Align = alBottom) or (not (Align = alRight) and not (Align = alLeft)) then begin
Self.FDockPanel.Height := 1;
Self.Height := 1;
end else if (Align = alLeft) or (Align = alRight) then begin
Self.FDockPanel.Width := 1;
Self.Width := 1;
end;
FSplitter.Hide;
end;
FDockPanel.Show;
if (Align <> alBottom) and (Align <> alTop) and (Align <> alLeft) and (Align <> alRight) then begin
FDockTabs.Align := alTop;
FSplitter.Align := alTop;
end else begin
FDockTabs.Align := FAlign;
FSplitter.Align := FAlign;
end;
if Align = alBottom then begin
FDockTabs.TabPosition := tpTop;
end else if Align = alTop then begin
FDockTabs.TabPosition := tpBottom;
end else if Align = alLeft then begin
FDockTabs.TabPosition := tpRight;
end else if Align = alRight then begin
FDockTabs.TabPosition := tpLeft;
end else begin
Caption := 'Must be aligned to Bottom, Top, Left or Right';
ShowCaption := True;
end;
end;
procedure TDockPanel.Paint;
begin
inherited;
if FAlign <> Align then begin
DrawDockStuff;
end;
end;
procedure TDockPanel.TabsChanged(Sender: TObject);
begin
if TDockTabSet(Sender).Tabs.Count > 0 then
TDockTabSet(Sender).Show
else
TDockTabSet(Sender).Hide;
if Align = alBottom then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Height := 25;
end;
end else if Align = alTop then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Height := 25;
end;
end else if Align = alLeft then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Width := 25;
end;
end else if Align = alRight then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Width := 25;
end;
end;
WhenResized(Self);
end;
procedure TDockPanel.DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
begin
if (Sender as TPanel).DockClientCount = 1 then
ShowDockPanel(Sender as TPanel, True, Source.Control);
(Sender as TPanel).DockManager.ResetBounds(True);
end;
procedure TDockPanel.DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
begin
Accept := Source.Control is TWinControl;
end;
procedure TDockPanel.GetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean);
begin
CanDock := DockClient is TWinControl;
end;
procedure TDockPanel.UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
begin
if (Sender as TPanel).DockClientCount = 1 then
ShowDockPanel(Sender as TPanel, False, Client);
end;
procedure TDockPanel.ShowDockPanel(APanel: TPanel; MakeVisible: Boolean; Client: TControl);
begin
if not MakeVisible and (APanel.VisibleDockClientCount > 1) then
Exit;
FSplitter.Visible := MakeVisible;
if MakeVisible then begin
if Align = alLeft then begin
Self.Width := Client.Width or FOWidth or 200;
end else if Align = alRight then begin
Self.Width := Client.Width or FOWidth or 200;
end else if Align = alTop then begin
Self.Height := Client.Height or FOHeight or 200;
end else if Align = alBottom then begin
Self.Height := Client.Height or FOHeight or 200;
end;
end else begin
if (Align = alLeft) or (Align = alRight) then
Self.Width := 0
else if (Align = alTop) or (Align = alBottom) then
Self.Height := 0;
end;
if MakeVisible and (Client <> nil) then
Client.Show;
WhenResized(Self);
end;
procedure Register;
begin
RegisterComponents('LaKraven.com [Docks]', [TDockPanel]);
end;
end.
interface
uses
Windows, SysUtils, Classes, Forms, Controls, ExtCtrls, ComCtrls, Graphics, Tabs, DockTabSet;
type
TDockPanel = class(TCustomPanel)
private
{ Members }
FAlign: TAlign;
FDockTabs: TDockTabSet;
FSplitter: TSplitter;
FDockPanel: TPanel;
FOWidth: Integer;
FOHeight: Integer;
FOriginalColor: TColor;
{ Methods }
procedure WhenResized(Sender: TObject);
procedure TabsChanged(Sender: TObject);
procedure DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
procedure DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure GetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
procedure UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
procedure ShowDockPanel(APanel: TPanel; MakeVisible: Boolean; Client: TControl);
protected
procedure Paint; override;
procedure DrawDockStuff;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Splitter: TSplitter read FSplitter;
property Tabs: TDockTabSet read FDockTabs;
property Dock: TPanel read FDockPanel;
end;
procedure Register;
implementation
{ TDockPanel }
constructor TDockPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// SET DEFAULTS
FullRepaint := True;
FAlign := Align;
Caption := 'Dock Target';
ShowCaption := True;
Self.BevelOuter := bvNone;
Self.BevelInner := bvNone;
Self.Align := alBottom;
// CREATE SUB OBJECTS
FDockTabs := TDockTabSet.Create(Self);
FSplitter := TSplitter.Create(Self);
FDockPanel := TPanel.Create(Self);
// PARENT THE SUB OBJECTS
FDockPanel.SetParentComponent(Self);
// CONFIGURE THE DOCK PANEL
FDockPanel.DockSite := True;
FDockPanel.BevelOuter := bvNone;
FDockPanel.BevelInner := bvNone;
FDockPanel.Align := alClient;
// CONFIGURE THE DOCK TABS
FDockTabs.DestinationDockSite := FDockPanel;
FDockTabs.Style := tsStandard;
FDockTabs.SoftTop := True;
FDockTabs.Width := 25;
FDockTabs.Height := 25;
FDockTabs.AutoSelect := True;
FDockTabs.AutoScroll := True;
// CONFIGURE THE SPLITTER
FSplitter.Beveled := True;
FSplitter.Height := 4;
FSplitter.Width := 4;
// SET EVENTS
FDockTabs.OnTabAdded := TabsChanged;
FDockTabs.OnTabRemoved := TabsChanged;
FDockPanel.OnDockDrop := DockDrop;
FDockPanel.OnDockOver := DockOver;
FDockPanel.OnGetSiteInfo := GetSiteInfo;
FDockPanel.OnUnDock := UnDock;
// HIDE ELEMENTS WE DON'T WANT DISPLAYED YET
FSplitter.Visible := False;
FDockTabs.Visible := False;
// REDRAW THE ELEMENT;
// WhenResized(Self);
end;
procedure TDockPanel.WhenResized(Sender: TObject);
begin
if Align = alTop then begin
FSplitter.Top := 0;
Self.Top := 0;
FDockTabs.Top := 0;
end else if Align = alBottom then begin
FSplitter.Top := TWinControl(Self.GetParentComponent).Height;
Self.Top := TWinControl(Self.GetParentComponent).Height;
FDockTabs.Top := TWinControl(Self.GetParentComponent).Height;
end else if Align = alLeft then begin
Self.Left := 0;
FSplitter.Left := 0;
Self.Left := 0;
FDockTabs.Left := 0;
end else if Align = alRight then begin
Self.Left := TWinControl(Self.GetParentComponent).Width;
FSplitter.Left := TWinControl(Self.GetParentComponent).Width;
Self.Left := TWinControl(Self.GetParentComponent).Width;
FDockTabs.Left := TWinControl(Self.GetParentComponent).Width;
end;
Parent.Refresh;
Parent.Repaint;
Parent.Update;
Self.Refresh;
Self.Repaint;
Self.Update;
end;
destructor TDockPanel.Destroy;
begin
inherited Destroy;
end;
procedure TDockPanel.DrawDockStuff;
begin
FAlign := Align;
ShowCaption := False;
FDockTabs.SetParentComponent(Self.GetParentComponent);
FSplitter.SetParentComponent(Self.GetParentComponent);
FOWidth := Self.Width;
FOHeight := Self.Height;
// WE WANT TO HIDE THE CONTROLS PROPERLY IF THERE ARE NO CHILD OBJECTS
if Self.FDockPanel.ControlCount = 0 then begin
if (Align = alTop) or (Align = alBottom) or (not (Align = alRight) and not (Align = alLeft)) then begin
Self.FDockPanel.Height := 1;
Self.Height := 1;
end else if (Align = alLeft) or (Align = alRight) then begin
Self.FDockPanel.Width := 1;
Self.Width := 1;
end;
FSplitter.Hide;
end;
FDockPanel.Show;
if (Align <> alBottom) and (Align <> alTop) and (Align <> alLeft) and (Align <> alRight) then begin
FDockTabs.Align := alTop;
FSplitter.Align := alTop;
end else begin
FDockTabs.Align := FAlign;
FSplitter.Align := FAlign;
end;
if Align = alBottom then begin
FDockTabs.TabPosition := tpTop;
end else if Align = alTop then begin
FDockTabs.TabPosition := tpBottom;
end else if Align = alLeft then begin
FDockTabs.TabPosition := tpRight;
end else if Align = alRight then begin
FDockTabs.TabPosition := tpLeft;
end else begin
Caption := 'Must be aligned to Bottom, Top, Left or Right';
ShowCaption := True;
end;
end;
procedure TDockPanel.Paint;
begin
inherited;
if FAlign <> Align then begin
DrawDockStuff;
end;
end;
procedure TDockPanel.TabsChanged(Sender: TObject);
begin
if TDockTabSet(Sender).Tabs.Count > 0 then
TDockTabSet(Sender).Show
else
TDockTabSet(Sender).Hide;
if Align = alBottom then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Height := 25;
end;
end else if Align = alTop then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Height := 25;
end;
end else if Align = alLeft then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Width := 25;
end;
end else if Align = alRight then begin
if TDockTabSet(Sender).Visible then begin
FDockTabs.Width := 25;
end;
end;
WhenResized(Self);
end;
procedure TDockPanel.DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
begin
if (Sender as TPanel).DockClientCount = 1 then
ShowDockPanel(Sender as TPanel, True, Source.Control);
(Sender as TPanel).DockManager.ResetBounds(True);
end;
procedure TDockPanel.DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
begin
Accept := Source.Control is TWinControl;
end;
procedure TDockPanel.GetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean);
begin
CanDock := DockClient is TWinControl;
end;
procedure TDockPanel.UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
begin
if (Sender as TPanel).DockClientCount = 1 then
ShowDockPanel(Sender as TPanel, False, Client);
end;
procedure TDockPanel.ShowDockPanel(APanel: TPanel; MakeVisible: Boolean; Client: TControl);
begin
if not MakeVisible and (APanel.VisibleDockClientCount > 1) then
Exit;
FSplitter.Visible := MakeVisible;
if MakeVisible then begin
if Align = alLeft then begin
Self.Width := Client.Width or FOWidth or 200;
end else if Align = alRight then begin
Self.Width := Client.Width or FOWidth or 200;
end else if Align = alTop then begin
Self.Height := Client.Height or FOHeight or 200;
end else if Align = alBottom then begin
Self.Height := Client.Height or FOHeight or 200;
end;
end else begin
if (Align = alLeft) or (Align = alRight) then
Self.Width := 0
else if (Align = alTop) or (Align = alBottom) then
Self.Height := 0;
end;
if MakeVisible and (Client <> nil) then
Client.Show;
WhenResized(Self);
end;
procedure Register;
begin
RegisterComponents('LaKraven.com [Docks]', [TDockPanel]);
end;
end.
August 17, 2010 at 1:43 pm
Thank you for the updated post, it’s what I need.
November 4, 2010 at 11:52 pm
Thank you, but one thing i don’t understand: why can’t i use ManualDock? I want to Dock some Controls to the Dockpanel as default. is there another way to do it?
November 5, 2010 at 12:17 am
Ah, i already found out. by using ManualDock(dockpanel1.dock). I like the Dockpanel – Component a lot. Thanks again
November 5, 2010 at 10:15 am
Yes, the TDockPanel main object is a non-visual component which then implements a bunch of visual components and positions them relative to its given alignment. The “.Dock” property is the actual panel to which objects can be docked, which you wisely figured out on your own.
Glad you appreciate the component, I enjoy making them and it’s nice to know others also find them useful. Enjoy
November 5, 2010 at 1:13 pm
Hey ,i found out that your component combines perfectly with this:
http://www.google.de/codesearch/p?hl=de#4CxmIqrgG2U/comps/dockpanel/DockPanel.pas&q=dockpanel%20lang:pascal&sa=N&cd=1&ct=rc
just replace the TPanel with the TDockpanel.
November 24, 2010 at 1:22 pm
TDockPanel is a native component only from D2010, sin’t it?
November 24, 2010 at 8:54 pm
It’s native for Delphi… I’m not sure if any versions older than 2009 will support it, but I’ve had confirmation of it working on 2009 and XE, and of course I made it with 2010 so I know it works with that.
March 11, 2011 at 8:10 am
I have locking quite a while for such a component and i can only say your work is simply great
If you change the the size(with or height) of a docked DockPanel, unpined and pined again the size(with or height) changed! The same problem occur also in “PADPlates”, but not in the Delphi 2010 IDE.
Please keep up your good work.
February 9, 2011 at 8:50 am
Do you have a demo project? I can’t figure out how to use your component. Thank you in advance.
May 4, 2011 at 6:57 pm
I get an error message when I try to install this component into BDS 2006: ShowCaption is an undeclared identifier. What can I do to correct this issue.
[Pascal Warning] UDockPanel.pas(22): W1010 Method ‘DockDrop’ hides virtual method of base type ‘TWinControl’
[Pascal Warning] UDockPanel.pas(23): W1010 Method ‘DockOver’ hides virtual method of base type ‘TWinControl’
[Pascal Warning] UDockPanel.pas(24): W1010 Method ‘GetSiteInfo’ hides virtual method of base type ‘TWinControl’
[Pascal Warning] UDockPanel.pas(37): W1009 Redeclaration of ‘Dock’ hides a member in the base class
[Pascal Error] UDockPanel.pas(53): E2003 Undeclared identifier: ‘ShowCaption’
[Pascal Error] UDockPanel.pas(62): E2362 Cannot access protected symbol TControl.SetParentComponent
[Pascal Error] UDockPanel.pas(132): E2003 Undeclared identifier: ‘ShowCaption’
[Pascal Error] UDockPanel.pas(134): E2362 Cannot access protected symbol TControl.SetParentComponent
[Pascal Error] UDockPanel.pas(135): E2362 Cannot access protected symbol TControl.SetParentComponent
[Pascal Hint] UDockPanel.pas(18): H2219 Private symbol ‘FOriginalColor’ declared but never used
[Pascal Fatal Error] DockPanelPackage.dpk(37): F2063 Could not compile used unit ‘UDockPanel.pas’
Mark Catheline
Mark.Catheline@hs.utc.com
May 7, 2011 at 2:36 pm
I haven’t tested TDockPanel against Delphi 2006… it was designed to work with 2009 to XE.
You don’t actually require the “ShowCaption” property, you can simply set the Caption to EmptyStr. TDockPanel makes use of ShowCaption because it’s a “cleaner” method available in the newest Delphi versions.
As annoying as this sounds, if you want to use TDockPanel with older versions than 2009, you will have to make the necessary changes. Alternatively you may want to consider the dock components provided with the JVCL (JEDI), as theirs work for all Delphi versions.
November 18, 2011 at 4:16 pm
Hi,
thanks for the component, works well and is much appreciated!
One problem I encounter is if I do a manualdock to a left-aligned dockpanel in the dockpanels parent window formshow-event, the splitter somehow sits on the left(!) side of the docked form. only after undocking/redocking the splitter is correctly positioned to the right of the docked form.
Interestingly, this does not happen if the dockpanel is top or right aligned. Is there a possible solution for that?
November 24, 2011 at 10:51 am
It’s possible! I haven’t played with TDockPanel in quite a while, but I’ll dust it off as soon as I have a few moments to spare and see if I can replicate (thus solve) the problem.
December 6, 2011 at 11:03 am
I found a possible solution for the mentioned misbehaviour when manualdocking a form to an allefted TDockpanel:
Just change the value of FSplitter.left in line 109 to a value larger than any window/control that can possibly be docked to the Dockpanel like
FSplitter.Left := 10000;
and you´re done. Since the splitter is parented by the Control it will now correctly position itself to the right of the docked form t all times.
Additionally I added a simple event to control drop operations (allow/disallow) from the application by exposing the OnDockOver event:
type TOnPanelDockOver = procedure(Sender:TObject;Source: TDragDockObject;var allowed:boolean) of object;
private
…
fOnPanelDockOver: TOnPanelDockOver;
published
…
property PanelDockOver:TOnPanelDockover read fOnPanelDockOver write fOnPanelDockOver;
…
procedure TDockPanel.DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
var allowed:boolean;
begin
if assigned(fOnPanelDockOver) then fOnPanelDockover(sender, source, allowed);
Accept := allowed;
// Accept := Source.Control is TWinControl;
end;
By the way, the Dockpanel component works great in combination with the Alphablend-patch I once found somewhere on the web but cannot remember where it was (Code Central?):
Just create a unit “BlendedDockingRect” – source code below – and place it in the uses clause of your main form. This will remove the cumbersomely slow and ugly gray rectangles that are drawn while dragging a form in D2010.
Bernhard
unit BlendedDockingRect;
interface
uses
Classes, Forms, Controls;
type
TDragDockObjectEx_AlphaBlend = class(TDragDockObjectEx)
private
FForm: TForm;
protected
procedure DrawDragDockImage; override;
function GetEraseWhenMoving: Boolean; override;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
implementation
uses
Windows, Graphics, FastCodePatch;
procedure TDragDockObjectEx_AlphaBlend.AfterConstruction;
begin
inherited;
FForm := TForm.Create(nil);
FForm.BorderStyle := bsToolWindow;//Or bsNone for a simple blue rectangle, or…
FForm.AlphaBlend := True;
FForm.AlphaBlendValue := 127;
FForm.Color := clActiveCaption;//Or RGB(96, 111, 151);
FForm.FormStyle := fsStayOnTop;
setWindowLong(FForm.Handle, GWL_EXSTYLE, getWindowLong(FForm.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT or WS_EX_LAYERED);
end;
procedure TDragDockObjectEx_AlphaBlend.BeforeDestruction;
begin
inherited;
FForm.Free;
end;
procedure TDragDockObjectEx_AlphaBlend.DrawDragDockImage;
begin
FForm.BoundsRect := DockRect;
if not FForm.Visible then
FForm.Show;
end;
function TDragDockObjectEx_AlphaBlend.GetEraseWhenMoving: Boolean;
begin
Result := False;
end;
type
TControlHack = class(TControl)
protected
procedure DoStartDockPatch(var DragObject: TDragObject);// override;
end;
procedure TControlHack.DoStartDockPatch(var DragObject: TDragObject);
begin
DragObject := nil;
if Assigned(OnStartDock) then
OnStartDock(Self, TDragDockObject(DragObject));
if not Assigned(DragObject) then
DragObject := TDragDockObjectEx_AlphaBlend.Create(Self);
end;
procedure TControlDoStartDockStub;
asm
call TControlHack.DoStartDock;
end;
function IsPatchSupported: Boolean;
var
OsVinfo: TOSVERSIONINFO;
begin
ZeroMemory(@OsVinfo, SizeOf(OsVinfo));
OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
if GetVersionEx(OsVinfo) then
begin
result := (OsVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
and (OsVinfo.dwMajorVersion >= 5); // >= Windows 2000
end
else
result := False;
end;
procedure ApplyPatch;
begin
FastcodeAddressPatch(FastcodeGetAddress(@TControlDoStartDockStub), @TControlHack.DoStartDockPatch);
end;
initialization
if IsPatchSupported then ApplyPatch;
end.
December 6, 2011 at 2:28 pm
Ah… so the issue is Windows-version dependant? This is well worth knowing!
Great job
January 31, 2012 at 3:07 pm
Hi
How to save en restor DockableFomr with UDockPanel
Code sample will welcome.
Thank’s for Help
February 24, 2012 at 12:15 am
There’s no built in feature for this in TDockPanel itself, but if you do a Google search on saving the docked position of forms in Delphi applications, you’ll find what you need.
March 4, 2012 at 3:55 pm
Hello,
nice but is there any way to change the style (docked state) of the caption? I mean caption background etc colors (gradient maybe) etc etc? And the moving of the forms are very very sluggish when dragKind is set to dkDock… what’s causing this (delphi2010)?
March 4, 2012 at 3:59 pm
also i have to move the ‘dockclient’ (the form i want to dock) to the very edge of the dockpanel, why? Thank You.