rm_dsgctrls.pas

这是一个功能强大

    begin
      if ResizeVertical then
      begin
        if ResizeReverese then Top := Bottom - NewSize;
        Bottom := Top + NewSize;
      end
      else
      begin
        if ResizeReverese then Left := Right - NewSize;
        Right := Left + NewSize;
      end;
    end;
  end;

  procedure DoResize;
  var
    I: Integer;
    ARect: TRect;
  begin
    CurrentDock.BeginUpdate;
    try
      if MultiResize then
        for I := 0 to CurrentDock.ToolbarCount - 1 do
        begin
          FToolbar := CurrentDock.Toolbars[I];
          if FToolbar.DockRow = DockRow then
          begin
            ARect := FToolbar.BoundsRect;
            ComputeToolbarNewSize(ARect);
            FToolbar.BoundsRect := ARect;
          end;
        end
      else
      begin
        ARect := Self.BoundsRect;
        ComputeToolbarNewSize(ARect);
        BoundsRect := ARect;
      end;
    finally
      CurrentDock.EndUpdate;
    end;
  end;

  procedure MouseMoved;
  begin
    NewSize := OrigSize;
    SizeDiff := Pos - OrigPos;
    if ResizeReverese then Dec(NewSize, SizeDiff)
    else Inc(NewSize, SizeDiff);

    // adjust min/max resizing
    if NewSize < MinSize then NewSize := MinSize;
    if (NewSize > MaxSize) and (MaxSize > 0) then NewSize := MaxSize;

    OldDragRect := DragRect;
    ComputeToolbarNewSize(DragRect);

    if not UseSmoothDrag then
      DrawDraggingOutline(ScreenDC, @DragRect, @OldDragRect, True, True)
    else
      DoResize;
  end;

var
  Msg: TMsg;
  Accept, VerticalDock: Boolean;
  I: Integer;
  FResizeKind: tbResizeKind;
  AMinSize, AMaxSize, DUMMY: Integer;
