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

📄 tb97.pas

📁 Nicesoft ERP 是新一代智能型 ERP 系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        if TaskFirstTopMost = 0 then TaskFirstTopMost := Wnd;
      end;
    end;
  Result := True;
end;

function FindTopLevelWindow (ActiveWindow: HWND): HWND;
var
  FindData: TFindWindowData;
begin
  with FindData do begin
    TaskActiveWindow := ActiveWindow;
    TaskFirstWindow := 0;
    TaskFirstTopMost := 0;
    EnumThreadWindows (GetCurrentThreadID, @DoFindWindow, Longint(@FindData));
    if TaskFirstWindow <> 0 then
      Result := TaskFirstWindow
    else
      Result := TaskFirstTopMost;
  end;
end;

procedure RecalcNCArea (const Ctl: TWinControl);
begin
  if Ctl.HandleAllocated then
    SetWindowPos (Ctl.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;


{ TDock97 - internal }

constructor TDock97.Create (AOwner: TComponent);
begin
  inherited;

  ControlStyle := ControlStyle +  [csAcceptsControls, csNoStdEvents] -
    [csClickEvents, csCaptureMouse, csOpaque];
  FAllowDrag := True;
  FBkgOnToolbars := True;
  DockList := TList.Create;
  RowSizes := TList.Create;
  FBkg := TBitmap.Create;
  FBkg.OnChange := BackgroundChanged;
  Color := clBtnFace;
  Position := dpTop;
end;

procedure TDock97.CreateParams (var Params: TCreateParams);
begin
  inherited;
  { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
    and are not necessary for this control at run time }
  if not(csDesigning in ComponentState) then
    with Params.WindowClass do
      Style := Style and not(CS_HREDRAW or CS_VREDRAW);
end;

destructor TDock97.Destroy;
begin
  FBkgCache.Free;
  FBkg.Free;
  RowSizes.Free;
  DockList.Free;
  inherited;
end;

procedure TDock97.SetParent (AParent: TWinControl);
begin
  if (AParent is TCustomToolWindow97) or (AParent is TDock97) then
    raise EInvalidOperation.Create(STB97DockParentNotAllowed);

  inherited;
end;

procedure TDock97.BeginUpdate;
begin
  Inc (FDisableArrangeToolbars);
end;

procedure TDock97.EndUpdate;
begin
  Dec (FDisableArrangeToolbars);
  if FArrangeToolbarsNeeded and (FDisableArrangeToolbars = 0) then
    ArrangeToolbars;
end;

procedure TDock97.BuildRowInfo;
var
  R, I, Size, HighestSize: Integer;
begin
  RowSizes.Clear;
  for R := 0 to GetHighestRow do begin
    HighestSize := DefaultBarWidthHeight;
    for I := 0 to DockList.Count-1 do begin
      with TCustomToolWindow97(DockList[I]) do begin
        if FDockRow <> R then Continue;
        GetBarSize (Size, GetDockTypeOf(Self));
        if Size > HighestSize then HighestSize := Size;
      end;
    end;
    RowSizes.Add (Pointer(HighestSize));
  end;
end;

function TDock97.GetRowSize (const Row: Integer;
  const DefaultToolbar: TCustomToolWindow97): Integer;
begin
  if Row < RowSizes.Count then
    Result := Longint(RowSizes[Row])
  else begin
    { If it's out of bounds }
    if DefaultToolbar = nil then
      Result := 0
    else
      DefaultToolbar.GetBarSize (Result, GetDockTypeOf(Self));
  end;
end;

function TDock97.GetRowOf (const XY: Integer; var Before: Boolean): Integer;
{ Returns row number of the specified coordinate. Before is set to True if it
  was close to being in between two rows. }
var
  HighestRow, R, CurY, NextY: Integer;
begin
  Result := 0;  Before := False;
  HighestRow := GetHighestRow;
  CurY := 0;
  for R := 0 to HighestRow+1 do begin
    if R <= HighestRow then
      NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2
    else
      NextY := High(NextY);
    if XY <= CurY+5 then begin
      Result := R;
      Before := True;
      Break;
    end;
    if (XY >= CurY+5) and (XY <= NextY-5) then begin
      Result := R;
      Break;
    end;
    CurY := NextY;
  end;
end;

function TDock97.GetDesignModeRowOf (const XY: Integer): Integer;
{ Similar to GetRowOf, but is a little different to accomidate design mode
  better }
var
  HighestRowPlus1, R, CurY, NextY: Integer;
begin
  Result := 0;
  HighestRowPlus1 := GetHighestRow+1;
  CurY := 0;
  for R := 0 to HighestRowPlus1 do begin
    Result := R;
    if R = HighestRowPlus1 then Break;
    NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2;
    if XY < NextY then
      Break;
    CurY := NextY;
  end;
end;

function TDock97.GetHighestRow: Integer;
{ Returns highest used row number, or -1 if no rows are used }
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to DockList.Count-1 do
    with TCustomToolWindow97(DockList[I]) do
      if FDockRow > Result then
        Result := FDockRow;
end;

function TDock97.GetNumberOfToolbarsOnRow (const Row: Integer;
  const NotIncluding: TCustomToolWindow97): Integer;
{ Returns number of toolbars on the specified row. The toolbar specified by
  "NotIncluding" is not included in the count. }
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to DockList.Count-1 do
    if (TCustomToolWindow97(DockList[I]).FDockRow = Row) and
       (DockList[I] <> NotIncluding) then
      Inc (Result);
end;

procedure TDock97.RemoveBlankRows;
{ Deletes any blank row numbers, adjusting the docked toolbars' FDockRow as
  needed }
var
  HighestRow, R, I: Integer;
  RowIsEmpty: Boolean;
begin
  HighestRow := GetHighestRow;
  R := 0;
  while R <= HighestRow do begin
    RowIsEmpty := True;
    for I := 0 to DockList.Count-1 do
      if TCustomToolWindow97(DockList[I]).FDockRow = R then begin
        RowIsEmpty := False;
        Break;
      end;
    if RowIsEmpty then begin
      { Shift all ones higher than R back one }
      for I := 0 to DockList.Count-1 do
        with TCustomToolWindow97(DockList[I]) do
          if FDockRow > R then
            Dec (FDockRow);
      Dec (HighestRow);
    end;
    Inc (R);
  end;
end;

procedure TDock97.InsertRowBefore (const BeforeRow: Integer);
{ Inserts a blank row before BeforeRow, adjusting all the docked toolbars'
  FDockRow as needed }
var
  I: Integer;
begin
  for I := 0 to DockList.Count-1 do
    with TCustomToolWindow97(DockList[I]) do
      if FDockRow >= BeforeRow then
        Inc (FDockRow);
end;

procedure TDock97.ChangeWidthHeight (const IsClientWidthAndHeight: Boolean;
  NewWidth, NewHeight: Integer);
{ Same as setting Width/Height or ClientWidth/ClientHeight directly, but does
  not lose Align position. }
begin
  if IsClientWidthAndHeight then begin
    Inc (NewWidth, Width-ClientWidth);
    Inc (NewHeight, Height-ClientHeight);
  end;
  case Align of
    alTop, alLeft:
      SetBounds (Left, Top, NewWidth, NewHeight);
    alBottom:
      SetBounds (Left, Top-NewHeight+Height, NewWidth, NewHeight);
    alRight:
      SetBounds (Left-NewWidth+Width, Top, NewWidth, NewHeight);
  end;
end;

procedure TDock97.AlignControls (AControl: TControl; var Rect: TRect);
begin
  ArrangeToolbars;
end;

function CompareDockRowPos (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
  if TCustomToolWindow97(Item1).FDockRow <> TCustomToolWindow97(Item2).FDockRow then
    Result := TCustomToolWindow97(Item1).FDockRow - TCustomToolWindow97(Item2).FDockRow
  else
    Result := TCustomToolWindow97(Item1).FDockPos - TCustomToolWindow97(Item2).FDockPos;
end;

procedure TDock97.ArrangeToolbars;
{ The main procedure to arrange all the toolbars docked to it }
var
  LeftRight: Boolean;
  EmptySize: Integer;
  HighestRow, R, CurDockPos, CurRowPixel, I, J, K: Integer;
  CurRowSize: Integer;
begin
  if (FDisableArrangeToolbars > 0) or (csLoading in ComponentState) then begin
    FArrangeToolbarsNeeded := True;
    Exit;
  end;

  Inc (FDisableArrangeToolbars);
  try
    { Work around VCL alignment bug when docking toolbars taller or wider than
      the client height or width of the form. }
    if not(csDesigning in ComponentState) and HandleAllocated then
      SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
        SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

    LeftRight := Position in PositionLeftOrRight;

    if DockList.Count = 0 then begin
      EmptySize := Ord(FFixAlign);
      if csDesigning in ComponentState then
        EmptySize := 9;
      if not LeftRight then
        ChangeWidthHeight (False, Width, EmptySize)
      else
        ChangeWidthHeight (False, EmptySize, Height);
      Exit;
    end;

    { Ensure list is in correct ordering according to DockRow/DockPos }
    ListSortEx (DockList, CompareDockRowPos, nil);

    { 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;

    { Find highest row number }
    HighestRow := GetHighestRow;
    { Arrange, first without actually moving the toolbars onscreen }
    R := 0;
    while R <= HighestRow do begin
      CurDockPos := 0;
      for I := 0 to DockList.Count-1 do begin
        with TCustomToolWindow97(DockList[I]) do begin
          if FDockRow <> R then Continue;
          if FullSize then
            { If FullSize, make sure there aren't any other toolbars on the same
              row. If there are, shift them down a row. }
            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;
          if FDockPos <= CurDockPos then
            FDockPos := CurDockPos
          else
            CurDockPos := FDockPos;
          if not LeftRight then
            Inc (CurDockPos, Width)
          else
            Inc (CurDockPos, Height);
        end;
      end;
      Inc (R);
    end;
    { Rebuild the RowInfo, since rows numbers may have shifted }
    BuildRowInfo;
    HighestRow := RowSizes.Count-1;
    { Try to move all the toolbars that are offscreen to a fully visible position }
    for R := 0 to HighestRow do
      for I := 0 to DockList.Count-1 do
        with TCustomToolWindow97(DockList[I]) do begin
          if FDockRow <> R then Continue;
          if FullSize then
            FDockPos := 0
          else
            for J := DockList.Count-1 downto I do
              with TCustomToolWindow97(DockList[J]) do begin
                if FDockRow <> R then Continue;
                if not LeftRight then begin
                  if FDockPos+Width > Self.ClientWidth then begin
                    Dec (TCustomToolWindow97(DockList[I]).FDockPos,
                      ((FDockPos+Width) - Self.ClientWidth));
                    Break;
                  end;
                end
                else begin
                  if FDockPos+Height > Self.ClientHeight then begin
                    Dec (TCustomToolWindow97(DockList[I]).FDockPos,

⌨️ 快捷键说明

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