1
0

TB2ToolWindow.pas 8.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268
  1. unit TB2ToolWindow;
  2. {
  3. Toolbar2000
  4. Copyright (C) 1998-2005 by Jordan Russell
  5. All rights reserved.
  6. The contents of this file are subject to the "Toolbar2000 License"; you may
  7. not use or distribute this file except in compliance with the
  8. "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
  9. TB2k-LICENSE.txt or at:
  10. http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
  11. Alternatively, the contents of this file may be used under the terms of the
  12. GNU General Public License (the "GPL"), in which case the provisions of the
  13. GPL are applicable instead of those in the "Toolbar2000 License". A copy of
  14. the GPL may be found in GPL-LICENSE.txt or at:
  15. http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
  16. If you wish to allow use of your version of this file only under the terms of
  17. the GPL and not to allow others to use your version of this file under the
  18. "Toolbar2000 License", indicate your decision by deleting the provisions
  19. above and replace them with the notice and other provisions required by the
  20. GPL. If you do not delete the provisions above, a recipient may use your
  21. version of this file under either the "Toolbar2000 License" or the GPL.
  22. $jrsoftware: tb2k/Source/TB2ToolWindow.pas,v 1.18 2005/01/06 03:56:50 jr Exp $
  23. }
  24. interface
  25. {$I TB2Ver.inc}
  26. uses
  27. Windows, Classes, Graphics, Controls, TB2Dock;
  28. type
  29. { TTBToolWindow }
  30. TTBToolWindow = class(TTBCustomDockableWindow)
  31. private
  32. FMinClientWidth, FMinClientHeight, FMaxClientWidth, FMaxClientHeight: Integer;
  33. FBarHeight, FBarWidth: Integer;
  34. function CalcSize(ADock: TTBDock): TPoint;
  35. function GetClientAreaWidth: Integer;
  36. procedure SetClientAreaWidth(Value: Integer);
  37. function GetClientAreaHeight: Integer;
  38. procedure SetClientAreaHeight(Value: Integer);
  39. procedure SetClientAreaSize(AWidth, AHeight: Integer);
  40. protected
  41. function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType;
  42. NewFloating: Boolean; NewDock: TTBDock): TPoint; override;
  43. procedure GetBaseSize(var ASize: TPoint); override;
  44. procedure GetMinMaxSize(var AMinClientWidth, AMinClientHeight,
  45. AMaxClientWidth, AMaxClientHeight: Integer); override;
  46. procedure Paint; override;
  47. procedure SizeChanging(const AWidth, AHeight: Integer); override;
  48. public
  49. constructor Create(AOwner: TComponent); override;
  50. procedure ReadPositionData(const Data: TTBReadPositionData); override;
  51. procedure WritePositionData(const Data: TTBWritePositionData); override;
  52. published
  53. property ActivateParent;
  54. property Align;
  55. property Anchors;
  56. property BorderStyle;
  57. property Caption;
  58. property Color;
  59. property CloseButton;
  60. property CloseButtonWhenDocked;
  61. property ClientAreaHeight: Integer read GetClientAreaHeight write SetClientAreaHeight;
  62. property ClientAreaWidth: Integer read GetClientAreaWidth write SetClientAreaWidth;
  63. property CurrentDock;
  64. property DefaultDock;
  65. property DockableTo;
  66. property DockMode;
  67. property DockPos;
  68. property DockRow;
  69. property DragHandleStyle;
  70. property FloatingMode;
  71. property Font;
  72. property FullSize;
  73. property HideWhenInactive;
  74. property LastDock;
  75. property MaxClientHeight: Integer read FMaxClientHeight write FMaxClientHeight default 0;
  76. property MaxClientWidth: Integer read FMaxClientWidth write FMaxClientWidth default 0;
  77. property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32;
  78. property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32;
  79. property ParentFont;
  80. property ParentShowHint;
  81. property PopupMenu;
  82. property Resizable;
  83. property ShowCaption;
  84. property ShowHint;
  85. property Stretch;
  86. property SmoothDrag;
  87. property TabOrder;
  88. property UseLastDock;
  89. {}{property Version;}
  90. property Visible;
  91. property OnClose;
  92. property OnCloseQuery;
  93. {$IFDEF JR_D5}
  94. property OnContextPopup;
  95. {$ENDIF}
  96. property OnDragDrop;
  97. property OnDragOver;
  98. property OnDockChanged;
  99. property OnDockChanging;
  100. property OnDockChangingHidden;
  101. property OnMouseDown;
  102. property OnMouseMove;
  103. property OnMouseUp;
  104. property OnMove;
  105. property OnRecreated;
  106. property OnRecreating;
  107. property OnResize;
  108. property OnVisibleChanged;
  109. end;
  110. implementation
  111. const
  112. { Constants for TTBToolWindow-specific registry values. Do not localize! }
  113. rvClientWidth = 'ClientWidth';
  114. rvClientHeight = 'ClientHeight';
  115. { TTBToolWindow }
  116. constructor TTBToolWindow.Create(AOwner: TComponent);
  117. begin
  118. inherited;
  119. FMinClientWidth := 32;
  120. FMinClientHeight := 32;
  121. { Initialize the client size to 32x32 }
  122. SetBounds(Left, Top, 32, 32);
  123. end;
  124. procedure TTBToolWindow.Paint;
  125. var
  126. R: TRect;
  127. begin
  128. { Draw dotted border in design mode }
  129. if csDesigning in ComponentState then
  130. with Canvas do begin
  131. R := ClientRect;
  132. Pen.Style := psDot;
  133. Pen.Color := clBtnShadow;
  134. Brush.Style := bsClear;
  135. Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  136. Pen.Style := psSolid;
  137. end;
  138. end;
  139. procedure TTBToolWindow.ReadPositionData(const Data: TTBReadPositionData);
  140. begin
  141. inherited;
  142. { Restore ClientAreaWidth/ClientAreaHeight variables }
  143. if Resizable then
  144. with Data do
  145. SetClientAreaSize(ReadIntProc(Name, rvClientWidth, FBarWidth, ExtraData),
  146. ReadIntProc(Name, rvClientHeight, FBarHeight, ExtraData));
  147. end;
  148. procedure TTBToolWindow.WritePositionData(const Data: TTBWritePositionData);
  149. begin
  150. inherited;
  151. { Write values of FBarWidth/FBarHeight }
  152. with Data do begin
  153. WriteIntProc(Name, rvClientWidth, FBarWidth, ExtraData);
  154. WriteIntProc(Name, rvClientHeight, FBarHeight, ExtraData);
  155. end;
  156. end;
  157. procedure TTBToolWindow.GetMinMaxSize(var AMinClientWidth, AMinClientHeight,
  158. AMaxClientWidth, AMaxClientHeight: Integer);
  159. begin
  160. AMinClientWidth := FMinClientWidth;
  161. AMinClientHeight := FMinClientHeight;
  162. AMaxClientWidth := FMaxClientWidth;
  163. AMaxClientHeight := FMaxClientHeight;
  164. end;
  165. procedure TTBToolWindow.SizeChanging(const AWidth, AHeight: Integer);
  166. begin
  167. FBarWidth := AWidth;
  168. if Parent <> nil then Dec(FBarWidth, Width - ClientWidth);
  169. FBarHeight := AHeight;
  170. if Parent <> nil then Dec(FBarHeight, Height - ClientHeight);
  171. end;
  172. function TTBToolWindow.CalcSize(ADock: TTBDock): TPoint;
  173. begin
  174. Result.X := FBarWidth;
  175. Result.Y := FBarHeight;
  176. if Assigned(ADock) then
  177. if FullSize then
  178. begin
  179. { If docked and full size, return the size corresponding to docked size }
  180. if not(ADock.Position in [dpLeft, dpRight]) then
  181. Result.X := ADock.ClientWidth - (Width - ClientWidth)
  182. else
  183. Result.Y := ADock.ClientHeight - (Height - ClientHeight);
  184. end
  185. else if Stretch then
  186. begin
  187. { If docked and stretching, return the minimum size so that the toolbar
  188. can shrink below FBarWidth/FBarHeight }
  189. if not(ADock.Position in [dpLeft, dpRight]) then
  190. Result.X := FMinClientWidth
  191. else
  192. Result.Y := FMinClientHeight;
  193. end;
  194. end;
  195. procedure TTBToolWindow.GetBaseSize(var ASize: TPoint);
  196. begin
  197. ASize := CalcSize(CurrentDock);
  198. end;
  199. function TTBToolWindow.DoArrange(CanMoveControls: Boolean;
  200. PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint;
  201. begin
  202. Result := CalcSize(NewDock);
  203. end;
  204. function TTBToolWindow.GetClientAreaWidth: Integer;
  205. begin
  206. if Parent = nil then
  207. Result := Width
  208. else
  209. Result := ClientWidth;
  210. end;
  211. procedure TTBToolWindow.SetClientAreaWidth(Value: Integer);
  212. begin
  213. SetClientAreaSize(Value, ClientAreaHeight);
  214. end;
  215. function TTBToolWindow.GetClientAreaHeight: Integer;
  216. begin
  217. if Parent = nil then
  218. Result := Height
  219. else
  220. Result := ClientHeight;
  221. end;
  222. procedure TTBToolWindow.SetClientAreaHeight(Value: Integer);
  223. begin
  224. SetClientAreaSize(ClientAreaWidth, Value);
  225. end;
  226. procedure TTBToolWindow.SetClientAreaSize(AWidth, AHeight: Integer);
  227. var
  228. Client: TRect;
  229. begin
  230. if Parent = nil then
  231. SetBounds(Left, Top, AWidth, AHeight)
  232. else begin
  233. Client := GetClientRect;
  234. SetBounds(Left, Top, Width - Client.Right + AWidth,
  235. Height - Client.Bottom + AHeight);
  236. end;
  237. end;
  238. end.