?? tb97.pas
字號:
((FDockPos+Height) - Self.ClientHeight));
Break;
end;
end;
end;
end;
{ Arrange again, this time actually moving the toolbars }
CurRowPixel := 0;
for R := 0 to HighestRow do begin
CurRowSize := DockedBorderSize2 + Longint(RowSizes[R]);
CurDockPos := 0;
for I := 0 to DockList.Count-1 do begin
with TCustomToolWindow97(DockList[I]) do begin
if FDockRow <> R then Continue;
if FDockPos <= CurDockPos then
FDockPos := CurDockPos
else
CurDockPos := FDockPos;
Inc (FUpdatingBounds);
try
if not LeftRight then begin
J := Width;
if FullSize then J := Self.ClientWidth;
SetBounds (CurDockPos, CurRowPixel, J, CurRowSize)
end
else begin
J := Height;
if FullSize then J := Self.ClientHeight;
SetBounds (CurRowPixel, CurDockPos, CurRowSize, J);
end;
finally
Dec (FUpdatingBounds);
end;
if not LeftRight then
Inc (CurDockPos, Width)
else
Inc (CurDockPos, Height);
end;
end;
Inc (CurRowPixel, CurRowSize);
end;
{ Set the size of the dock }
if not LeftRight then
ChangeWidthHeight (True, ClientWidth, CurRowPixel)
else
ChangeWidthHeight (True, CurRowPixel, ClientHeight);
finally
Dec (FDisableArrangeToolbars);
FArrangeToolbarsNeeded := False;
end;
end;
procedure TDock97.ChangeDockList (const Insert: Boolean;
const Bar: TCustomToolWindow97; const IsVisible: Boolean);
{ Inserts or removes Bar. It inserts only if IsVisible is True, or is in
design mode }
var
Modified: Boolean;
begin
Modified := False;
if Insert then begin
{ Delete if already exists }
if DockList.IndexOf(Bar) <> -1 then
DockList.Remove (Bar);
{ Only add to dock list if visible }
if (csDesigning in ComponentState) or IsVisible then begin
DockList.Add (Bar);
Modified := True;
end;
end
else begin
if DockList.IndexOf(Bar) <> -1 then begin
DockList.Remove (Bar);
Modified := True;
end;
end;
if Modified then begin
ArrangeToolbars;
{ This corrects a problem in past versions when toolbar is shown after it
was initially hidden }
Bar.ArrangeControls;
if Assigned(FOnInsertRemoveBar) then
FOnInsertRemoveBar (Self, Insert, Bar);
end;
end;
procedure TDock97.Loaded;
begin
inherited;
{ Rearranging is disabled while the component is loading, so now that it's
loaded, rearrange it. }
ArrangeToolbars;
end;
function TDock97.GetPalette: HPALETTE;
begin
Result := FBkg.Palette;
end;
procedure TDock97.DrawBackground (const DC: HDC;
const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
const DrawRect: TRect);
var
UseBmp: TBitmap;
R2: TRect;
SaveIndex: Integer;
DC2: HDC;
begin
UseBmp := FBkg;
{ When FBkgTransparent is True, it keeps a cached copy of the
background that has the transparent color already translated. Without the
cache, redraws can be very slow.
Note: The cache is cleared in the OnChange event of FBkg }
if FBkgTransparent then begin
if FBkgCache = nil then begin
FBkgCache := TBitmap.Create;
with FBkgCache do begin
Palette := CopyPalette(FBkg.Palette);
Width := FBkg.Width;
Height := FBkg.Height;
Canvas.Brush.Color := Self.Color;
Canvas.BrushCopy (Rect(0, 0, Width, Height), FBkg,
Rect(0, 0, Width, Height), FBkg.Canvas.Pixels[0, Height-1] or $02000000);
end;
end;
UseBmp := FBkgCache;
end;
SaveIndex := SaveDC(DC);
try
with IntersectClippingRect do
IntersectClipRect (DC, Left, Top, Right, Bottom);
if Assigned(ExcludeClippingRect) then
with ExcludeClippingRect^ do
ExcludeClipRect (DC, Left, Top, Right, Bottom);
if UseBmp.Palette <> 0 then begin
SelectPalette (DC, UseBmp.Palette, True);
RealizePalette (DC);
end;
R2 := DrawRect;
while R2.Left < R2.Right do begin
while R2.Top < R2.Bottom do begin
{ Note: versions of Toolbar97 prior to 1.68 used 'UseBmp.Canvas.Handle'
instead of DC2 in the BitBlt call. This was changed because there
seems to be a bug in D2/BCB1's Graphics.pas: if you called
<dockname>.Background.LoadFromFile(<filename>) twice the background
would not be shown. }
DC2 := CreateCompatibleDC(DC);
SelectObject (DC2, UseBmp.Handle);
BitBlt (DC, R2.Left, R2.Top, UseBmp.Width, UseBmp.Height,
DC2, 0, 0, SRCCOPY);
DeleteDC (DC2);
Inc (R2.Top, UseBmp.Height);
end;
R2.Top := DrawRect.Top;
Inc (R2.Left, UseBmp.Width);
end;
finally
{ Restores the clipping region and palette back }
RestoreDC (DC, SaveIndex);
end;
end;
procedure TDock97.Paint;
var
R, R2: TRect;
P1, P2: TPoint;
begin
inherited;
with Canvas do begin
R := ClientRect;
{ Draw dotted border in design mode }
if csDesigning in ComponentState then begin
Pen.Style := psDot;
Pen.Color := clBtnShadow;
Brush.Style := bsClear;
Rectangle (R.Left, R.Top, R.Right, R.Bottom);
Pen.Style := psSolid;
InflateRect (R, -1, -1);
end;
{ Draw the Background }
if UsingBackground then begin
R2 := ClientRect;
{ Make up for nonclient area }
P1 := ClientToScreen(Point(0, 0));
P2 := Parent.ClientToScreen(BoundsRect.TopLeft);
Dec (R2.Left, Left + (P1.X-P2.X));
Dec (R2.Top, Top + (P1.Y-P2.Y));
DrawBackground (Canvas.Handle, R, nil, R2);
end;
end;
end;
procedure TDock97.WMMove (var Message: TWMMove);
begin
inherited;
if UsingBackground then
InvalidateBackgrounds;
end;
procedure TDock97.WMSize (var Message: TWMSize);
begin
inherited;
ArrangeToolbars;
if not(csLoading in ComponentState) and Assigned(FOnResize) then
FOnResize (Self);
end;
procedure TDock97.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
inherited;
with Message.CalcSize_Params^.rgrc[0] do begin
if blTop in BoundLines then Inc (Top);
if blBottom in BoundLines then Dec (Bottom);
if blLeft in BoundLines then Inc (Left);
if blRight in BoundLines then Dec (Right);
end;
end;
procedure TDock97.WMNCPaint (var Message: TMessage);
var
R, R2: TRect;
DC: HDC;
NewClipRgn: HRGN;
HighlightPen, ShadowPen, SavePen: HPEN;
begin
{ Don't draw border when nothing is docked }
if (DockList.Count = 0) and not(csDesigning in ComponentState) then
Exit;
{ This works around WM_NCPAINT problem described at top of source code }
{no! R := Rect(0, 0, Width, Height);}
GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
DC := GetWindowDC(Handle);
try
{ Use update region }
if (Message.WParam <> 0) and (Message.WParam <> 1) then begin
GetWindowRect (Handle, R2);
if SelectClipRgn(DC, HRGN(Message.WParam)) = ERROR then begin
NewClipRgn := CreateRectRgnIndirect(R2);
SelectClipRgn (DC, NewClipRgn);
DeleteObject (NewClipRgn);
end;
OffsetClipRgn (DC, -R2.Left, -R2.Top);
end;
{ Draw BoundLines }
HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
if blTop in BoundLines then begin
SavePen := SelectObject(DC, ShadowPen);
MoveToEx (DC, R.Left, R.Top, nil); LineTo (DC, R.Right, R.Top);
SelectObject (DC, SavePen);
end;
if blLeft in BoundLines then begin
SavePen := SelectObject(DC, ShadowPen);
MoveToEx (DC, R.Left, R.Top, nil); LineTo (DC, R.Left, R.Bottom);
SelectObject (DC, SavePen);
end;
if blBottom in BoundLines then begin
SavePen := SelectObject(DC, HighlightPen);
MoveToEx (DC, R.Left, R.Bottom-1, nil); LineTo (DC, R.Right, R.Bottom-1);
SelectObject (DC, SavePen);
end;
if blRight in BoundLines then begin
SavePen := SelectObject(DC, HighlightPen);
MoveToEx (DC, R.Right-1, R.Top, nil); LineTo (DC, R.Right-1, R.Bottom);
SelectObject (DC, SavePen);
end;
DeleteObject (ShadowPen);
DeleteObject (HighlightPen);
finally
ReleaseDC (Handle, DC);
end;
end;
procedure TDock97.CMColorChanged (var Message: TMessage);
begin
if UsingBackground then
{ Erase the cache }
BackgroundChanged (FBkg);
inherited;
end;
procedure TDock97.CMSysColorChange (var Message: TMessage);
begin
inherited;
if UsingBackground then
{ Erase the cache }
BackgroundChanged (FBkg);
end;
{ TDock97 - property access methods }
procedure TDock97.SetAllowDrag (Value: Boolean);
var
I: Integer;
begin
if FAllowDrag <> Value then begin
FAllowDrag := Value;
for I := 0 to ControlCount-1 do
if Controls[I] is TCustomToolWindow97 then
RecalcNCArea (TCustomToolWindow97(Controls[I]));
end;
end;
procedure TDock97.SetBackground (Value: TBitmap);
begin
FBkg.Assign (Value);
end;
function TDock97.UsingBackground: Boolean;
begin
Result := (FBkg.Width <> 0) and (FBkg.Height <> 0);
end;
procedure TDock97.InvalidateBackgrounds;
{ Called after background is changed }
var
I: Integer;
begin
Invalidate;
{ Synchronize child toolbars also }
for I := 0 to DockList.Count-1 do
with TCustomToolWindow97(DockList[I]) do begin
InvalidateDockedNCArea;
Invalidate;
end;
end;
procedure TDock97.BackgroundChanged (Sender: TObject);
begin
{ Erase the cache }
FBkgCache.Free;
FBkgCache := nil;
InvalidateBackgrounds;
end;
procedure TDock97.SetBackgroundOnToolbars (Value: Boolean);
begin
if FBkgOnToolbars <> Value then begin
FBkgOnToolbars := Value;
InvalidateBackgrounds;
end;
end;
procedure TDock97.SetBackgroundTransparent (Value: Boolean);
begin
if FBkgTransparent <> Value then begin
FBkgTransparent := Value;
if UsingBackground then
{ Erase the cache }
BackgroundChanged (FBkg);
end;
end;
procedure TDock97.SetBoundLines (Value: TDockBoundLines);
begin
if FBoundLines <> Value then begin
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -