⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_tb97.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    ClientW := Width - FNonClientWidth;
    if ClientW < 0 then ClientW := 0;
    ClientH := Height - FNonClientHeight;
    if ClientH < 0 then ClientH := 0;

    { If LimitToOneRow is True, only use the first row }
    if FLimitToOneRow then
      for I := 0 to DockList.Count - 1 do
        with TCustomToolWindow97(DockList[I]) do
          FDockRow := 0;
    { Remove any blank rows }
    RemoveBlankRows;

    { Ensure DockList is in correct ordering according to DockRow/DockPos }
    ListSortEx(DockList, CompareDockRowPos, nil);
    ListSortEx(DockVisibleList, CompareDockRowPos, nil);
    { Find highest row number }
    HighestRow := GetHighestRow;
    { Find FullSize toolbars and make sure there aren't any other toolbars
      on the same row. If there are, shift them down a row. }
    R := 0;
    while R <= HighestRow do begin
      for I := 0 to DockList.Count - 1 do
        with TCustomToolWindow97(DockList[I]) do
          if (FDockRow = R) and FullSize then
            for J := 0 to DockList.Count - 1 do
              if (J <> I) and (TCustomToolWindow97(DockList[J]).FDockRow = R) then begin
                for K := 0 to DockList.Count - 1 do
                  with TCustomToolWindow97(DockList[K]) do
                    if (K <> I) and (FDockRow >= R) then begin
                      Inc(FDockRow);
                      if FDockRow > HighestRow then
                        HighestRow := FDockRow;
                    end;
                Break;
              end;
      Inc(R);
    end;
    { Rebuild the RowInfo, since rows numbers may have shifted }
    BuildRowInfo;
    HighestRow := RowSizes.Count - 1;
    { Adjust DockPos's of toolbars to make sure none of the them overlap }
    for R := 0 to HighestRow do begin
      CurDockPos := 0;
      for I := 0 to DockList.Count - 1 do begin
        T := TCustomToolWindow97(DockList[I]);
        with T do
          if (FDockRow = R) and ToolbarVisibleOnDock(T) then begin
            if FullSize then
              FDockPos := 0
            else begin
              if FDockPos <= CurDockPos then
                FDockPos := CurDockPos
              else
                CurDockPos := FDockPos;
              if not LeftRight then
                Inc(CurDockPos, Width)
              else
                Inc(CurDockPos, Height);
            end;
          end;
      end;
    end;
    { Create a temporary array that holds new DockPos's for the toolbars }
    GetMem(NewDockPos, DockList.Count * SizeOf(Integer));
    try
      for I := 0 to DockList.Count - 1 do
        NewDockPos[I] := TCustomToolWindow97(DockList[I]).FDockPos;

      { Move toolbars that go off the edge of the dock to a fully visible
        position if possible }
      for R := 0 to HighestRow do begin
        if not LeftRight then
          CurDockPos := ClientW
        else
          CurDockPos := ClientH;
        for I := DockList.Count - 1 downto 0 do begin
          T := TCustomToolWindow97(DockList[I]);
          with T do
            if (FDockRow = R) and ToolbarVisibleOnDock(T) and not FullSize then begin
              if not LeftRight then
                Dec(CurDockPos, Width)
              else
                Dec(CurDockPos, Height);
              if NewDockPos[I] > CurDockPos then
                NewDockPos[I] := CurDockPos;
              CurDockPos := NewDockPos[I];
            end;
        end;
        { Since the above code will make the toolbars go off the left if the
          width of all toolbars is more than the width of the dock, push them
          back right if needed }
        CurDockPos := 0;
        for I := 0 to DockList.Count - 1 do begin
          T := TCustomToolWindow97(DockList[I]);
          with T do
            if (FDockRow = R) and ToolbarVisibleOnDock(T) and not FullSize then begin
              if NewDockPos[I] <= CurDockPos then
                NewDockPos[I] := CurDockPos
              else
                CurDockPos := NewDockPos[I];
              if not LeftRight then
                Inc(CurDockPos, Width)
              else
                Inc(CurDockPos, Height);
            end;
        end;
      end;

      { If FArrangeToolbarsClipPoses (ClipPoses) is True, update all the
        toolbars' DockPos's to match the actual positions }
      if FArrangeToolbarsClipPoses then
        for I := 0 to DockList.Count - 1 do
          TCustomToolWindow97(DockList[I]).FDockPos := NewDockPos[I];

      { Now actually move the toolbars }
      CurRowPixel := 0;
      for R := 0 to HighestRow do begin
        CurRowSize := Longint(RowSizes[R]);
        if CurRowSize <> 0 then
          Inc(CurRowSize, DockedBorderSize2);
        for I := 0 to DockList.Count - 1 do begin
          T := TCustomToolWindow97(DockList[I]);
          with T do
            if (FDockRow = R) and ToolbarVisibleOnDock(T) then begin
              Inc(FUpdatingBounds);
              try
                if not LeftRight then begin
                  J := Width;
                  if FullSize then J := ClientW;
                  SetBounds(NewDockPos[I], CurRowPixel, J, CurRowSize)
                end
                else begin
                  J := Height;
                  if FullSize then J := ClientH;
                  SetBounds(CurRowPixel, NewDockPos[I], CurRowSize, J);
                end;
              finally
                Dec(FUpdatingBounds);
              end;
            end;
        end;
        Inc(CurRowPixel, CurRowSize);
      end;
    finally
      FreeMem(NewDockPos);
    end;

    { Set the size of the dock }
    if not LeftRight then
      ChangeWidthHeight(Width, CurRowPixel + FNonClientHeight)
    else
      ChangeWidthHeight(CurRowPixel + FNonClientWidth, Height);
  finally
    Dec(FDisableArrangeToolbars);
    FArrangeToolbarsNeeded := False;
    FArrangeToolbarsClipPoses := False;
  end;
end;

procedure TDock97.ChangeDockList(const Insert: Boolean;
  const Bar: TCustomToolWindow97);
{ Inserts or removes Bar from DockList }
var
  I: Integer;
begin
  I := DockList.IndexOf(Bar);
  if Insert then begin
    if I = -1 then begin
      Bar.FreeNotification(Self);
      DockList.Add(Bar);
    end;
  end
  else begin
    if I <> -1 then
      DockList.Delete(I);
  end;
  ToolbarVisibilityChanged(Bar, False);
end;

procedure TDock97.ToolbarVisibilityChanged(const Bar: TCustomToolWindow97;
  const ForceRemove: Boolean);
var
  Modified, VisibleOnDock: Boolean;
  I: Integer;
begin
  Modified := False;
  I := DockVisibleList.IndexOf(Bar);
  VisibleOnDock := not ForceRemove and ToolbarVisibleOnDock(Bar);
  if VisibleOnDock then begin
    if I = -1 then begin
      DockVisibleList.Add(Bar);
      Modified := True;
    end;
  end
  else begin
    if I <> -1 then begin
      DockVisibleList.Remove(Bar);
      Modified := True;
    end;
  end;

  if Modified then begin
    ArrangeToolbars(False);

    if Assigned(FOnInsertRemoveBar) then
      FOnInsertRemoveBar(Self, VisibleOnDock, 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(False);
end;

procedure TDock97.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent is TCustomToolWindow97) then begin
    DockList.Remove(AComponent);
    DockVisibleList.Remove(AComponent);
  end;
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(False);
  if not (csLoading in ComponentState) and Assigned(FOnResize) then
    FOnResize(Self);
end;

procedure TDock97.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  { note to self: non-client size is stored in FNonClientWidth &
    FNonClientHeight }
  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.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -