?? tb97tlbr.pas
字號:
S, S1: TPoint;
S2: TSmallPoint;
begin
with PToolbar97SizeData(SizeData)^ do begin
SaveFloatingRightX := FFloatingRightX;
try
FFloatingRightX := 0;
S := OrderControls(False, dtNotDocked, nil);
S1 := S;
AddFloatingNCAreaToSize (S1, Resizable);
S2 := PointToSmallPoint(S1);
NewSizes.Add (Pointer(S2));
LastY := S.Y;
Max := S.X;
SkipTo := High(SkipTo);
for X := Max-1 downto LeftMarginNotDocked+CurBarSize+RightMarginNotDocked do begin
if X > SkipTo then Continue;
FFloatingRightX := X;
S := OrderControls(False, dtNotDocked, nil);
if X = S.X then begin
if S.Y = LastY then
NewSizes.Delete (NewSizes.Count-1);
S1 := S;
AddFloatingNCAreaToSize (S1, Resizable);
S2 := PointToSmallPoint(S1);
if NewSizes.IndexOf(Pointer(S2)) = -1 then
NewSizes.Add (Pointer(S2));
LastY := S.Y;
end
else
SkipTo := S.X;
end;
finally
FFloatingRightX := SaveFloatingRightX;
end;
ListSortEx (NewSizes, CompareNewSizes, Pointer(Longint(YOrdering)));
end;
end;
const
MaxSizeSens = 12;
var
I, NewSize: Integer;
S, N: TSmallPoint;
begin
inherited;
SizeData := AllocMem(SizeOf(TToolbar97SizeData));
with PToolbar97SizeData(SizeData)^ do begin
HitTest := HitTestValue;
CurRightX := FFloatingRightX;
DisableSensCheck := False;
OpSide := False;
GetBarSize (CurBarSize, dtNotDocked);
NewSizes := TList.Create;
BuildNewSizes (HitTestValue in [HTTOP, HTBOTTOM]);
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 HitTestValue in [HTLEFT, HTRIGHT] 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 HitTestValue in [HTLEFT, HTRIGHT] 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 HitTest = HTLEFT then
Pos.X := Width-Pos.X
else
if HitTest = HTTOP then
Pos.Y := Height-Pos.Y;
{ Adjust Pos to make up for the "sizing sensitivity", as seen in Office 97 }
if HitTest in [HTLEFT, HTRIGHT] then
NewOpSide := Pos.X < Width
else
NewOpSide := Pos.Y < Height;
if (not DisableSensCheck) or (OpSide <> NewOpSide) then begin
DisableSensCheck := False;
OpSide := NewOpSide;
if HitTest in [HTLEFT, HTRIGHT] 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 HitTest in [HTLEFT, HTRIGHT] 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 HitTest in [HTLEFT, HTRIGHT] 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 HitTest = HTRIGHT 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 HitTest = HTBOTTOM 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
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
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
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;
{ 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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -