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

dockmanager example: added missing package files

Browse Source 
git-svn-id: trunk@20514 -
This commit is contained in:
dodi 2009-06-08 09:35:38 +00:00
parent d37ca80343
commit 754531cdfd
13 changed files with 101 additions and 2081 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

@ -2317,24 +2317,21 @@ examples/docking/unit1.lrs svneol=native#text/pascal
examples/docking/unit1.pas svneol=native#text/pascal
examples/dockmanager/easytree/BUGS.txt svneol=native#text/plain
examples/dockmanager/easytree/README.txt svneol=native#text/plain
examples/dockmanager/easytree/easy_dock_images.lrs svneol=native#text/plain
examples/dockmanager/easytree/easydocking.lpi svneol=native#text/plain
examples/dockmanager/easytree/easydocking.lpr svneol=native#text/plain
examples/dockmanager/easytree/easydocksite.pas svneol=native#text/plain
examples/dockmanager/easytree/fdockable.lfm svneol=native#text/plain
examples/dockmanager/easytree/fdockable.lrs svneol=native#text/plain
examples/dockmanager/easytree/fdockable.pas svneol=native#text/plain
examples/dockmanager/easytree/fdockbook.lfm svneol=native#text/plain
examples/dockmanager/easytree/fdockbook.lrs svneol=native#text/plain
examples/dockmanager/easytree/fdockbook.pas svneol=native#text/pascal
examples/dockmanager/easytree/fmain.lfm svneol=native#text/plain
examples/dockmanager/easytree/fmain.lrs svneol=native#text/plain
examples/dockmanager/easytree/fmain.pas svneol=native#text/plain
examples/dockmanager/easytree/ftree.lfm svneol=native#text/plain
examples/dockmanager/easytree/ftree.lrs svneol=native#text/plain
examples/dockmanager/easytree/ftree.pas svneol=native#text/plain
examples/dockmanager/easytree/zoneheader.inc svneol=native#text/pascal
examples/dockmanager/package/easy_dock_images.lrs svneol=native#text/plain
examples/dockmanager/package/easydocking.pas svneol=native#text/pascal
examples/dockmanager/package/easydockmgr.lpk svneol=native#text/plain
examples/dockmanager/package/easydockmgr.pas svneol=native#text/pascal
examples/dockmanager/package/easydocksite.pas svneol=native#text/plain
examples/dockmanager/package/fdockbook.lfm svneol=native#text/plain
examples/dockmanager/package/fdockbook.lrs svneol=native#text/plain

12
examples/dockmanager/easytree/easy_dock_images.lrs
View File

