grabbar.pas

动态提示控件

  { adjust Top/Left so that window is the minimum allowed size.              }
  if assigned(FWindowA) and (FWindowAMinSize > 0) then begin
    if FStyle = gbHorizontal then begin
      if Top - FWindowA.Top < FWindowAMinSize then
        Top := FWindowAMinSize;
    end  { horizontal }
    else begin
      if Left - FWindowA.Left < FWindowAMinSize then
        Left := FWindowAMinSize
    end;  { vertical }
  end;  { adjust windowA's size as necessary }

  if assigned(FWindowB) and (FWindowBMinSize > 0) then begin
    if FStyle = gbHorizontal then begin
      newSize := FWindowB.Top + FwindowB.Height - (Top + Thickness);
      if newSize < FWindowBMinSize then
        Top := top - (FWindowBMinSize - newSize);
    end  { horizontal }
    else begin { vertical }
      newSize := FWindowB.Left + FWindowB.Width - (Left + Thickness);
      if newSize < FWindowBMinSize then
        Left := left - (FWindowBMinSize - newSize);
    end;  { vertical }
  end;   { adjust Top if WindowB was made too small }

  { end of additions by Beth Weiss }

  if assigned(FWindowA) then
    MoveWindowA;
  if assigned(FWindowB) then
    MoveWindowB;
  { Tell parent it can align controls now if it wants.  We have repositioned }
  { windows and they should not need further moving.                         }
  Parent.EnableAlign;
end;

{ Reset the bar's size to fill the client's width or height. }
procedure TdfsGrabBar.ResizeBar;
var
 PPanel : TPanel;
begin
  if (Parent = NIL) then exit;
  if FStyle = gbHorizontal then
  begin
    if (Parent is TCustomPanel) then
    begin {Respect border widths}
      PPanel := (Parent as TPanel);{Use Panel instead of CustomPanel}
      SetBounds(PPanel.BorderWidth, Top,
                Parent.ClientWidth - 2*PPanel.BorderWidth, Thickness);
    end else
      SetBounds(0, Top, Parent.ClientWidth, Thickness)
  end else begin
    if (Parent is TCustomPanel) then
    begin {Respect border widths}
      PPanel := (Parent as TPanel);{USe Panel instead of CustomPanel}
      SetBounds(Left, PPanel.BorderWidth ,
                Thickness, Parent.ClientHeight - 2*PPanel.BorderWidth);
    end else
      SetBounds(Left, 0, Thickness, Parent.ClientHeight);
  end;
end;

{ The value of the Ctl3D property has changed, invalidate the control so }
{ that it is redrawn to reflect the change.                              }
procedure TdfsGrabBar.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

{ We have been moved.  Make sure we are as wide or tall as the parent. }
procedure TdfsGrabBar.WMMove(var Msg: TWMMove);
begin
  inherited;
  ResizeBar;
end;

{ We have been resized.  Make sure we are as wide or tall as the parent. }
procedure TdfsGrabBar.WMSize(var Msg: TWMSize);
begin
  inherited;
  ResizeBar;
end;

{ BorderStyle property has changed.  Redraw control to reflect change. }
procedure TdfsGrabBar.SetBorderStyle(Value: TBorderStyle);
begin
  if Value = FBorderStyle then exit;
  FBorderStyle := Value;
  RecreateWnd;
end;

{ A Parent has been assigned or changed.  Unhook old parent and install }
{ hook in new parent.                                                   }
procedure TdfsGrabBar.SetParent(Value: TWinControl);
begin
  { UnhookParent knows if the current parent has been hooked or not }
  UnhookParent;
  { Set Parent to the new value }
  inherited SetParent(Value);
  { Hook the new parent's window procedure }
  HookParent;
  { Size ourselves to fill the new parent's client area }
  ResizeBar;
  { Position our windows accordingly }
  MoveWindows;
end;

{ Set whether the bar is horizontal or vertical, setting the cursor }
{ accordingly. }
procedure TdfsGrabBar.SetStyle(Value: TdfsGrabBarStyle);
begin
  if Value = FStyle then exit;
  FStyle := Value;
  if FStyle = gbHorizontal then begin
    Cursor := crVSplit;
    Height := Width;
{    if Parent <> NIL then
      Top := Parent.ClientHeight div 2;}
  end else begin
    Cursor := crHSplit;
    Width := Height;
{    if Parent <> NIL then
      Left := Parent.ClientWidth div 2;}
  end;
  ResizeBar;
end;

{ Return the thickness of the bar, depending on the orientation. }
function TdfsGrabBar.GetThickness: integer;
begin
  if FStyle = gbHorizontal then
    Result := Height
  else
    Result := Width;
end;

{ Set the thickness, depending on the orientation. }
procedure TdfsGrabBar.SetThickness(Value: integer);
begin
  if (Value = Thickness) or (Value < 0) then exit;
  if FStyle = gbHorizontal then
    Height := Value
  else
    Width := Value;
end;

{ Set a window we are responsible for.  Do not allow selection of ourself or }
{ the other window being split.                                              }
procedure TdfsGrabBar.SetWindowA(Value: TWinControl);
begin
  if (Value = FWindowA) or (Value = FWindowB) or (Value = Self) then exit;
  FWindowA := Value;
  { Position it correctly with the bar. }
  MoveWindows;
end;

{ Set a window we are responsible for.  Do not allow selection of ourself or }
{ the other window being split.                                              }
procedure TdfsGrabBar.SetWindowB(Value: TWinControl);
begin
  if (Value = FWindowA) or (Value = FWindowB) or (Value = Self) then exit;
  FWindowB := Value;
  { Position it correctly with the bar. }
  MoveWindows;
end;

procedure TdfsGrabBar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if FBorderStyle = bsSingle then
    Params.Style := Params.Style or WS_BORDER;
end;

procedure TdfsGrabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
var
  FrameBrush: HBRUSH;
begin
  inherited; { Paint rectangle with Color property }
  if Ctl3D then begin
    FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
    try
      FrameRect(Msg.DC, Rect(-1, -1, Width, Height), FrameBrush);
    finally
      DeleteObject(FrameBrush);
    end;
    FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
    try
      FrameRect(Msg.DC, Rect(0, 0, Width+1, Height+1), FrameBrush);
    finally
      DeleteObject(FrameBrush);
    end;
  end;
end;

{ Mouse button has been pressed.  Setup for moving the bar. This is only }
{ called when the application is running, not in design mode.            }
procedure TdfsGrabBar.MouseDown(Button: TMouseButton;
                             Shift: TShiftState; X, Y: Integer);
  function Min(i1, i2: integer): integer;
  begin
    if i1 > i2 then
      Result := i2
    else
      Result := i1;
  end;

  function Max(i1, i2: integer): integer;
  begin
    if i1 < i2 then
      Result := i2
    else
      Result := i1;
  end;
var
  WARect, WBRect,
  ClipRect: TRect;
begin
  inherited MouseDown(Button, Shift, X, Y);
  { If no parent or not left button pressed, no reason to go on }
  if (Parent = NIL) or (Button <> mbLeft) then exit;

(*
  { Get the rectangle of our parent }
  ClipRect := Parent.ClientRect;
  { Convert rectangle to screen coords. Simpler than calling ClientToScreen }
  { twice, once for TopLeft and again for BottomRight                       }
  with Parent.ClientOrigin do OffsetRect(ClipRect, X, Y);
*)

  if WindowA = NIL then
    GetWindowRect(Parent.Handle, WARect)
  else
    GetWindowRect(WindowA.Handle, WARect);

  if WindowB = NIL then
    GetWindowRect(Parent.Handle, WBRect)
  else
    GetWindowRect(WindowB.Handle, WBRect);

  { Remove the minimum sizes from the rectangle }
  if FWindowAMinSize > 0 then begin
    if FStyle = gbHorizontal then { horizontal }
      Inc(WARect.Top, FWindowAMinSize)
    else { vertical }
      Inc(WARect.Left, FWindowAMinSize);
  end;  { adjust windowA's size as necessary }

  if FWindowBMinSize > 0 then begin
    if FStyle = gbHorizontal then { horizontal }
      Dec(WBRect.Bottom, FWindowBMinSize)
    else { vertical }
      Dec(WBRect.Right, FWindowBMinSize);
  end;   { adjust Top if WindowB was made too small }

  with ClipRect do begin
    Left := Min(WARect.Left, WBRect.Left);
    Top := Min(WARect.Top, WBRect.Top);
    Right := Max(WARect.Right, WBRect.Right);
    Bottom := Max(WARect.Bottom, WBRect.Bottom);
  end;

  { Subtract our size from the rectangle }
  if FStyle = gbHorizontal then begin
    Inc(ClipRect.Top, Thickness div 2);
    Dec(ClipRect.Bottom, (Thickness div 2) - 1);
  end else begin
    Inc(ClipRect.Left, Thickness div 2);
    Dec(ClipRect.Right, (Thickness div 2) - 1);
  end;

  { Clip the mouse cursor to the rectangle.  Prevents from moving out of it }
  ClipCursor(@ClipRect);
  FDragging := TRUE;
  LastRect := BoundsRect;
  if not FDragUpdate then { Draw the indicator bar }
    InvertedRect(LastRect, FALSE);
end;

{ The mouse has moved.  Move the indicator bar accordingly. }
procedure TdfsGrabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
begin
  inherited MouseMove(Shift, X, Y);
  if (ssLeft in Shift) and FDragging then begin
    { Convert our client point to our parent's client point }
    R := BarRect(ClientToParent(Point(X,Y)));
    { If the bar is still in the same place as last time, }
    { there's nothing to do                               }
    if EqualRect(R, LastRect) or IsRectEmpty(R) then exit;
    if not FDragUpdate then { Draw the indicator bar }
      InvertedRect(R, TRUE);
    LastRect := R;

    if FDragUpdate then { Update the bar's position.  This updates windows, too}
      if FStyle = gbHorizontal then
        Top := LastRect.Top
      else
        Left := LastRect.Left;
  end;
end;

{ The mouse button has been released, update the position of the }
{ bar and it's windows.                                          }
procedure TdfsGrabBar.MouseUp(Button: TMouseButton;
                           Shift: TShiftState; X, Y: Integer);
var
  OldRect,
  Intersect: TRect;
begin
  inherited MouseUp(Button, Shift, X, Y);
  { Don't do anything if it wasn't the left button. }
  if not ((Button = mbLeft) and FDragging) then exit;

  { Remove the clipping of the mouse cursor }
  ClipCursor(NIL);
  FDragging := FALSE;
  if not IsRectEmpty(LastRect) then begin
    if not FDragUpdate then { Remove the last indicator bar }
      InvertedRect(LastRect, FALSE);
    OldRect := BoundsRect;
    { Update the bar position.  Because SetBounds is overridden, }
    { the other windows will be moved accordingly.               }
    if FStyle = gbHorizontal then
      Top := LastRect.Top
    else
      Left := LastRect.Left;
    if not FDragUpdate then begin
      { If new rect is in old rect, part of inverted rect gets left over. }
      { Invalidate the control and update so it is repainted immediately. }
      IntersectRect(Intersect, LastRect, OldRect);
      if not IsRectEmpty(Intersect) then
        Refresh;
    end;
  end;
  SetRectEmpty(LastRect);
  { Fire the OnMove event if there is one }
  if assigned(FOnMove) then
    FOnMove(Self);
end;

{ We have be notified of a change in the on-form components. If it is one }
{ that we are responsible for, update variables accordingly.              }
procedure TdfsGrabBar.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Operation = opRemove then begin
    if AComponent = FWindowA then
      FWindowA := NIL;
    if AComponent = FWindowB then
      FWindowB := NIL;
  end;
end;

{ Every change to Top, Left, Width and Height come through this procedure.  }
{ The statement: Top := 10; will result in the procedure being called.  By  }
{ overriding it, we can ensure that the windows our repositioned every time }
{ we are moved.                                                             }
procedure TdfsGrabBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  R: TRect;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then begin
    R := Rect(0, 0, Width, Height);
    InvalidateRect(Handle, @R, TRUE);
    Update;
    if not Fsettingbounds then
      try
        FSettingBounds := TRUE;
        MoveWindows;
      finally
        FSettingBounds := FALSE;
      end;
{    MoveWindows;}
  end;
end;

function TdfsGrabBar.GetVersion: string;
begin
  Result := DFS_COMPONENT_VERSION;
end;

procedure TdfsGrabBar.SetVersion(const Val: string);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;

end.