dfssplitter.pas

动态提示控件

      BW), Point(X, Y))) then
    begin
      Result := WinButton[i];
      break;
    end;
end;

function TdfsSplitter.ButtonHitTest(X, Y: integer): boolean;
begin
  // We use FLastKnownButtonRect here so that we don't have to recalculate the
  // button rect with GetButtonRect every time the mouse moved.  That would be
  // EXTREMELY inefficient.
  Result := PtInRect(FLastKnownButtonRect, Point(X, Y));
  if Align in [alLeft, alRight] then
  begin
    if (not AllowDrag) or ((Y >= FLastKnownButtonRect.Top) and
      (Y <= FLastKnownButtonRect.Bottom)) then
      Cursor := FButtonCursor
    else
      Cursor := crHSplit;
  end else begin
    if (not AllowDrag) or ((X >= FLastKnownButtonRect.Left) and
      (X <= FLastKnownButtonRect.Right)) then
      Cursor := FButtonCursor
    else
      Cursor := crVSplit;
  end;
end;

procedure TdfsSplitter.DoMaximize;
begin
  if assigned(FOnMaximize) then
    FOnMaximize(Self);
end;


procedure TdfsSplitter.DoRestore;
begin
  if assigned(FOnRestore) then
    FOnRestore(Self);
end;

//DoClose

procedure TdfsSplitter.SetMaximized(const Value: boolean);
begin
  if Value <> FMaximized then
  begin

    if csLoading in ComponentState then
    begin
      FMaximized := Value;
      exit;
    end;

    FindControl;
    if FControl = NIL then
      exit;

    if Value then
    begin
      if FMinimized then
        FMinimized := FALSE
      else
      begin
        case Align of
          alLeft,
          alRight:  FRestorePos := FControl.Width;
          alTop,
          alBottom: FRestorePos := FControl.Height;
        else
          exit;
        end;
      end;
      if ButtonStyle = bsNetscape then
        UpdateControlSize(-3000)
      else
        case Align of
          alLeft,
          alBottom: UpdateControlSize(3000);
          alRight,
          alTop: UpdateControlSize(-3000);
        else
          exit;
        end;
      FMaximized := Value;
      DoMaximize;
    end
    else
    begin
      UpdateControlSize(FRestorePos);
      FMaximized := Value;
      DoRestore;
    end;
  end;
end;

procedure TdfsSplitter.SetMinimized(const Value: boolean);
begin
  if Value <> FMinimized then
  begin

    if csLoading in ComponentState then
    begin
      FMinimized := Value;
      exit;
    end;

    FindControl;
    if FControl = NIL then
      exit;

    if Value then
    begin
      if FMaximized then
        FMaximized := FALSE
      else
      begin
        case Align of
          alLeft,
          alRight:  FRestorePos := FControl.Width;
          alTop,
          alBottom: FRestorePos := FControl.Height;
        else
          exit;
        end;
      end;
      FMinimized := Value;
      // Just use something insanely large to get it to move to the other extreme
      case Align of
        alLeft,
        alBottom: UpdateControlSize(-3000);
        alRight,
        alTop: UpdateControlSize(3000);
      else
        exit;
      end;
      DoMinimize;
    end
    else
    begin
      FMinimized := Value;
      UpdateControlSize(FRestorePos);
      DoRestore;
    end;
  end;
end;

function TdfsSplitter.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

procedure TdfsSplitter.SetAlign(Value: TAlign);
begin
  inherited Align := Value;

  Invalidate; // Direction changing, redraw arrows.
  {$IFNDEF DFS_COMPILER_4_UP}
  // D4 does this already
  if (Cursor <> crVSplit) and (Cursor <> crHSplit) then Exit;
  if Align in [alBottom, alTop] then
    Cursor := crVSplit
  else
    Cursor := crHSplit;
  {$ENDIF}
end;


procedure TdfsSplitter.FindControl;
var
  P: TPoint;
  I: Integer;
  R: TRect;
begin
  if Parent = NIL then
    exit;
  FControl := NIL;
  P := Point(Left, Top);
  case Align of
    alLeft: Dec(P.X);
    alRight: Inc(P.X, Width);
    alTop: Dec(P.Y);
    alBottom: Inc(P.Y, Height);
  else
    Exit;
  end;
  for I := 0 to Parent.ControlCount - 1 do
  begin
    FControl := Parent.Controls[I];
    if FControl.Visible and FControl.Enabled then
    begin
      R := FControl.BoundsRect;
      if (R.Right - R.Left) = 0 then
        Dec(R.Left);
      if (R.Bottom - R.Top) = 0 then
        Dec(R.Top);
      if PtInRect(R, P) then
        Exit;
    end;
  end;
  FControl := NIL;
end;


procedure TdfsSplitter.UpdateControlSize(NewSize: integer);
  procedure MoveViaMouse(FromPos, ToPos: integer; Horizontal: boolean);
  begin
    if Horizontal then
    begin
      MouseDown(mbLeft, [ssLeft], FromPos, 0);
      MouseMove([ssLeft], ToPos, 0);
      MouseUp(mbLeft, [ssLeft], ToPos, 0);
    end
    else
    begin
      MouseDown(mbLeft, [ssLeft], 0, FromPos);
      MouseMove([ssLeft], 0, ToPos);
      MouseUp(mbLeft, [ssLeft], 0, ToPos);
    end;
  end;
