home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d23456 / TB97.ZIP / Source / TB97Tlwn.pas < prev    next >
Pascal/Delphi Source File  |  2001-01-05  |  6KB  |  204 lines
  1. unit TB97Tlwn;
  2.  
  3. {
  4.   Toolbar97
  5.   Copyright (C) 1998-2001 by Jordan Russell
  6.   For conditions of distribution and use, see LICENSE.TXT.
  7.  
  8.   TToolWindow97
  9.  
  10.   $Id: TB97Tlwn.pas,v 1.2 2001/01/04 04:17:14 jr Exp $
  11. }
  12.  
  13. interface
  14.  
  15. {$I TB97Ver.inc}
  16.  
  17. uses
  18.   Windows, Classes, Controls, TB97;
  19.  
  20. type
  21.   { TToolWindow97 }
  22.  
  23.   TToolWindow97 = class(TCustomToolWindow97)
  24.   private
  25.     FMinClientWidth, FMinClientHeight: Integer;
  26.     FBarHeight, FBarWidth: Integer;
  27.     function GetClientAreaWidth: Integer;
  28.     procedure SetClientAreaWidth (Value: Integer);
  29.     function GetClientAreaHeight: Integer;
  30.     procedure SetClientAreaHeight (Value: Integer);
  31.     procedure SetClientAreaSize (AWidth, AHeight: Integer);
  32.   protected
  33.     procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override;
  34.     procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override;
  35.     function OrderControls (CanMoveControls: Boolean; PreviousDockType: TDockType;
  36.       DockingTo: TDock97): TPoint; override;
  37.     procedure SizeChanging (const AWidth, AHeight: Integer); override;
  38.   public
  39.     constructor Create (AOwner: TComponent); override;
  40.  
  41.     procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  42.       const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override;
  43.     procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  44.       const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override;
  45.   published
  46.     property ActivateParent;
  47.     property BorderStyle;
  48.     property Caption;
  49.     property Color;
  50.     property CloseButton;
  51.     property CloseButtonWhenDocked;
  52.     property ClientAreaHeight: Integer read GetClientAreaHeight write SetClientAreaHeight;
  53.     property ClientAreaWidth: Integer read GetClientAreaWidth write SetClientAreaWidth;
  54.     property DefaultDock;
  55.     property DockableTo;
  56.     property DockedTo;
  57.     property DockMode;
  58.     property DockPos;
  59.     property DockRow;
  60.     property DragHandleStyle;
  61.     property FloatingMode;
  62.     property Font;
  63.     property FullSize;
  64.     property HideWhenInactive;
  65.     property LastDock;
  66.     property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32;
  67.     property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32;
  68.     property ParentFont;
  69.     property ParentShowHint;
  70.     property PopupMenu;
  71.     property Resizable;
  72.     property ShowCaption;
  73.     property ShowHint;
  74.     property TabOrder;
  75.     property UseLastDock;
  76.     property Version;
  77.     property Visible;
  78.  
  79.     property OnClose;
  80.     property OnCloseQuery;
  81.     property OnDragDrop;
  82.     property OnDragOver;
  83.     property OnDockChanged;
  84.     property OnDockChanging;
  85.     property OnDockChangingEx;
  86.     property OnDockChangingHidden;
  87.     property OnMouseDown;
  88.     property OnMouseMove;
  89.     property OnMouseUp;
  90.     property OnMove;
  91.     property OnRecreated;
  92.     property OnRecreating;
  93.     property OnResize;
  94.     property OnVisibleChanged;
  95.   end;
  96.  
  97. implementation
  98.  
  99. const
  100.   { Constants for TToolWindow97-specific registry values. Do not localize! }
  101.   rvClientWidth = 'ClientWidth';
  102.   rvClientHeight = 'ClientHeight';
  103.  
  104.  
  105. { TToolWindow97 }
  106.  
  107. constructor TToolWindow97.Create (AOwner: TComponent);
  108. begin
  109.   inherited;
  110.   FMinClientWidth := 32;
  111.   FMinClientHeight := 32;
  112.   { Initialize the client size to 32x32 }
  113.   SetBounds (Left, Top, 32, 32);
  114. end;
  115.  
  116. procedure TToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  117.   const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
  118. begin
  119.   inherited;
  120.   { Restore ClientAreaWidth/ClientAreaHeight variables }
  121.   if Resizable then
  122.     SetClientAreaSize (ReadIntProc(Name, rvClientWidth, FBarWidth, ExtraData),
  123.       ReadIntProc(Name, rvClientHeight, FBarHeight, ExtraData));
  124. end;
  125.  
  126. procedure TToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  127.   const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
  128. begin
  129.   inherited;
  130.   { Write values of FBarWidth/FBarHeight }
  131.   WriteIntProc (Name, rvClientWidth, FBarWidth, ExtraData);
  132.   WriteIntProc (Name, rvClientHeight, FBarHeight, ExtraData);
  133. end;
  134.  
  135. procedure TToolWindow97.GetMinimumSize (var AClientWidth, AClientHeight: Integer);
  136. begin
  137.   AClientWidth := FMinClientWidth;
  138.   AClientHeight := FMinClientHeight;
  139. end;
  140.  
  141. procedure TToolWindow97.SizeChanging (const AWidth, AHeight: Integer);
  142. begin
  143.   FBarWidth := AWidth;
  144.   if Parent <> nil then Dec (FBarWidth, Width - ClientWidth);
  145.   FBarHeight := AHeight;
  146.   if Parent <> nil then Dec (FBarHeight, Height - ClientHeight);
  147. end;
  148.  
  149. procedure TToolWindow97.GetBarSize (var ASize: Integer; const DockType: TDockType);
  150. begin
  151.   if DockType <> dtLeftRight then
  152.     ASize := FBarHeight
  153.   else
  154.     ASize := FBarWidth;
  155. end;
  156.  
  157. function TToolWindow97.OrderControls (CanMoveControls: Boolean;
  158.   PreviousDockType: TDockType; DockingTo: TDock97): TPoint;
  159. begin
  160.   Result.X := FBarWidth;
  161.   Result.Y := FBarHeight;
  162. end;
  163.  
  164. function TToolWindow97.GetClientAreaWidth: Integer;
  165. begin
  166.   if Parent = nil then
  167.     Result := Width
  168.   else
  169.     Result := ClientWidth;
  170. end;
  171.  
  172. procedure TToolWindow97.SetClientAreaWidth (Value: Integer);
  173. begin
  174.   SetClientAreaSize (Value, ClientAreaHeight);
  175. end;
  176.  
  177. function TToolWindow97.GetClientAreaHeight: Integer;
  178. begin
  179.   if Parent = nil then
  180.     Result := Height
  181.   else
  182.     Result := ClientHeight;
  183. end;
  184.  
  185. procedure TToolWindow97.SetClientAreaHeight (Value: Integer);
  186. begin
  187.   SetClientAreaSize (ClientAreaWidth, Value);
  188. end;
  189.  
  190. procedure TToolWindow97.SetClientAreaSize (AWidth, AHeight: Integer);
  191. var
  192.   Client: TRect;
  193. begin
  194.   if Parent = nil then
  195.     SetBounds (Left, Top, AWidth, AHeight)
  196.   else begin
  197.     Client := GetClientRect;
  198.     SetBounds (Left, Top, Width - Client.Right + AWidth,
  199.       Height - Client.Bottom + AHeight);
  200.   end;
  201. end;
  202.  
  203. end.
  204.