begin
  FResizeKind := GetResizeKind(X, Y);
  Result := FResizeKind <> rkNone;

  if not Result then Exit;

  // Initialization
  Accept := False;
  ResizeVertical := FResizeKind in [rkTop, rkBottom];
  ResizeReverese := FResizeKind in [rkLeft, rkTop];
  VerticalDock := CurrentDock.Position in [dpLeft, dpRight];
  MultiResize := VerticalDock xor ResizeVertical;
{$IFDEF USE_TB2K}
  UseSmoothDrag := SmoothDrag;
{$ENDIF}

  // compute maximal/minimal sizes
  MinSize := 0;
  MaxSize := 0;
  if not MultiResize then
  begin // MINIMAL-MAXIMAL sizes of me only or to stay inside of my dock.
    if ResizeVertical then
    begin
      GetMinMaxSize(MinSize, DUMMY, MaxSize, DUMMY);
      if (MaxSize <= 0) or (MaxSize + Top > CurrentDock.Height) then MaxSize := CurrentDock.Height - Top;
    end
    else
    begin
      GetMinMaxSize(DUMMY, MinSize, DUMMY, MaxSize);
      if (MaxSize <= 0) or (MaxSize + Left > CurrentDock.Width) then MaxSize := CurrentDock.Width - Left;
    end;
  end
  else // MINIMAL-MAXIMAL sizes in my row.
    for I := 0 to CurrentDock.ToolbarCount - 1 do
    begin
      FToolbar := CurrentDock.Toolbars[I];
      if FToolbar.DockRow = DockRow then
      begin
        AMinSize := 0;
        AMaxSize := 0;
{$IFDEF USE_TB2K}
        if ResizeVertical then
          TTBCustomDockableWindowAccess(FToolbar).GetMinMaxSize(AMinSize, DUMMY, AMaxSize, DUMMY)
        else
          TTBCustomDockableWindowAccess(FToolbar).GetMinMaxSize(DUMMY, AMinSize, DUMMY, AMaxSize);
{$ELSE}
        if ResizeVertical then
          GetMinMaxSize(AMinSize, DUMMY, AMaxSize, DUMMY)
        else
          GetMinMaxSize(DUMMY, AMinSize, DUMMY, AMaxSize);
{$ENDIF}

        if MinSize < AMinSize then MinSize := AMinSize;
        if ((MaxSize > AMaxSize) or (MaxSize = 0))
          and (AMaxSize > 0) then MaxSize := AMaxSize;
      end;
    end;

  ResizeBegin(ResizeKind2SizeHandle(ResizeVertical, ResizeReverese));
  try
    { Before locking, make sure all pending paint messages are processed }
    ProcessPaintMessages;

    if not UseSmoothDrag then
    begin
{$IFNDEF TB2Dock_DisableLock}
      LockWindowUpdate(GetDesktopWindow);
{$ENDIF}
      ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
    end
    else
      ScreenDC := 0;
    try
      SetCapture(Handle);

      {Initialization}
      GetWindowRect(Handle, DragRect);
      if not UseSmoothDrag then
        DrawDraggingOutline(ScreenDC, @DragRect, nil, True, True);
      GetCursorPos(APoint);
      if ResizeVertical then OrigPos := APoint.y
      else OrigPos := APoint.x;
      LastPos := APoint;
      if ResizeVertical then
        OrigSize := Height
      else
        OrigSize := Width;
      NewSize := OrigSize;

      { Stay in message loop until capture is lost. Capture is removed either
        by this procedure manually doing it, or by an outside influence (like
        a message box or menu popping up) }
      while GetCapture = Handle do begin
        case Integer(GetMessage(Msg, 0, 0, 0)) of
          -1: Break; { if GetMessage failed }
          0: begin
              { Repost WM_QUIT messages }
              PostQuitMessage(Msg.WParam);
              Break;
            end;
        end;

        case Msg.Message of
          WM_KEYDOWN, WM_KEYUP:
            { Ignore all keystrokes while in a resize loop except ESCAPE}
            if Msg.wParam = VK_ESCAPE then Break;
          WM_MOUSEMOVE: begin
              APoint := SmallPointToPoint(TSmallPoint(DWORD(GetMessagePos)));
              if (LastPos.X <> APoint.X) or (LastPos.Y <> APoint.Y) then begin
                if ResizeVertical then Pos := APoint.y
                else Pos := APoint.x;
                MouseMoved;
                LastPos := APoint;
              end;
            end;
          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
            { Make sure it doesn't begin another loop }
            Break;
          WM_LBUTTONUP: begin
              Accept := True;
              Break;
            end;
          WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
            { Ignore all other mouse up/down messages }
            ;
        else
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
      end;
    finally
      { Since it sometimes breaks out of the loop without capture being
        released }
      if GetCapture = Handle then
        ReleaseCapture;
      ClipCursor(nil);

      if not UseSmoothDrag then begin
        { Hide dragging outline. Since NT will release a window update lock if
          another thread comes to the foreground, it has to release the DC
          and get a new one for erasing the dragging outline. Otherwise,
          the DrawDraggingOutline appears to have no effect when this happens. }
        ReleaseDC(GetDesktopWindow, ScreenDC);
        ScreenDC := GetDCEx(GetDesktopWindow, 0,
          DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
        DrawDraggingOutline(ScreenDC, nil, @DragRect, True, True);
        ReleaseDC(GetDesktopWindow, ScreenDC);

        { Release window update lock }
{$IFNDEF TB2Dock_DisableLock}
        LockWindowUpdate(0);
{$ENDIF}
      end;
    end;
    if not UseSmoothDrag and Accept then
      DoResize;
  finally
{$IFDEF USE_TB2K}
    ResizeEnd;
{$ELSE}
    ResizeEnd(True);
{$ENDIF}
  end;
end;

function TRMResizeableToolWindow.GetResizeKind(X, Y: Integer): tbResizeKind;
begin
  Result := rkNone;

  if not Assigned(CurrentDock) then Exit;

  if (Y + DockedBorderSize in [0..ResizeBorderSize])
    and (CurrentDock.Position = dpBottom) then Result := rkTop;

  if (ClientAreaHeight - Y in [0..ResizeBorderSize])
    and (CurrentDock.Position <> dpBottom) then Result := rkBottom;

  if (X + DockedBorderSize in [0..ResizeBorderSize])
    and (CurrentDock.Position = dpRight) then Result := rkLeft;

  if (ClientAreaWidth - X in [0..ResizeBorderSize])
    and (CurrentDock.Position <> dpRight) then Result := rkRight;

  // NO resizing because of FULLSIZE
  if FullSize
    and ((Result in [rkLeft, rkRight]) xor (CurrentDock.Position in [dpLeft, dpRight])) then Result := rkNone;
end;

{$IFDEF COMPILER4_UP}

procedure TRMResizeableToolWindow.AdjustClientRect(var Rect: TRect);
var
  DockPos: TRMDockPosition;
begin
  inherited;
  if Assigned(CurrentDock) then
  begin
    DockPos := CurrentDock.Position;
    Dec(Rect.Right, AlignmentBorderSize);
    Dec(Rect.Bottom, AlignmentBorderSize);
    if DockPos = dpBottom then OffsetRect(Rect, 0, AlignmentBorderSize);
    if DockPos = dpRight then OffsetRect(Rect, AlignmentBorderSize, 0);
  end;
end;
{$ENDIF}

procedure TRMResizeableToolWindow.WM__LButtonDown(var Msg: TWMMouse);
begin
  if DockedSizingLoop(Msg.XPos, Msg.YPos) then
    Msg.Result := 0
  else
    inherited;
end;

procedure TRMResizeableToolWindow.WM__NCLButtonDown(var Msg: TWMMouse);
var
  P: TPoint;
begin
  P := ScreenToClient(SmallPointToPoint(Msg.Pos));

  if DockedSizingLoop(P.X, P.Y) then
    Msg.Result := 0
  else
    inherited;
end;

procedure TRMResizeableToolWindow.WM__SetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);

  case GetResizeKind(P.X, P.Y) of
    rkTop, rkBottom: Windows.SetCursor(Screen.Cursors[crVSplit]); // LoadCursor(0, IDC_HSPLIT));
    rkLeft, rkRight: Windows.SetCursor(Screen.Cursors[crHSplit]); // LoadCursor(0, IDC_VSPLIT));
  else inherited;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure RMSaveToolbars(aParentKey: string; t: array of TRMToolbar);
var
  i: Integer;

  procedure SaveToolbarPosition(t: TRMToolbar);
  var
    Ini: TRegIniFile;
    X, Y, lWidth, lHeight: integer;
    lName: string;
  begin
    Ini := TRegIniFile.Create(RMRegRootKey + aParentKey);
    try
      lName := rsToolbar + t.Name;
      Ini.WriteBool(lName, rsVisible, t.Visible);
{$IFDEF USE_TB2K}
      if t.CurrentDock <> nil then
      begin
        X := t.DockPos;
        Y := t.DockRow;
        lWidth := t.Width;
        lHeight := t.Height;
      end
{$ELSE}
      if t.DockedTo <> nil then
      begin
        X := t.DockPos;
        Y := t.DockRow;
        lWidth := t.Width;
        lHeight := t.Height;
      end
{$ENDIF}
      else
      begin
{$IFDEF USE_TB2K}
        X := t.FloatingPosition.x;
        Y := t.FloatingPosition.Y;
{$ELSE}
        X := t.Left;
        Y := t.Top;
{$ENDIF}
        lWidth := t.Width;
        lHeight := t.Height;
      end;
      Ini.WriteInteger(lName, rsX, X);
      Ini.WriteInteger(lName, rsY, Y);
      Ini.WriteInteger(lName, rsWidth, lWidth);
      Ini.WriteInteger(lName, rsHeight, lHeight);
{$IFDEF USE_TB2K}
      if t.CurrentDock <> nil then
      begin
        Ini.WriteString(lName, rsDockName, t.CurrentDock.Name);
        Ini.WriteBool(lName, rsDocked, TRUE);
      end
{$ELSE}
      if t.DockedTo <> nil then
      begin
        Ini.WriteString(lName, rsDockName, t.DockedTo.Name);
        Ini.WriteBool(lName, rsDocked, TRUE);
      end
{$ENDIF}
      else
      begin
        Ini.WriteString(lName, rsDockName, '');
        Ini.WriteBool(lName, rsDocked, FALSE);
      end;
    finally
      Ini.Free;
    end;
  end;

begin
  for i := Low(t) to High(t) do
  begin
    SaveToolbarPosition(t[i]);
    //    t[i].Visible := False;
  end;
end;

procedure RMRestoreToolbars(aParentKey: string; t: array of TRMToolbar);
var
  i: Integer;

  procedure _RestoreToolbarPosition(t: TRMToolbar);
  var
    Ini: TRegIniFile;
    X, Y: Integer;
    DN: string;
    lNewDock: TRMDock;
    lName: string;
    lDNDocked: Boolean;
  begin
    Ini := TRegIniFile.Create(RMRegRootKey + aParentKey);
    try
      lName := rsToolbar + t.Name;
      t.Visible := False;
      X := Ini.ReadInteger(lName, rsX, t.Left);
      Y := Ini.ReadInteger(lName, rsY, t.Top);
      //t.Width := Ini.ReadInteger(lName, rsWidth, t.Width);
      t.Height := Ini.ReadInteger(lName, rsHeight, t.Height);

      lDNDocked := Ini.ReadBool(lName, rsDocked, TRUE);
      if lDNDocked then
      begin
        DN := Ini.ReadString(lName, rsDockName, '');
        if t.Owner <> nil then
        begin
          if t.ParentForm <> nil then
            lNewDock := t.ParentForm.FindComponent(DN) as TRMDock
          else
            lNewDock := t.Parent.FindComponent(DN) as TRMDock;

          if lNewDock <> nil then
          begin
{$IFDEF USE_TB2K}
            t.CurrentDock := lNewDock;
{$ELSE}
            t.DockedTo := lNewDock;
{$ENDIF}
            t.DockPos := X;
            t.DockRow := Y;
          end;
        end;
      end
      else
      begin
{$IFDEF USE_TB2K}
        t.CurrentDock := nil;
{$ELSE}
        t.DockedTo := nil;
{$ENDIF}
{$IFDEF USE_TB2K}
        t.FloatingPosition := Point(X, Y);
        t.Floating := True;
        t.MoveOnScreen(True);
{$ELSE}
        t.Left := X;
        t.Top := Y;
{$ENDIF}
      end;

      t.Visible := Ini.ReadBool(lName, rsVisible, True);
    finally
      Ini.Free;
    end;
  end;

begin
  for i := Low(t) to High(t) do
    _RestoreToolbarPosition(t[i]);
end;

procedure RMSaveToolWinPosition(aParentKey: string; f: TRMToolWin);
var
  Ini: TRegIniFile;
  lName: string;
  X, Y, lWidth, lHeight: integer;
begin
  Ini := TRegIniFile.Create(RMRegRootKey + aParentKey);
  lName := rsForm + f.ClassName;

  Ini.WriteBool(lName, rsVisible, f.Visible);
{$IFDEF USE_TB2K}
  if f.CurrentDock <> nil then
  begin
    X := f.DockPos;
    Y := f.DockRow;
    lWidth := f.ClientAreaWidth;
    lHeight := f.ClientAreaHeight;
  end
{$ELSE}
  if f.DockedTo <> nil then
  begin
    X := f.DockPos;
    Y := f.DockRow;
    lWidth := f.Width;
    lHeight := f.Height;
  end
{$ENDIF}
  else
  begin
{$IFDEF USE_TB2K}
    X := f.FloatingPosition.x;
    Y := f.FloatingPosition.Y;
{$ELSE}
    X := f.Left;
    Y := f.Top;
{$ENDIF}
    lWidth := f.Width;
    lHeight := f.Height;
  end;
  Ini.WriteInteger(lName, rsX, X);
  Ini.WriteInteger(lName, rsY, Y);
  Ini.WriteInteger(lName, rsWidth, lWidth);
  Ini.WriteInteger(lName, rsHeight, lHeight);
{$IFDEF USE_TB2K}
  if f.CurrentDock <> nil then
  begin
    Ini.WriteString(lName, rsDockName, f.CurrentDock.Name);
    Ini.WriteBool(lName, rsDocked, TRUE);
  end
{$ELSE}
  if f.DockedTo <> nil then
  begin
    Ini.WriteString(lName, rsDockName, f.DockedTo.Name);
    Ini.WriteBool(lName, rsDocked, TRUE);
  end
{$ENDIF}
  else
  begin
    Ini.WriteString(lName, rsDockName, '');
    Ini.WriteBool(lName, rsDocked, FALSE);
  end;