begin
  if (FControl <> NIL) then
  begin
    { You'd think that using FControl directly would be the way to change it's
      position (and thus the splitter's position), wouldn't you?  But, TSplitter
      has this nutty idea that the only way a control's size will change is if
      the mouse moves the splitter.  If you size the control manually, the
      splitter has an internal variable (FOldSize) that will not get updated.
      Because of this, if you try to then move the newly positioned splitter
      back to the old position, it won't go there (NewSize <> OldSize must be
      true).  Now, what are the odds that the user will move the splitter back
      to the exact same pixel it used to be on?  Normally, extremely low.  But,
      if the splitter has been restored from it's minimized position, it then
      becomes quite likely:  i.e. they drag it back all the way to the min
      position.  What a pain. }
    case Align of
      alLeft: MoveViaMouse(Left, FControl.Left + NewSize, TRUE);
              // alLeft: FControl.Width := NewSize;
      alTop: MoveViaMouse(Top, FControl.Top + NewSize, FALSE);
             // FControl.Height := NewSize;
      alRight: MoveViaMouse(Left, (FControl.Left + FControl.Width - Width) - NewSize, TRUE);
        {begin
          Parent.DisableAlign;
          try
            FControl.Left := FControl.Left + (FControl.Width - NewSize);
            FControl.Width := NewSize;
          finally
            Parent.EnableAlign;
          end;
        end;}
      alBottom: MoveViaMouse(Top, (FControl.Top + FControl.Height - Height) - NewSize, FALSE);
        {begin
          Parent.DisableAlign;
          try
            FControl.Top := FControl.Top + (FControl.Height - NewSize);
            FControl.Height := NewSize;
          finally
            Parent.EnableAlign;
          end;
        end;}
    end;
    Update;
  end;
end;

procedure TdfsSplitter.SetArrowColor(const Value: TColor);
begin
  if FArrowColor <> Value then
  begin
    FArrowColor := Value;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

procedure TdfsSplitter.SetButtonColor(const Value: TColor);
begin
  if FButtonColor <> Value then
  begin
    FButtonColor := Value;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

procedure TdfsSplitter.SetButtonHighlightColor(const Value: TColor);
begin
  if FButtonHighlightColor <> Value then
  begin
    FButtonHighlightColor := Value;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

procedure TdfsSplitter.SetAutoHighlightColor(const Value: boolean);
begin
  if FAutoHighLightColor <> Value then
  begin
    FAutoHighLightColor := Value;
    if FAutoHighLightColor then
      FButtonHighLightColor := GrabBarColor
    else
      FButtonHighLightColor := DEF_BUTTON_HIGHLIGHT_COLOR;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

procedure TdfsSplitter.SetTextureColor1(const Value: TColor);
begin
  if FTextureColor1 <> Value then
  begin
    FTextureColor1 := Value;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

procedure TdfsSplitter.SetTextureColor2(const Value: TColor);
begin
  if FTextureColor2 <> Value then
  begin
    FTextureColor2 := Value;
    if (ButtonStyle = bsNetscape) and ShowButton then
      Invalidate;
  end;
end;

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

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


procedure TdfsSplitter.Loaded;
begin
  inherited Loaded;
  if FRestorePos = -1 then
  begin
    FindControl;
    if FControl <> NIL then
      case Align of
        alLeft,
        alRight:  FRestorePos := FControl.Width;
        alTop,
        alBottom: FRestorePos := FControl.Height;
      end;
  end;
{  if FMaximized then
  begin
    FMaximized := FALSE;
    Maximized := TRUE;
  end
  else
  if FMinimized then
  begin
    FMinimized := FALSE;
    Minimized := TRUE;
  end;}
end;

procedure TdfsSplitter.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if FRestorePos < 0 then
  begin
    FindControl;
    if FControl <> NIL then
      case Align of
        alLeft,
        alRight:  FRestorePos := FControl.Width;
        alTop,
        alBottom: FRestorePos := FControl.Height;
      end;
  end;
end;

procedure TdfsSplitter.SetAllowDrag(const Value: boolean);
var
  Pt: TPoint;
begin
  if FAllowDrag <> Value then
  begin
    FAllowDrag := Value;
    // Have to reset cursor in case it's on the splitter at the moment
    GetCursorPos(Pt);
    Pt := ScreenToClient(Pt);
    ButtonHitTest(Pt.x, Pt.y);
  end;
end;

function TdfsSplitter.VisibleWinButtons: integer;
var
  x: TdfsWindowsButton;
begin
  Result := 0;
  for x := Low(TdfsWindowsButton) to High(TdfsWindowsButton) do
    if x in WindowsButtons then
      inc(Result);
end;

procedure TdfsSplitter.SetButtonStyle(const Value: TdfsButtonStyle);
begin
  FButtonStyle := Value;
  if ShowButton then
    Invalidate;
end;

procedure TdfsSplitter.SetWindowsButtons(const Value: TdfsWindowsButtons);
begin
  FWindowsButtons := Value;
  if (ButtonStyle = bsWindows) and ShowButton then
    Invalidate;
end;

procedure TdfsSplitter.DoMinimize;
begin
  if assigned(FOnMinimize) then
    FOnMinimize(Self);
end;

procedure TdfsSplitter.DoClose;
begin
  if Assigned(FOnClose) then
    FOnClose(Self);
end;

procedure TdfsSplitter.SetButtonCursor(const Value: TCursor);
begin
  FButtonCursor := Value;
end;

procedure TdfsSplitter.LoadOtherProperties(Reader: TReader);
begin
  RestorePos := Reader.ReadInteger;
end;


procedure TdfsSplitter.StoreOtherProperties(Writer: TWriter);
begin
  Writer.WriteInteger(RestorePos);
end;

procedure TdfsSplitter.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('RestorePos', LoadOtherProperties, StoreOtherProperties,
    Minimized or Maximized);
end;

end.