@ -1,12 +0,0 @@
LazarusResources.Add('easy_dock_close','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#10#0#0#0#10#8#6#0#0#0#141'2'#207
+#189#0#0#0'0IDATx'#218'c````d '#1#252#135'b'#130#226#255#177#8#254#199'e'#192
+''#28#24#175#19#240'*b '#215'4'#130#238#195#235#25#162#131#135' '#0#0#177'5'
+''''#218'{1'#230#136#0#0#0#0'IEND'#174'B`'#130
]);
LazarusResources.Add('easy_dock_restore','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#10#0#0#0#10#8#6#0#0#0#141'2'#207
+#189#0#0#0'&IDATx'#218'c````d '#3#252#199#131#201'W'#136#203'&'#162'L"O!!'
+#207#17#231'6'#178#20#226#13#22#0#23#22'.'#211'T'#186#182'Q'#0#0#0#0'IEND'
+#174'B`'#130
]);

2
examples/dockmanager/easytree/easydocking.lpi
View File

@ -30,7 +30,7 @@
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="EasyDocking"/>
<PackageName Value="EasyDockMgr"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>

2
examples/dockmanager/easytree/easydocking.lpr
View File

@ -5,7 +5,7 @@ program EasyDocking;
{.$APPTYPE CONSOLE}
uses
Interfaces,
EasyDockMgr, Interfaces,
Forms,
fMain in 'fmain.pas' {EasyDockMain},
fDockable in 'fdockable.pas' {Dockable},

1406
examples/dockmanager/easytree/easydocksite.pas
View File

File diff suppressed because it is too large Load Diff

45
examples/dockmanager/easytree/fdockbook.lfm
View File

@ -1,45 +0,0 @@
object EasyDockBook: TEasyDockBook
Left = 263
Height = 300
Top = 146
Width = 400
Caption = 'EasyDockBook'
ClientHeight = 300
ClientWidth = 400
DragKind = dkDock
DragMode = dmAutomatic
LCLVersion = '0.9.27'
Visible = True
object Tabs: TToolBar
Left = 1
Height = 26
Top = 1
Width = 398
AutoSize = True
BorderSpacing.Around = 1
BorderWidth = 1
Caption = 'Tabs'
ChildSizing.HorizontalSpacing = 2
ChildSizing.Layout = cclLeftToRightThenTopToBottom
Color = clBtnFace
EdgeBorders = [ebTop, ebBottom]
Flat = False
Font.Style = [fsBold]
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
end
object pnlDock: TPanel
Left = 0
Height = 272
Top = 28
Width = 400
Align = alClient
DockSite = True
TabOrder = 1
OnDockDrop = pnlDockDockDrop
OnUnDock = pnlDockUnDock
end
end

17
examples/dockmanager/easytree/fdockbook.lrs
View File

@ -1,17 +0,0 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TEasyDockBook','FORMDATA',[
'TPF0'#13'TEasyDockBook'#12'EasyDockBook'#4'Left'#3#7#1#6'Height'#3','#1#3'To'
+'p'#3#146#0#5'Width'#3#144#1#7'Caption'#6#12'EasyDockBook'#12'ClientHeight'#3
+','#1#11'ClientWidth'#3#144#1#8'DragKind'#7#6'dkDock'#8'DragMode'#7#11'dmAut'
+'omatic'#10'LCLVersion'#6#6'0.9.27'#7'Visible'#9#0#8'TToolBar'#4'Tabs'#4'Lef'
+'t'#2#1#6'Height'#2#26#3'Top'#2#1#5'Width'#3#142#1#8'AutoSize'#9#20'BorderSp'
+'acing.Around'#2#1#11'BorderWidth'#2#1#7'Caption'#6#4'Tabs'#29'ChildSizing.H'
+'orizontalSpacing'#2#2#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBo'
+'ttom'#5'Color'#7#9'clBtnFace'#11'EdgeBorders'#11#5'ebTop'#8'ebBottom'#0#4'F'
+'lat'#8#10'Font.Style'#11#6'fsBold'#0#4'List'#9#11'ParentColor'#8#10'ParentF'
+'ont'#8#12'ShowCaptions'#9#8'TabOrder'#2#0#0#0#6'TPanel'#7'pnlDock'#4'Left'#2
+#0#6'Height'#3#16#1#3'Top'#2#28#5'Width'#3#144#1#5'Align'#7#8'alClient'#8'Do'
+'ckSite'#9#8'TabOrder'#2#1#10'OnDockDrop'#7#15'pnlDockDockDrop'#8'OnUnDock'#7
+#13'pnlDockUnDock'#0#0#0
]);

175
examples/dockmanager/easytree/fdockbook.pas
View File

@ -1,175 +0,0 @@
unit fDockBook;
(* Notebook for docking multiple controls into a tabbed control.
By DoDi <DrDiettrich1@aol.com> 2009.
A tab is created for every docked control.
The currently visible tab remains down.
A control can be undocked by dragging the associated tab.
This makes the tabs act as grab regions, for undocking forms.
*)
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, ExtCtrls;
type
TTabButton = class(TToolButton)
protected
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(TheOwner: TComponent); override;
Control: TControl;
end;
TEasyDockBook = class(TForm)
pnlDock: TPanel;
Tabs: TToolBar;
procedure pnlDockDockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
procedure pnlDockUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
procedure ToolButton1Click(Sender: TObject);
private
CurTab: TTabButton;
protected
function GetDefaultDockCaption: string; override;
function GetControlTab(AControl: TControl): TTabButton;
end;
var
EasyDockBook: TEasyDockBook;
implementation
{ TEasyDockBook }
function TEasyDockBook.GetControlTab(AControl: TControl): TTabButton;
var
i: integer;
btn: TToolButton absolute Result;
begin
for i := 0 to Tabs.ButtonCount - 1 do begin
btn := Tabs.Buttons[i];
if Result.Control = AControl then
exit;
end;
//not found - raise exception?
Result := nil;
end;
function TEasyDockBook.GetDefaultDockCaption: string;
var
i: integer;
pg: TToolButton;
begin
Result := '';
for i := 0 to Tabs.ButtonCount - 1 do begin
pg := Tabs.Buttons[i];
if Result = '' then
Result := pg.Caption
else
Result := Result + ', ' + pg.Caption;
end;
end;
procedure TEasyDockBook.pnlDockDockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
var
btn: TTabButton;
begin
btn := TTabButton.Create(Tabs);
btn.Control := Source.Control;
btn.Control.Align := alClient;
btn.Caption := GetDockCaption(btn.Control);
btn.OnClick := @ToolButton1Click;
btn.Down := True;
btn.Click;
end;
procedure TEasyDockBook.pnlDockUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
var
i: integer;
btn: TTabButton;
begin
(* Client undocked, remove associated tab.
We'll have to find the tab, associated with the control.
*)
Allow := true;
//assert(CurTab.Control = Client, 'diff client');
btn := GetControlTab(Client);
//i := CurTab.Index;
i := btn.Index;
if btn = CurTab then begin
CurTab := nil;
end else begin
Client.Visible := True; //make hidden page control visible
end;
Tabs.ButtonList.Delete(i);
btn.Free; //seems to work
//special handle remove of current and last tab
if Tabs.ButtonCount > 0 then begin
//tab moved?
if CurTab = nil then begin //current button removed
//find next tab to show
if i >= Tabs.ButtonCount then
i := Pred(Tabs.ButtonCount); // dec(i);
//activate new tab
CurTab := Tabs.Buttons[i] as TTabButton;
CurTab.Down := True;
CurTab.Click;
end;
end else begin
//last tab removed
if HostDockSite <> nil then
ManualDock(nil); //undock before closing
Close;
end;
end;
procedure TEasyDockBook.ToolButton1Click(Sender: TObject);
var
btn: TTabButton absolute Sender;
begin
if CurTab <> nil then begin
CurTab.Control.Visible := false;
end;
if btn.Control <> nil then
btn.Control.Visible := True;
CurTab := btn;
end;
{ TTabButton }
constructor TTabButton.Create(TheOwner: TComponent);
var
i, last: integer;
begin
inherited Create(TheOwner);
//these properties must be set before Parent
Style := tbsCheck;
AutoSize := True;
Parent := TWinControl(TheOwner);
//these properties must be set after Parent
Grouped := True;
end;
procedure TTabButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if ssLeft in Shift then begin
if Control <> nil then begin
Control.BeginDrag(False); //delayed docking
end;
end;
end;
initialization
{$I fdockbook.lrs}
end.

416
examples/dockmanager/easytree/zoneheader.inc
View File

@ -1,416 +0,0 @@
type
TDockHeaderImageKind =
(
dhiRestore,
dhiClose
);
TDockHeaderImages = array[TDockHeaderImageKind] of TCustomBitmap;
const
DockHeaderImageNames: array[TDockHeaderImageKind] of String =
(
{ dhiRestore } 'easy_dock_restore',
{ dhiClose } 'easy_dock_close'
);
var
DockBtnImages: TDockHeaderImages;
procedure CreateDockHeaderImages;
var
ImageKind: TDockHeaderImageKind;
begin
for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
DockBtnImages[ImageKind] := CreateBitmapFromLazarusResource(DockHeaderImageNames[ImageKind]);
end;
procedure DestroyDockHeaderImages;
var
ImageKind: TDockHeaderImageKind;
begin
//called from unit finalization only!
{ this code can result in crashes, due to missing handles
for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
FreeAndNil(DockBtnImages[ImageKind]);
}
end;
{ TEasyDockHeader }
type
TZonePartMap = record
dTop, dBottom, dLeft, dRight: integer;
end;
const //zone decoration sizes
dSizer = 4;
dBorder = 2; //frame and inner bevel
dDist = 1; //button distance
dButton = 14; //include some space for themes
dHeader = dButton + 2*dBorder; // 22 - dSizer; //splitter outside header!
//minimal (Delphi) header
GrabberSize = 10; // 12;
dDDist = 1;
dDBorder = 1;
dDHeader = GrabberSize + dSizer; //?
dDButton = GrabberSize - dBorder; // 2*dDBorder; //10?
(* Zone part map.
In portrait mode (header on top), the zone rectangle is adjusted according
to the given offsets. In landscape mode (header on the left), the offsets
have to be applied to the rotated coordinates.
Positive offsets mean self-relative adjustment, towards the opposite edge.
This operation has highest precedence.
Negative offsets mean adjustment relative to the adjusted opposite edge.
zpAll excludes the splitter and client area.
zpCaption excludes borders and buttons from zpAll.
*)
{$IFDEF newSplitter}
(*
The map reflects new splitter placement (past client area),
and no restore button.
*)
HeaderPartMap: array[TEasyZonePart] of TZonePartMap = (
(), //zpNowhere
(dTop:dHeader; dBottom:0), //zpClient
(dTop:0; dBottom:-dHeader), //zpAll
(dTop:dBorder; dBottom:-dButton; dLeft:dBorder; dRight:dBorder+dButton), //zpCaption
(dTop:-dSizer), //zpSizer
{$IFDEF restore}
(...), //zpRestoreButton
{$ENDIF}
(dTop:dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dBorder) //zpCloseButton
);
{$ELSE}
(* Sizer in header, just before caption
*)
HeaderPartMap: array[TEasyHeaderStyle, TEasyZonePart] of TZonePartMap = (
//hsMinimal
(
{zpNowhere} (),
{zpClient} (dTop:dDHeader; dBottom:0),
{zpAll} (dTop:dSizer; dBottom:-dDHeader),
{zpCaption} (dTop:dSizer+dDBorder; dBottom:-dDButton; dLeft:dDBorder; dRight:2*dDBorder+dDButton),
{zpSizer} (dTop:0; dBottom:-dSizer),
{$IFDEF restore}
{zpRestoreButton} (),
{$ENDIF}
{zpCloseButton} (dTop:dSizer+dDBorder; dBottom:-dDButton; dLeft:-dDButton; dRight:dDBorder)
),
//hsForm
(
(), //zpNowhere - not in any zone
(dTop:dHeader+dSizer; dBottom:0), //zpClient - on client control
(dTop:dSizer; dBottom:-dHeader), //zpAll - total header rect
(dTop:dSizer+dBorder; dBottom:-dButton; dLeft:dBorder; dRight:dBorder+dButton), //zpCaption
(dTop:0; dBottom:-dSizer), //zpSizer - splitter/sizer
{$IFDEF restore}
(dTop:dSizer+dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dButton+2*dBorder) //zpRestoreButton, // header restore button
{$ENDIF}
(dTop:dSizer+dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dBorder) //zpCloseButton // header close button
)
);
{$ENDIF}
constructor TEasyDockHeader.Create;
procedure dump;
var
r, r2: TRect;
const
hc = true;
orn = doVertical;
begin
r := Rect(0, 0, 200, 200); //LTBR
r2 := GetRectOfPart(r, orn, zpAll, hc);
DebugLn('%s (%d,%d)-(%d,%d)', ['header ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
r2 := GetRectOfPart(r, orn, zpCaption, hc);
DebugLn('%s (%d,%d)-(%d,%d)', ['caption', r2.Top, r2.Left, r2.Bottom, r2.Right]);
r2 := GetRectOfPart(r, orn, zpCloseButton, hc);
DebugLn('%s (%d,%d)-(%d,%d)', ['closer ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
r2 := GetRectOfPart(r, orn, zpClient, hc);
DebugLn('%s (%d,%d)-(%d,%d)', ['client ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
r2 := GetRectOfPart(r, orn, zpSizer, hc);
DebugLn('%s (%d,%d)-(%d,%d)', ['sizer ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
end;
begin
HeaderSize := dHeader; //some meaningful value?
//debug
//dump;
end;
function TEasyDockHeader.GetRectOfPart(ARect: TRect; AOrientation: TDockOrientation;
APart: TEasyZonePart; HasSplitter: boolean): TRect;
begin
(* ARect is (must be) TLBR zone rectangle, on input.
*)
if (APart = zpNowhere) or ((APart = zpSizer) and not HasSplitter) then begin
Result := Rect(0,0,0,0);
exit;
end;
Result := ARect;
with HeaderPartMap[Style, APart] do begin
if AOrientation = doVertical then begin //portrait
if dTop > 0 then
inc(Result.Top, dTop);
if dBottom > 0 then
dec(Result.Bottom, dBottom)
else if dBottom < 0 then
Result.Bottom := Result.Top - dBottom;
if dTop < 0 then
Result.Top := Result.Bottom + dTop;
if dLeft > 0 then
inc(Result.Left, dLeft);
if dRight > 0 then
dec(Result.Right, dRight)
else if dRight < 0 then
Result.Right := Result.Left + dRight;
if dLeft < 0 then
Result.Left := Result.Right + dLeft;
{$IFDEF newSplitter}
//handle client w/o splitter
if (APart = zpClient) and HasSplitter then
dec(Result.Bottom, dSizer);
{$ELSE}
{$ENDIF}
end else begin //landscape
if dTop > 0 then
inc(Result.Left, dTop);
if dBottom > 0 then
dec(Result.Right, dBottom)
else if dBottom < 0 then
Result.Right := Result.Left - dBottom;
if dTop < 0 then
Result.Left := Result.Right + dTop;
if dLeft > 0 then
dec(Result.Bottom, dLeft);
if dRight > 0 then
inc(Result.Top, dRight)
else if dRight < 0 then
Result.Top := Result.Bottom + dRight;
if dLeft < 0 then
Result.Bottom := Result.Top - dLeft;
{$IFDEF newSplitter}
//handle client w/o splitter
if (APart = zpClient) and HasSplitter then
dec(Result.Right, dSizer);
{$ELSE}
{$ENDIF}
end;
end;
end;
function TEasyDockHeader.FindPart(AZone: TEasyZone; MousePos: TPoint; fButtonDown: boolean): TEasyZonePart;
var
SubRect, r: TRect;
Control: TControl;
Part: TEasyZonePart;
aHandle : HWND;
function MouseInPart(APart: TEasyZonePart): boolean;
begin
//on hit: retain Part and SubRect
SubRect := GetRectOfPart(r, Control.DockOrientation, APart, AZone.HasSizer);
Result := PtInRect(SubRect, MousePos);
if Result then
Part := APart;
end;
begin
(* Called from mouse message handler (only!).
Remember draw state of current zone.
*)
r := AZone.GetBounds;
if (AZone.FChildControl = nil) or not PtInRect(r, MousePos) then
//possibly empty root zone
Result := zpNowhere
else begin
Control := AZone.FChildControl;
if MouseInPart(zpSizer) or MouseInPart(zpCloseButton)
{$IFDEF restore}
or MouseInPart(zpRestoreButton)
{$ENDIF}
or MouseInPart(zpClient)
then
//all done, result stored in Part
else
Part := zpCaption; //include borders
end;
aHandle:=AZone.GetHandle;
//check old state changed - buttons also change state on mouse enter/exit
if (self.MouseZone <> nil) //else Mouse... invalid
and ((MouseZone <> AZone) or (MousePart in HeaderButtons)) then
InvalidateRect(aHandle, @PartRect, false); //old button
//check new state
if (Part in HeaderButtons) then begin
InvalidateRect(aHandle, @SubRect, false); //refresh button
end;
//set new state
MouseZone := AZone;
MousePart := Part;
MouseDown := fButtonDown;
PartRect := SubRect;
//done
Result := Part;
end;
procedure TEasyDockHeader.Draw(AZone: TEasyZone; ACanvas: TCanvas; ACaption: string; const MousePos: TPoint);
(* Problem with colors on other than win32 widgetsets (gtk2...)
*)
const
clBack = clHighlight;
clFont = clHighlightText;
var
IsMouseDown: Boolean;
//procedure DrawButton(ARect: TRect; IsMouseDown, IsMouseOver: Boolean; ABitmap: TCustomBitmap); inline;
procedure DrawButton(ARect: TRect; ABitmap: TCustomBitmap);
const
// ------------- Pressed, Hot -----------------------
BtnDetail: array[Boolean, Boolean] of TThemedToolBar =
(
(ttbButtonNormal, ttbButtonHot),
(ttbButtonNormal, ttbButtonPressed)
);
var
Details: TThemedElementDetails;
dx, dy: integer;
IsMouseOver: boolean;
begin
ACanvas.FillRect(ARect);
IsMouseOver := PtInRect(ARect, MousePos);
Details := ThemeServices.GetElementDetails(BtnDetail[IsMouseDown, IsMouseOver]);
ThemeServices.DrawElement(ACanvas.Handle, Details, ARect);
ARect := ThemeServices.ContentRect(ACanvas.Handle, Details, ARect);
//move button into rect, excluding border
dx := (ARect.Right - ARect.Left - ABitmap.Width) div 2;
dy := (ARect.Bottom - ARect.Top - ABitmap.Height) div 2;
ACanvas.Draw(ARect.Left + dx, ARect.Top + dy, ABitmap);
end;
procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
begin
with ACanvas do
begin
Pen.Color := clBtnHighlight;
MoveTo(Right, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
Pen.Color := clBtnShadow;
LineTo(Right, Bottom);
LineTo(Right, Top);
end;
end;
var
BtnRect: TRect;
ARect, DrawRect: TRect;
// LCL doesn't handle orientation in TFont
OldFont, RotatedFont: HFONT;
OldMode: Integer;
ALogFont: TLogFont;
AOrientation: TDockOrientation;
AControl: TControl;
begin
(* Some colors inavailable on some widgetsets!
*)
IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
//debug
AControl := AZone.FChildControl;
AOrientation := AControl.DockOrientation;
ARect := AZone.GetBounds;
ACanvas.Brush.Color := clBtnFace;
//draw splitter?
if AZone.HasSizer then begin
// border?
BtnRect := GetRectOfPart(ARect, AOrientation, zpSizer, AZone.HasSizer);
ACanvas.FillRect(BtnRect);
end;
//erase - which color(s)?
DrawRect := GetRectOfPart(ARect, AOrientation, zpAll, AZone.HasSizer);
//ACanvas.Brush.Color := clBack; // clActiveCaption;
ACanvas.FillRect(DrawRect);
//border
InflateRect(DrawRect, -1, -1); //outer bevel?
ACanvas.Brush.Color := clBtnShadow;
ACanvas.FrameRect(DrawRect); //1 pixel border
//InflateRect(DrawRect, -1, -1); //inner bevel?
//the value is not used any more!
ACanvas.Brush.Color := clBtnFace;
// draw caption
case Style of
hsMinimal:
with DrawRect do begin
DrawRect := GetRectOfPart(ARect, AOrientation, zpCaption, AZone.HasSizer);
if AOrientation = doVertical then begin
inc(Top, 1);
DrawGrabberLine(Left, Top, Right, Top+2);
inc(Top, 3);
DrawGrabberLine(Left, Top, Right, Top+2);
end else begin
inc(Left, 1);
DrawGrabberLine(Left, Top, Left+2, Bottom);
inc(Left, 3);
DrawGrabberLine(Left, Top, Left+2, Bottom);
end;
end;
hsForm:
begin
//ACanvas.Font.Color := clFont; //clCaptionText;
DrawRect := GetRectOfPart(ARect, AOrientation, zpCaption, AZone.HasSizer);
OldMode := SetBkMode(ACanvas.Handle, TRANSPARENT);
//for some reason the caption is not offset properly?
if AOrientation = doVertical then begin
inc(DrawRect.Left, dBorder); //looks better
DrawText(ACanvas.Handle, PChar(ACaption), -1, DrawRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER)
end else begin
OldFont := 0;
if GetObject(ACanvas.Font.Reference.Handle, SizeOf(ALogFont), @ALogFont) <> 0 then
begin
ALogFont.lfEscapement := 900;
RotatedFont := CreateFontIndirect(ALogFont);
if RotatedFont <> 0 then
OldFont := SelectObject(ACanvas.Handle, RotatedFont);
end;
// from msdn: DrawText doesnot support font with orientation and escapement <> 0
//TextOut(ACanvas.Handle, DrawRect.Left, DrawRect.Bottom, PChar(ACaption), Length(ACaption));
TextOut(ACanvas.Handle, DrawRect.Left-2, DrawRect.Bottom-2, PChar(ACaption), Length(ACaption));
if OldFont <> 0 then
DeleteObject(SelectObject(ACanvas.Handle, OldFont));
end;
SetBkMode(ACanvas.Handle, OldMode);
end;
end;
// buttons - which colors to use?
ACanvas.Brush.Color := clBtnFace;
//ACanvas.Pen.Color := clButtonText;
// draw close button
BtnRect := GetRectOfPart(ARect, AOrientation, zpCloseButton, AZone.HasSizer);
DrawButton(BtnRect, DockBtnImages[dhiClose]);
{$IFDEF restore}
// draw restore button
BtnRect := GetRectOfPart(ARect, AOrientation, zpRestoreButton, AZone.HasSizer);
DrawButton(BtnRect, DockBtnImages[dhiRestore]);
{$ENDIF}
end;

14
examples/dockmanager/package/easydocking.pas Normal file
View File

@ -0,0 +1,14 @@
{ This file was automatically created by Lazarus. do not edit!
This source is only used to compile and install the package.
}
unit EasyDocking;
interface
uses
EasyDockSite, fDockBook;
implementation
end.

56
examples/dockmanager/package/easydockmgr.lpk Normal file
View File

@ -0,0 +1,56 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<PathDelim Value="\"/>
<Name Value="EasyDockMgr"/>
<Author Value="DoDi"/>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="EasyDocking Manager and Notebook"/>
<License Value="LGPL"/>
<Version Major="1"/>
<Files Count="4">
<Item1>
<Filename Value="easydocksite.pas"/>
<UnitName Value="EasyDockSite"/>
</Item1>
<Item2>
<Filename Value="fdockbook.lfm"/>
<Type Value="LFM"/>
</Item2>
<Item3>
<Filename Value="fdockbook.lrs"/>
<Type Value="LRS"/>
</Item3>
<Item4>
<Filename Value="fdockbook.pas"/>
<UnitName Value="fDockBook"/>
</Item4>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PrjOutDir)\;$(PkgDir)\"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

20
examples/dockmanager/package/easydockmgr.pas Normal file
View File

@ -0,0 +1,20 @@
{ This file was automatically created by Lazarus. do not edit!
This source is only used to compile and install the package.
}
unit EasyDockMgr;
interface
uses
EasyDockSite, fDockBook, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('EasyDockMgr', @Register);
end.

8
examples/dockmanager/package/fdockbook.pas
View File

@ -40,11 +40,15 @@ type
function GetControlTab(AControl: TControl): TTabButton;
end;
var
EasyDockBook: TEasyDockBook;
//procedure Register;
implementation
procedure Register;
begin
//RegisterComponents('Common Controls', [TEasyDockBook]);
end;
{ TEasyDockBook }
function TEasyDockBook.GetControlTab(AControl: TControl): TTabButton;