rm_tb97.pas

进销存·完整的·有数据库的·非常完整·只得参考

    DispatchMessage(Msg);
  end;
end;

type
  PFindWindowData = ^TFindWindowData;
  TFindWindowData = record
    TaskActiveWindow, TaskFirstWindow, TaskFirstTopMost: HWND;
  end;

function DoFindWindow(Wnd: HWND; Param: Longint): Bool; stdcall;
begin
  with PFindWindowData(Param)^ do
    if (Wnd <> TaskActiveWindow) and (Wnd <> Application.Handle) and
      IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then begin
      if GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then begin
        if TaskFirstWindow = 0 then TaskFirstWindow := Wnd;
      end
      else begin
        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;

function GetToolbarDockPos(Ctl: TControl): TGetToolbarDockPosType;
begin
  Result := gtpNone;
  while Assigned(Ctl) and not (Ctl is TCustomToolWindow97) do
    Ctl := Ctl.Parent;
  if Assigned(Ctl) and Assigned(TCustomToolWindow97(Ctl).DockedTo) then
    Result := TGetToolbarDockPosType(TCustomToolWindow97(Ctl).DockedTo.Position);
    { ^ TDockPosition can be casted TGetToolbarDockPosType because its values
      are in the same order }
end;


{ TDock97 - internal }

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

  ControlStyle := ControlStyle + [csAcceptsControls] -
    [csClickEvents, csCaptureMouse, csOpaque];
  FAllowDrag := True;
  FBkgOnToolbars := True;
  DockList := TList.Create;
  DockVisibleList := 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;
  inherited;
  RowSizes.Free;
  DockVisibleList.Free;
  DockList.Free;
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(FArrangeToolbarsClipPoses);
end;

function TDock97.HasVisibleToolbars: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to DockList.Count - 1 do
    if ToolbarVisibleOnDock(TCustomToolWindow97(DockList[I])) then begin
      Result := True;
      Break;
    end;
end;

function TDock97.ToolbarVisibleOnDock(const AToolbar: TCustomToolWindow97): Boolean;
begin
  Result := (AToolbar.Parent = Self) and
    (AToolbar.Visible or (csDesigning in AToolbar.ComponentState));
end;

procedure TDock97.BuildRowInfo;
var
  R, I, Size, HighestSize: Integer;
  ToolbarOnRow: Boolean;
  T: TCustomToolWindow97;
begin
  RowSizes.Clear;
  for R := 0 to GetHighestRow do begin
    ToolbarOnRow := False;
    HighestSize := 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
          ToolbarOnRow := True;
          GetBarSize(Size, GetDockTypeOf(Self));
          if Size > HighestSize then HighestSize := Size;
        end;
    end;
    if ToolbarOnRow and (HighestSize < DefaultBarWidthHeight) then
      HighestSize := DefaultBarWidthHeight;
    RowSizes.Add(Pointer(HighestSize));
  end;
end;

function TDock97.GetRowSize(const Row: Integer;
  const DefaultToolbar: TCustomToolWindow97): Integer;
begin
  Result := 0;
  if Row < RowSizes.Count then
    Result := Longint(RowSizes[Row]);
  if (Result = 0) and Assigned(DefaultToolbar) then
    DefaultToolbar.GetBarSize(Result, GetDockTypeOf(Self));
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, CurRowSize: Integer;
begin
  Result := 0; Before := False;
  HighestRow := GetHighestRow;
  CurY := 0;
  for R := 0 to HighestRow + 1 do begin
    NextY := High(NextY);
    if R <= HighestRow then begin
      CurRowSize := GetRowSize(R, nil);
      if CurRowSize = 0 then Continue;
      NextY := CurY + CurRowSize + DockedBorderSize2;
    end;
    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, CurRowSize: Integer;
begin
  Result := 0;
  HighestRowPlus1 := GetHighestRow + 1;
  CurY := 0;
  for R := 0 to HighestRowPlus1 do begin
    Result := R;
    if R = HighestRowPlus1 then Break;
    CurRowSize := GetRowSize(R, nil);
    if CurRowSize = 0 then Continue;
    Inc(CurY, CurRowSize + DockedBorderSize2);
    if XY < CurY then
      Break;
  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
    else
      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 NewWidth, NewHeight: Integer);
{ Same as setting Width/Height directly, but does not lose Align position. }
begin
  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(False);
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(const ClipPoses: Boolean);
{ The main procedure to arrange all the toolbars docked to it }
type
  PIntegerArray = ^TIntegerArray;
  TIntegerArray = array[0..$7FFFFFFF div SizeOf(Integer) - 1] of Integer;
var
  LeftRight: Boolean;
  EmptySize: Integer;
  HighestRow, R, CurDockPos, CurRowPixel, I, J, K, ClientW, ClientH: Integer;
  CurRowSize: Integer;
  T: TCustomToolWindow97;
  NewDockPos: PIntegerArray;
begin
  if ClipPoses then
    FArrangeToolbarsClipPoses := True;
  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 not HasVisibleToolbars then begin
      EmptySize := Ord(FFixAlign);
      if csDesigning in ComponentState then
        EmptySize := 9;
      if not LeftRight then
        ChangeWidthHeight(Width, EmptySize)
      else
        ChangeWidthHeight(EmptySize, Height);
      Exit;
    end;

    { It can't read the ClientWidth and ClientHeight properties because they
      attempt to create a handle, which requires Parent to be set. "ClientW"
      and "ClientH" are calculated instead. }