tb97.pas

Nicesoft ERP 是新一代智能型 ERP 系统

                      ((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