www.pudn.com > tb97_176.zip > TB97Tlbr.pas, change:2000-06-25,size:34480b
unit TB97Tlbr;
{
Toolbar97
Copyright (C) 1998-99 by Jordan Russell
For conditions of distribution and use, see LICENSE.TXT.
TCustomToolbar97, TToolbar97, TToolbarSep97
}
interface
{$I TB97Ver.inc}
uses
Windows, Messages, Classes, Controls, Graphics,
TB97;
type
{ TCustomToolbar97 }
TToolbarParams = record
InitializeOrderByPosition, DesignOrderByPosition: Boolean;
end;
TCustomToolbar97 = class(TCustomToolWindow97)
private
FToolbarParams: TToolbarParams;
FFloatingRightX: Integer;
FOrderListDirty: Boolean;
SizeData: Pointer;
{ Lists }
SlaveInfo, { List of slave controls. Items are pointers to TSlaveInfo's }
GroupInfo, { List of the control "groups". List items are pointers to TGroupInfo's }
LineSeps, { List of the Y locations of line separators. Items are casted in TLineSep's }
OrderList: TList; { List of the child controls, arranged using the current "OrderIndex" values }
{ Property access methods }
function GetOrderIndex (Control: TControl): Integer;
procedure SetFloatingWidth (Value: Integer);
procedure SetOrderIndex (Control: TControl; Value: Integer);
{ Internal }
procedure CleanOrderList;
procedure SetControlVisible (const Control: TControl;
const LeftOrRight: Boolean);
function ShouldControlBeVisible (const Control: TControl;
const LeftOrRight: Boolean): Boolean;
procedure FreeGroupInfo (const List: TList);
procedure BuildGroupInfo (const List: TList; const TranslateSlave: Boolean;
const OldDockType, NewDockType: TDockType);
{ Messages }
procedure CMControlListChange (var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
procedure WMWindowPosChanging (var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
protected
property ToolbarParams: TToolbarParams read FToolbarParams;
procedure Paint; override;
procedure BuildPotentialSizesList (SizesList: TList); dynamic;
function ChildControlTransparent (Ctl: TControl): Boolean; override;
procedure GetParams (var Params: TToolWindowParams); override;
procedure GetToolbarParams (var Params: TToolbarParams); dynamic;
procedure ResizeBegin (ASizeHandle: TToolWindowSizeHandle); override;
procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); override;
procedure ResizeEnd (Accept: Boolean); override;
procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override;
procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override;
procedure InitializeOrdering; override;
function OrderControls (CanMoveControls: Boolean; PreviousDockType: TDockType;
DockingTo: TDock97): TPoint; override;
public
property OrderIndex[Control: TControl]: Integer read GetOrderIndex write SetOrderIndex;
property FloatingWidth: Integer read FFloatingRightX write SetFloatingWidth;
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override;
procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override;
procedure SetSlaveControl (const ATopBottom, ALeftRight: TControl);
end;
{ TToolbar97 }
TToolbar97 = class(TCustomToolbar97)
published
property ActivateParent;
property BorderStyle;
property Caption;
property Color;
property CloseButton;
property CloseButtonWhenDocked;
property DefaultDock;
property DockableTo;
property DockedTo;
property DockMode;
property DockPos;
property DockRow;
property DragHandleStyle;
property FloatingMode;
property Font;
property FullSize;
property HideWhenInactive;
property LastDock;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowCaption;
property ShowHint;
property TabOrder;
property UseLastDock;
property Version;
property Visible;
property OnClose;
property OnCloseQuery;
property OnDragDrop;
property OnDragOver;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMove;
property OnRecreated;
property OnRecreating;
property OnDockChanged;
property OnDockChanging;
property OnDockChangingEx;
property OnDockChangingHidden;
property OnResize;
property OnVisibleChanged;
end;
{ TToolbarSep97 }
TToolbarSepSize = 1..MaxInt;
TToolbarSep97 = class(TGraphicControl)
private
FBlank: Boolean;
FSizeHorz, FSizeVert: TToolbarSepSize;
procedure SetBlank (Value: Boolean);
procedure SetSizeHorz (Value: TToolbarSepSize);
procedure SetSizeVert (Value: TToolbarSepSize);
protected
procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure SetParent (AParent: TWinControl); override;
public
constructor Create (AOwner: TComponent); override;
published
{ These two properties don't need to be stored since it automatically gets
resized based on the setting of SizeHorz and SizeVert }
property Width stored False;
property Height stored False;
property Blank: Boolean read FBlank write SetBlank default False;
property SizeHorz: TToolbarSepSize read FSizeHorz write SetSizeHorz default 6;
property SizeVert: TToolbarSepSize read FSizeVert write SetSizeVert default 6;
property Visible;
end;
{$IFOPT J+}
{$DEFINE _TB97_OPT_J}
{$J-} { don't let the following typed constants be modified }
{$ENDIF}
const
tb97DefaultBarWidthHeight = 8;
tb97TopMarginFloating = 2;
tb97TopMarginDocked = 0;
tb97TopMargin: array[Boolean] of Integer = (tb97TopMarginFloating, tb97TopMarginDocked);
tb97BottomMarginFloating = 1;
tb97BottomMarginDocked = 0;
tb97BottomMargin: array[Boolean] of Integer = (tb97BottomMarginFloating, tb97BottomMarginDocked);
tb97LeftMarginFloating = 4;
tb97LeftMarginDocked = 0;
tb97LeftMargin: array[Boolean] of Integer = (tb97LeftMarginFloating, tb97LeftMarginDocked);
tb97RightMarginFloating = 4;
tb97RightMarginDocked = 0;
tb97RightMargin: array[Boolean] of Integer = (tb97RightMarginFloating, tb97RightMarginDocked);
tb97LineSpacing = 6;
{$IFDEF _TB97_OPT_J}
{$J+}
{$UNDEF _TB97_OPT_J}
{$ENDIF}
implementation
uses
SysUtils, TB97Cmn, TB97Cnst;
const
{ Constants for registry values. Do not localize! }
{ TCustomToolbar97 specific }
rvFloatRightX = 'FloatRightX';
type
{ Used internally by the TCustomToolbar97.Resize* procedures }
PToolbar97SizeData = ^TToolbar97SizeData;
TToolbar97SizeData = record
SizeHandle: TToolWindowSizeHandle;
NewSizes: TList; { List of valid new sizes. Items are casted into TSmallPoints }
CurRightX: Integer;
DisableSensCheck, OpSide: Boolean;
SizeSens: Integer;
end;
{ Used in TCustomToolbar97.GroupInfo lists }
PGroupInfo = ^TGroupInfo;
TGroupInfo = record
GroupWidth, { Width in pixels of the group, if all controls were
lined up left-to-right }
GroupHeight: Integer; { Heights in pixels of the group, if all controls were
lined up top-to-bottom }
Members: TList;
end;
{ Used in TCustomToolbar97.SlaveInfo lists }
PSlaveInfo = ^TSlaveInfo;
TSlaveInfo = record
LeftRight,
TopBottom: TControl;
end;
{ Used in TCustomToolbar97.LineSeps lists }
TLineSep = packed record
Y: SmallInt;
Blank: Boolean;
Unused: Boolean;
end;
{ Use by CompareControls }
PCompareExtra = ^TCompareExtra;
TCompareExtra = record
Toolbar: TCustomToolbar97;
ComparePositions: Boolean;
CurDockType: TDockType;
end;
{ TCustomToolbar97 }
constructor TCustomToolbar97.Create (AOwner: TComponent);
begin
inherited;
GetToolbarParams (FToolbarParams);
GroupInfo := TList.Create;
SlaveInfo := TList.Create;
LineSeps := TList.Create;
OrderList := TList.Create;
end;
destructor TCustomToolbar97.Destroy;
var
I: Integer;
begin
OrderList.Free;
LineSeps.Free;
if Assigned(SlaveInfo) then begin
for I := SlaveInfo.Count-1 downto 0 do
FreeMem (SlaveInfo.Items[I]);
SlaveInfo.Free;
end;
FreeGroupInfo (GroupInfo);
GroupInfo.Free;
inherited;
end;
procedure TCustomToolbar97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
begin
inherited;
FFloatingRightX := ReadIntProc(Name, rvFloatRightX, 0, ExtraData);
end;
procedure TCustomToolbar97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
begin
inherited;
WriteIntProc (Name, rvFloatRightX, FFloatingRightX, ExtraData);
end;
procedure TCustomToolbar97.GetMinimumSize (var AClientWidth, AClientHeight: Integer);
begin
AClientWidth := 0;
AClientHeight := 0;
end;
procedure TCustomToolbar97.CleanOrderList;
{ TCustomToolbar97 uses a CM_CONTROLLISTCHANGE handler to detect when new
controls are added to the toolbar. The handler adds the new controls to
OrderList, which can be manipulated by the application using the OrderIndex
property.
The only problem is, the VCL relays CM_CONTROLLISTCHANGE messages
to all parents of a control, not just the immediate parent. In pre-1.76
versions of Toolbar97, OrderList contained not only the immediate children
of the toolbar, but their children too. So this caused the OrderIndex
property to return unexpected results.
What this method does is clear out all controls in OrderList that aren't
immediate children of the toolbar. (A check of Parent can't be put into the
CM_CONTROLLISTCHANGE handler because that message is sent before a new
Parent is assigned.) }
var
I: Integer;
begin
if not FOrderListDirty then
Exit;
I := 0;
while I < OrderList.Count do begin
if TControl(OrderList.List[I]).Parent <> Self then
OrderList.Delete (I)
else
Inc (I);
end;
FOrderListDirty := False;
end;
function CompareControls (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
with PCompareExtra(ExtraData)^ do
if ComparePositions then begin
if CurDockType <> dtLeftRight then
Result := TControl(Item1).Left - TControl(Item2).Left
else
Result := TControl(Item1).Top - TControl(Item2).Top;
end
else
with Toolbar.OrderList do
Result := IndexOf(Item1) - IndexOf(Item2);
end;
procedure TCustomToolbar97.InitializeOrdering;
var
Extra: TCompareExtra;
begin
inherited;
{ Initialize order of items in OrderList }
if ToolbarParams.InitializeOrderByPosition then begin
with Extra do begin
Toolbar := Self;
ComparePositions := True;
CurDockType := GetDockTypeOf(DockedTo);
end;
CleanOrderList;
ListSortEx (OrderList, CompareControls, @Extra);
end;
end;
procedure TCustomToolbar97.GetBarSize (var ASize: Integer; const DockType: TDockType);
var
I: Integer;
begin
ASize := tb97DefaultBarWidthHeight;
for I := 0 to ControlCount-1 do
if not(Controls[I] is TToolbarSep97) then
with Controls[I] do begin
if ShouldControlBeVisible(Controls[I], DockType = dtLeftRight) then begin
if DockType = dtLeftRight then begin
if Width > ASize then ASize := Width;
end
else begin
if Height > ASize then ASize := Height;
end;
end;
end;
end;
procedure TCustomToolbar97.GetParams (var Params: TToolWindowParams);
begin
inherited;
with Params do begin
CallAlignControls := False;
ResizeEightCorner := False;
ResizeClipCursor := False;
end;
end;
procedure TCustomToolbar97.GetToolbarParams (var Params: TToolbarParams);
begin
with Params do begin
InitializeOrderByPosition := True;
DesignOrderByPosition := True;
end;
end;
procedure TCustomToolbar97.Paint;
var
S: Integer;
begin
inherited;
{ Long separators when not docked }
if not Docked then
for S := 0 to LineSeps.Count-1 do begin
with TLineSep(LineSeps[S]) do begin
if Blank then Continue;
Canvas.Pen.Color := clBtnShadow;
Canvas.MoveTo (1, Y-4); Canvas.LineTo (ClientWidth-1, Y-4);
Canvas.Pen.Color := clBtnHighlight;
Canvas.MoveTo (1, Y-3); Canvas.LineTo (ClientWidth-1, Y-3);
end;
end;
end;
function ControlVisibleOrDesigning (AControl: TControl): Boolean;
begin
Result := AControl.Visible or (csDesigning in AControl.ComponentState);
end;
procedure TCustomToolbar97.SetControlVisible (const Control: TControl;
const LeftOrRight: Boolean);
{ If Control is a master or slave control, it automatically adjusts the
Visible properties of both the master and slave control based on the value
of LeftOrRight }
var
I: Integer;
begin
for I := 0 to SlaveInfo.Count-1 do
with PSlaveInfo(SlaveInfo[I])^ do
if (TopBottom = Control) or (LeftRight = Control) then begin
if Assigned(TopBottom) then TopBottom.Visible := not LeftOrRight;
if Assigned(LeftRight) then LeftRight.Visible := LeftOrRight;
Exit;
end;
end;
function TCustomToolbar97.ShouldControlBeVisible (const Control: TControl;
const LeftOrRight: Boolean): Boolean;
{ If Control is a master or slave control, it returns the appropriate visibility
setting based on the value of LeftOrRight, otherwise it simply returns the
current Visible setting }
var
I: Integer;
begin
for I := 0 to SlaveInfo.Count-1 do
with PSlaveInfo(SlaveInfo[I])^ do
if TopBottom = Control then begin
Result := not LeftOrRight;
Exit;
end
else
if LeftRight = Control then begin
Result := LeftOrRight;
Exit;
end;
Result := ControlVisibleOrDesigning(Control);
end;
procedure TCustomToolbar97.FreeGroupInfo (const List: TList);
var
I: Integer;
L: PGroupInfo;
begin
if List = nil then Exit;
for I := List.Count-1 downto 0 do begin
L := List.Items[I];
if Assigned(L) then begin
L^.Members.Free;
FreeMem (L);
end;
List.Delete (I);
end;
end;
procedure TCustomToolbar97.BuildGroupInfo (const List: TList;
const TranslateSlave: Boolean; const OldDockType, NewDockType: TDockType);
var
I: Integer;
GI: PGroupInfo;
Children: TList; {items casted into TControls}
C: TControl;
NewGroup: Boolean;
Extra: TCompareExtra;
begin
FreeGroupInfo (List);
if ControlCount = 0 then Exit;
Children := TList.Create;
try
for I := 0 to ControlCount-1 do
if (not TranslateSlave and ControlVisibleOrDesigning(Controls[I])) or
(TranslateSlave and ShouldControlBeVisible(Controls[I], NewDockType = dtLeftRight)) then
Children.Add (Controls[I]);
with Extra do begin
Toolbar := Self;
CurDockType := OldDockType;
ComparePositions := (csDesigning in ComponentState) and
ToolbarParams.DesignOrderByPosition;
end;
if Extra.ComparePositions then begin
CleanOrderList;
ListSortEx (OrderList, CompareControls, @Extra);
end;
ListSortEx (Children, CompareControls, @Extra);
GI := nil;
NewGroup := True;
for I := 0 to Children.Count-1 do begin
if NewGroup then begin
NewGroup := False;
GI := AllocMem(SizeOf(TGroupInfo));
{ Note: AllocMem initializes the newly allocated data to zero }
GI^.Members := TList.Create;
List.Add (GI);
end;
C := Children[I];
GI^.Members.Add (C);
if C is TToolbarSep97 then
NewGroup := True
else begin
with C do begin
Inc (GI^.GroupWidth, Width);
Inc (GI^.GroupHeight, Height);
end;
end;
end;
finally
Children.Free;
end;
end;
function TCustomToolbar97.OrderControls (CanMoveControls: Boolean;
PreviousDockType: TDockType; DockingTo: TDock97): TPoint;
{ This arranges the controls on the toolbar }
var
NewDockType: TDockType;
NewDocked: Boolean;
RightX, I: Integer;
CurBarSize, DockRowSize: Integer;
GInfo: TList;
AllowWrap: Boolean;
MinPosPixels, MinRowPixels, CurPosPixel, CurLinePixel, G: Integer;
GoToNewLine: Boolean;
GI: PGroupInfo;
Member: TControl;
MemberIsSep: Boolean;
GroupPosSize, MemberPosSize: Integer;
PreviousSep: TToolbarSep97; PrevMinPosPixels: Integer;
NewLineSep: TLineSep;
label 1;
begin
NewDockType := GetDockTypeOf(DockingTo);
NewDocked := Assigned(DockingTo);
RightX := FFloatingRightX;
if (NewDockType <> dtNotDocked) or (RightX = 0) then
RightX := High(RightX)
else begin
{ Make sure RightX isn't less than the smallest sized control + margins,
in case one of the *LoadToolbarPositions functions happened to read
a value too small. }
for I := 0 to ControlCount-1 do
if not(Controls[I] is TToolbarSep97) then
with Controls[I] do
if Width + (tb97LeftMarginFloating+tb97RightMarginFloating) > RightX then
RightX := Width + (tb97LeftMarginFloating+tb97RightMarginFloating);
end;
if CanMoveControls and (SlaveInfo.Count <> 0) then
for I := 0 to ControlCount-1 do
if not(Controls[I] is TToolbarSep97) then
SetControlVisible (Controls[I], NewDockType = dtLeftRight);
GetBarSize (CurBarSize, NewDockType);
if (DockingTo <> nil) and (DockingTo = DockedTo) then
GetDockRowSize (DockRowSize)
else
DockRowSize := CurBarSize;
if CanMoveControls then
GInfo := GroupInfo
else
GInfo := TList.Create;
try
BuildGroupInfo (GInfo, not CanMoveControls, PreviousDockType, NewDockType);
if CanMoveControls then
LineSeps.Clear;
CurLinePixel := tb97TopMargin[NewDocked];
MinPosPixels := tb97LeftMargin[NewDocked];
if GInfo.Count <> 0 then begin
AllowWrap := not NewDocked;
CurPosPixel := MinPosPixels;
GoToNewLine := False;
PreviousSep := nil; PrevMinPosPixels := 0;
for G := 0 to GInfo.Count-1 do begin
GI := PGroupInfo(GInfo[G]);
if NewDockType <> dtLeftRight then
GroupPosSize := GI^.GroupWidth
else
GroupPosSize := GI^.GroupHeight;
if AllowWrap and
(GoToNewLine or (CurPosPixel+GroupPosSize+tb97RightMargin[NewDocked] > RightX)) then begin
GoToNewLine := False;
CurPosPixel := tb97LeftMargin[NewDocked];
if (G <> 0) and (PGroupInfo(GInfo[G-1])^.Members.Count <> 0) then begin
Inc (CurLinePixel, CurBarSize + tb97LineSpacing);
if Assigned(PreviousSep) then begin
MinPosPixels := PrevMinPosPixels;
if CanMoveControls then begin
PreviousSep.Width := 0;
LongInt(NewLineSep) := 0;
NewLineSep.Y := CurLinePixel;
NewLineSep.Blank := PreviousSep.Blank;
LineSeps.Add (Pointer(NewLineSep));
end;
end;
end;
end;
if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
for I := 0 to GI^.Members.Count-1 do begin
Member := TControl(GI^.Members[I]);
MemberIsSep := Member is TToolbarSep97;
with Member do begin
if not MemberIsSep then begin
if NewDockType <> dtLeftRight then
MemberPosSize := Width
else
MemberPosSize := Height;
end
else begin
if NewDockType <> dtLeftRight then
MemberPosSize := TToolbarSep97(Member).SizeHorz
else
MemberPosSize := TToolbarSep97(Member).SizeVert;
end;
{ If RightX is passed, proceed to next line }
if AllowWrap and not MemberIsSep and
(CurPosPixel+MemberPosSize+tb97RightMargin[NewDocked] > RightX) then begin
CurPosPixel := tb97LeftMargin[NewDocked];
Inc (CurLinePixel, CurBarSize);
GoToNewLine := True;
end;
if NewDockType <> dtLeftRight then begin
if not MemberIsSep then begin
if CanMoveControls then
SetBounds (CurPosPixel, CurLinePixel+((DockRowSize-Height) div 2), Width, Height);
Inc (CurPosPixel, Width);
end
else begin
if CanMoveControls then
SetBounds (CurPosPixel, CurLinePixel, TToolbarSep97(Member).SizeHorz, DockRowSize);
Inc (CurPosPixel, TToolbarSep97(Member).SizeHorz);
end;
end
else begin
if not MemberIsSep then begin
if CanMoveControls then
SetBounds (CurLinePixel+((DockRowSize-Width) div 2), CurPosPixel, Width, Height);
Inc (CurPosPixel, Height);
end
else begin
if CanMoveControls then
SetBounds (CurLinePixel, CurPosPixel, DockRowSize, TToolbarSep97(Member).SizeVert);
Inc (CurPosPixel, TToolbarSep97(Member).SizeVert);
end;
end;
PrevMinPosPixels := MinPosPixels;
if not MemberIsSep then
PreviousSep := nil
else
PreviousSep := TToolbarSep97(Member);
if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
end;
end;
end;
end
else
Inc (MinPosPixels, tb97DefaultBarWidthHeight);
if csDesigning in ComponentState then
Invalidate;
finally
if not CanMoveControls then begin
FreeGroupInfo (GInfo);
GInfo.Free;
end;
end;
Inc (MinPosPixels, tb97RightMargin[NewDocked]);
MinRowPixels := CurLinePixel + CurBarSize + tb97BottomMargin[NewDocked];
if NewDockType <> dtLeftRight then begin
Result.X := MinPosPixels;
Result.Y := MinRowPixels;
end
else begin
Result.X := MinRowPixels;
Result.Y := MinPosPixels;
end;
end;
procedure TCustomToolbar97.CMControlListChange (var Message: TCMControlListChange);
{ The VCL sends this message is sent whenever a child control is inserted into
or deleted from the toolbar }
var
I: Integer;
begin
inherited;
with Message, OrderList do begin
{ Delete any previous occurances of Control in OrderList. There shouldn't
be any if Inserting=True, but just to be safe, check anyway. }
while True do begin
I := IndexOf(Control);
if I = -1 then Break;
Delete (I);
end;
if Inserting then begin
Add (Control);
FOrderListDirty := True;
end;
end;
end;
function CompareNewSizes (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
{ Sorts in descending order }
if ExtraData = nil then
Result := TSmallPoint(Item2).X - TSmallPoint(Item1).X
else
Result := TSmallPoint(Item2).Y - TSmallPoint(Item1).Y;
end;
procedure TCustomToolbar97.BuildPotentialSizesList (SizesList: TList);
var
MinX, SaveFloatingRightX: Integer;
X, LastY: Integer;
S: TPoint;
S2: TSmallPoint;
begin
MinX := tb97LeftMarginFloating + tb97RightMarginFloating;
SaveFloatingRightX := FFloatingRightX;
try
{ Add the widest size to the list }
FFloatingRightX := 0;
S := OrderControls(False, dtNotDocked, nil);
SizesList.Add (Pointer(PointToSmallPoint(S)));
{ Calculate and add rest of sizes to the list }
LastY := S.Y;
X := S.X-1;
while X >= MinX do begin
FFloatingRightX := X;
S := OrderControls(False, dtNotDocked, nil);
if S.X > X then { if it refuses to go any smaller }
Break
else
if X = S.X then begin
if (S.Y = LastY) and (SizesList.Count > 1) then
SizesList.Delete (SizesList.Count-1);
S2 := PointToSmallPoint(S);
if SizesList.IndexOf(Pointer(S2)) = -1 then
SizesList.Add (Pointer(S2));
LastY := S.Y;
Dec (X);
end
else
X := S.X;
end;
finally
FFloatingRightX := SaveFloatingRightX;
end;
end;
procedure TCustomToolbar97.ResizeBegin (ASizeHandle: TToolWindowSizeHandle);
const
MaxSizeSens = 12;
var
I, NewSize: Integer;
S, N: TSmallPoint;
P: TPoint;
begin
inherited;
SizeData := AllocMem(SizeOf(TToolbar97SizeData));
with PToolbar97SizeData(SizeData)^ do begin
SizeHandle := ASizeHandle;
CurRightX := FFloatingRightX;
DisableSensCheck := False;
OpSide := False;
NewSizes := TList.Create;
BuildPotentialSizesList (NewSizes);
for I := 0 to NewSizes.Count-1 do begin
P := SmallPointToPoint(TSmallPoint(NewSizes.List[I]));
AddFloatingNCAreaToSize (P);
NewSizes.List[I] := Pointer(PointToSmallPoint(P));
end;
ListSortEx (NewSizes, CompareNewSizes,
Pointer(Ord(ASizeHandle in [twshTop, twshBottom])));
SizeSens := MaxSizeSens;
{ Adjust sensitivity if it's too high }
for I := 0 to NewSizes.Count-1 do begin
Pointer(S) := NewSizes[I];
if (S.X = Width) and (S.Y = Height) then begin
if I > 0 then begin
Pointer(N) := NewSizes[I-1];
if ASizeHandle in [twshLeft, twshRight] then
NewSize := N.X - S.X - 1
else
NewSize := N.Y - S.Y - 1;
if NewSize < SizeSens then SizeSens := NewSize;
end;
if I < NewSizes.Count-1 then begin
Pointer(N) := NewSizes[I+1];
if ASizeHandle in [twshLeft, twshRight] then
NewSize := S.X - N.X - 1
else
NewSize := S.Y - N.Y - 1;
if NewSize < SizeSens then SizeSens := NewSize;
end;
Break;
end;
end;
if SizeSens < 0 then SizeSens := 0;
end;
end;
procedure TCustomToolbar97.ResizeTrack (var Rect: TRect; const OrigRect: TRect);
var
Pos: TPoint;
NCXDiff: Integer;
NewOpSide: Boolean;
Reverse: Boolean;
I: Integer;
P: TSmallPoint;
begin
inherited;
with PToolbar97SizeData(SizeData)^ do begin
GetCursorPos (Pos);
NCXDiff := ClientToScreen(Point(0, 0)).X - Left;
Dec (Pos.X, Left); Dec (Pos.Y, Top);
if SizeHandle = twshLeft then
Pos.X := Width-Pos.X
else
if SizeHandle = twshTop then
Pos.Y := Height-Pos.Y;
{ Adjust Pos to make up for the "sizing sensitivity", as seen in Office 97 }
if SizeHandle in [twshLeft, twshRight] then
NewOpSide := Pos.X < Width
else
NewOpSide := Pos.Y < Height;
if (not DisableSensCheck) or (OpSide <> NewOpSide) then begin
DisableSensCheck := False;
OpSide := NewOpSide;
if SizeHandle in [twshLeft, twshRight] then begin
if (Pos.X >= Width-SizeSens) and (Pos.X < Width+SizeSens) then
Pos.X := Width;
end
else begin
if (Pos.Y >= Height-SizeSens) and (Pos.Y < Height+SizeSens) then
Pos.Y := Height;
end;
end;
Rect := OrigRect;
if SizeHandle in [twshLeft, twshRight] then
Reverse := Pos.X > Width
else
Reverse := Pos.Y > Height;
if not Reverse then
I := NewSizes.Count-1
else
I := 0;
while True do begin
if (not Reverse and (I < 0)) or
(Reverse and (I >= NewSizes.Count)) then
Break;
Pointer(P) := NewSizes[I];
if SizeHandle in [twshLeft, twshRight] then begin
if (not Reverse and ((I = NewSizes.Count-1) or (Pos.X >= P.X))) or
(Reverse and ((I = 0) or (Pos.X < P.X))) then begin
if I = 0 then
CurRightX := 0
else
CurRightX := P.X - NCXDiff*2;
if SizeHandle = twshRight then
Rect.Right := Rect.Left + P.X
else
Rect.Left := Rect.Right - P.X;
Rect.Bottom := Rect.Top + P.Y;
DisableSensCheck := not EqualRect(Rect, OrigRect);
end;
end
else begin
if (not Reverse and ((I = NewSizes.Count-1) or (Pos.Y >= P.Y))) or
(Reverse and ((I = 0) or (Pos.Y < P.Y))) then begin
if I = NewSizes.Count-1 then
CurRightX := 0
else
CurRightX := P.X - NCXDiff*2;
if SizeHandle = twshBottom then
Rect.Bottom := Rect.Top + P.Y
else
Rect.Top := Rect.Bottom - P.Y;
Rect.Right := Rect.Left + P.X;
DisableSensCheck := not EqualRect(Rect, OrigRect);
end;
end;
if not Reverse then
Dec (I)
else
Inc (I);
end;
end;
end;
procedure TCustomToolbar97.ResizeEnd (Accept: Boolean);
begin
inherited;
if Assigned(SizeData) then begin
with PToolbar97SizeData(SizeData)^ do begin
if Accept then
FFloatingRightX := CurRightX;
NewSizes.Free;
end;
FreeMem (SizeData);
end;
end;
function TCustomToolbar97.GetOrderIndex (Control: TControl): Integer;
begin
CleanOrderList;
Result := OrderList.IndexOf(Control);
if Result = -1 then
raise EInvalidOperation.CreateFmt(STB97ToolbarControlNotChildOfToolbar,
[Control.Name]);
end;
procedure TCustomToolbar97.SetOrderIndex (Control: TControl; Value: Integer);
var
OldIndex: Integer;
begin
CleanOrderList;
with OrderList do begin
OldIndex := IndexOf(Control);
if OldIndex = -1 then
raise EInvalidOperation.CreateFmt(STB97ToolbarControlNotChildOfToolbar,
[Control.Name]);
if Value < 0 then Value := 0;
if Value >= Count then Value := Count-1;
if Value <> OldIndex then begin
Delete (OldIndex);
Insert (Value, Control);
ArrangeControls;
end;
end;
end;
procedure TCustomToolbar97.SetFloatingWidth (Value: Integer);
begin
if FFloatingRightX <> Value then begin
FFloatingRightX := Value;
ArrangeControls;
end;
end;
procedure TCustomToolbar97.SetSlaveControl (const ATopBottom, ALeftRight: TControl);
var
NewVersion: PSlaveInfo;
begin
GetMem (NewVersion, SizeOf(TSlaveInfo));
with NewVersion^ do begin
TopBottom := ATopBottom;
LeftRight := ALeftRight;
end;
SlaveInfo.Add (NewVersion);
ArrangeControls;
end;
function TCustomToolbar97.ChildControlTransparent (Ctl: TControl): Boolean;
begin
Result := Ctl is TToolbarSep97;
end;
procedure TCustomToolbar97.WMWindowPosChanging (var Message: TWMWindowPosChanging);
var
R: TRect;
begin
inherited;
{ When floating, invalidate the toolbar when resized so that the vertical
separators get redrawn.
Note to self: The Invalidate call must be in the WM_WINDOWPOSCHANGING
handler. If it's in WM_SIZE or WM_WINDOWPOSCHANGED there can be repainting
problems in rare cases (refer to Toolbar97 1.65a's implementation). }
if not Docked and HandleAllocated then
with Message.WindowPos^ do
if flags and SWP_DRAWFRAME <> 0 then
Invalidate
else
if flags and SWP_NOSIZE = 0 then begin
GetWindowRect (Handle, R);
if (R.Right-R.Left <> cx) or (R.Bottom-R.Top <> cy) then
Invalidate;
end;
end;
{ TToolbarSep97 }
constructor TToolbarSep97.Create (AOwner: TComponent);
begin
inherited;
FSizeHorz := 6;
FSizeVert := 6;
ControlStyle := ControlStyle - [csOpaque, csCaptureMouse];
end;
procedure TToolbarSep97.SetParent (AParent: TWinControl);
begin
if (AParent <> nil) and not(AParent is TCustomToolbar97) then
raise EInvalidOperation.Create(STB97SepParentNotAllowed);
inherited;
end;
procedure TToolbarSep97.SetBlank (Value: Boolean);
begin
if FBlank <> Value then begin
FBlank := Value;
Invalidate;
end;
end;
procedure TToolbarSep97.SetSizeHorz (Value: TToolbarSepSize);
begin
if FSizeHorz <> Value then begin
FSizeHorz := Value;
if Parent is TCustomToolbar97 then
TCustomToolbar97(Parent).ArrangeControls;
end;
end;
procedure TToolbarSep97.SetSizeVert (Value: TToolbarSepSize);
begin
if FSizeVert <> Value then begin
FSizeVert := Value;
if Parent is TCustomToolbar97 then
TCustomToolbar97(Parent).ArrangeControls;
end;
end;
procedure TToolbarSep97.Paint;
var
R: TRect;
Z: Integer;
begin
inherited;
if not(Parent is TCustomToolbar97) then Exit;
with Canvas do begin
{ Draw dotted border in design mode }
if csDesigning in ComponentState then begin
Pen.Style := psDot;
Pen.Color := clBtnShadow;
Brush.Style := bsClear;
R := ClientRect;
Rectangle (R.Left, R.Top, R.Right, R.Bottom);
Pen.Style := psSolid;
end;
if not FBlank then
if GetDockTypeOf(TCustomToolbar97(Parent).DockedTo) <> dtLeftRight then begin
Z := Width div 2;
Pen.Color := clBtnShadow;
MoveTo (Z-1, 0); LineTo (Z-1, Height);
Pen.Color := clBtnHighlight;
MoveTo (Z, 0); LineTo (Z, Height);
end
else begin
Z := Height div 2;
Pen.Color := clBtnShadow;
MoveTo (0, Z-1); LineTo (Width, Z-1);
Pen.Color := clBtnHighlight;
MoveTo (0, Z); LineTo (Width, Z);
end;
end;
end;
procedure TToolbarSep97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
inherited;
if not(Parent is TCustomToolbar97) then Exit;
{ Relay the message to the parent toolbar }
P := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));
TCustomToolbar97(Parent).MouseDown (Button, Shift, P.X, P.Y);
end;
end.