Delphi:滑动(动画)面板

发布于 2024-12-02 13:00:21 字数 283 浏览 2 评论 0原文

Delphi 有滑动(动画)面板组件吗?

例如,它可以在 Raize Components 中找到(左侧面板带有“热点”或隐藏/显示按钮)。

我不需要可调整大小的面板,而是可以从左向右水平平滑滑动的面板+具有隐藏/显示按钮的面板(如果没有该按钮,这没什么大不了的)。

谢谢!

Is there a sliding (animated) panel component for Delphi?

For instance it can be found in Raize Components (a left panel with a "Hot Spot" or hide/show button).

I need not a resizeable panel but a panel that can slide horizontally and smoothly from the left to the right + that has a hide/show button (it's not a big deal if without that button).

Thanks!

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(5

老街孤人 2024-12-09 13:00:21

尝试 NLDSideBar,这是我自己编写的一个容器组件,可折叠并沿其左侧或右侧对齐父母。

界面:

property Align: TSideBarAlign default alLeft;
property AutoHide: Boolean default False;
property Hint: String;
property MinWidth: Integer default DefWidth;
property OnAutoHideChanged: TNotifyEvent;
property OnHide: TNotifyEvent;
property PinButtonDownHint: String;
property PinButtonUpHint: String;
property PinButtonVisible: Boolean default True;
property Resizable: Boolean default True;
property SideButtonWidth: Integer default DefSideButtonWidth;
property Caption;
property Color default clBtnFace;
property Font;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property TabOrder;
property TabStop;

NLDSideBar

或者 这个旧版本是动画的。免费使用,免费修改。

抱歉自我推销,但我认为这是对问题的回答。

Try NLDSideBar, a container component written by myself that is collapsable and aligned along the left or right side of its parent.

Interface:

property Align: TSideBarAlign default alLeft;
property AutoHide: Boolean default False;
property Hint: String;
property MinWidth: Integer default DefWidth;
property OnAutoHideChanged: TNotifyEvent;
property OnHide: TNotifyEvent;
property PinButtonDownHint: String;
property PinButtonUpHint: String;
property PinButtonVisible: Boolean default True;
property Resizable: Boolean default True;
property SideButtonWidth: Integer default DefSideButtonWidth;
property Caption;
property Color default clBtnFace;
property Font;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property TabOrder;
property TabStop;

NLDSideBar

Or maybe this older version which is animated. Free to use, free to modify.

Sorry for being self-promotive, but I think it's an answer to the question.

习惯成性 2024-12-09 13:00:21

我们最终建立了自己的控件。我们找不到任何能完全按照我们想要的方式工作的东西。结果并没有那么难。我确信有些情况我们没有正确处理,但因此这对我们来说很有用。

下面的代码使用 cxGroupBox,因为我们需要该外观与应用程序的其余部分相匹配。可以将其切换为普通的 GroupBox。

我们在两个地方使用它。在一种情况下,我们在标准 Delphi Flow Panel 内有许多这样的面板(我不确定添加的是哪个版本)。当我们的 DynPanel 折叠时,所有内容都会自动向上移动并填充空间。

在另一种情况下,我们有一个分为主要部分和工具箱的窗口。两者由标准分离器隔开。主窗口设置为与客户端对齐。当我们的面板折叠或展开时。分割器自动移动并扩展主部分。

我们从未完全让“容器”控制内容发挥作用,因此您添加到面板的项目可以移出您通常在组框中期望的范围。但这不会给我们带来任何大问题,所以我们就离开了。这也没有考虑到与按钮大小相关的 DPI 变化。标题会变大,但按钮不会变大。


unit DynPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, cxGroupBox;

const
  DEFAULTBUTTONWIDTH = 16;
  DEFAULTWIDTH  = 161;
  DEFAULTHEIGHT = 81;
  cButtonPadding = 8;
  cCollapsePadding = 3;
  cCaptionPadding = '       ';
  cCollapsedSize = DEFAULTBUTTONWIDTH + cCollapsePadding;
  cAutoCollapseSize = DEFAULTBUTTONWIDTH + cButtonPadding;

type
  TCollapseDirection = (cdUp, cdRight, cdLeft);

  TMinDemension = cAutoCollapseSize..High(Integer);

  TDynPanel = class(TPanel)
  private
    FGroupBox: TcxGroupBox;
    FButtonPanel: TPanel;
    FButtonImage: TImage;

    FExpand: Boolean;
    FOldHeight: Integer;
    FOldWidth: Integer;
    FCollapseDirection: TCollapseDirection;
    FOrigGroupBoxCaption: String;
    FAutoCollapseHeight: TMinDemension;
    FAutoCollapseWidth: TMinDemension;

    FButtonPadding: integer;
    FCollapsePadding: integer;
    FCollapsedSize: integer;

    procedure SetExpand(Value: Boolean);
    procedure SetGroupBoxCaption(Value: string);
    procedure ButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure EnableControls(Value: Boolean);
    procedure SetCollapseDirection(Value: TCollapseDirection);
    procedure ConfigurePanel;
    procedure SetMinHeight(Value: TMinDemension);
    procedure SetMinWidth(Value: TMinDemension);
    procedure UpdateImage();

  protected
    procedure Resize; override;
    procedure ChangeScale(M, D: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property OldHeight: Integer read FOldHeight write FOldHeight;
    property OldWidth: Integer read FOldWidth write FOldWidth;
    property GroupBox: TcxGroupBox read FGroupBox;
  published
    property Caption: string read FOrigGroupBoxCaption write SetGroupBoxCaption;
    property Expand: Boolean read FExpand write SetExpand;
    property BevelOuter default bvNone;
    property CollapseDirection: TCollapseDirection read FCollapseDirection write SetCollapseDirection default cdUp;
    property AutoCollapseHeight: TMinDemension read FAutoCollapseHeight write SetMinHeight default cAutoCollapseSize;
    property AutoCollapseWidth: TMinDemension read FAutoCollapseWidth write SetMinWidth default cAutoCollapseSize;
  end;

procedure Register;

implementation

{$R 'ButtonImages\ButtonImages.res' 'ButtonImages\ButtonImages.rc'}

uses cxEdit;

procedure Register;
begin
  RegisterComponents('AgWare', [TDynPanel]);
end;


{ TDynPanel }

{
  TDynPanel.Create
  ---------------------------------------------------------------------------
}
constructor TDynPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Self.ControlStyle := ControlStyle - [csSetCaption];

  Self.Width := DEFAULTWIDTH;
  Self.Height := DEFAULTHEIGHT;
  BevelOuter := bvNone;

  FExpand := True;
  FOldHeight := Self.Height;
  FOldWidth := Self.Width;
  FOrigGroupBoxCaption := 'AgDynPanel';
  FCollapseDirection := cdUp;
  FAutoCollapseHeight := cAutoCollapseSize;
  FAutoCollapseWidth := cAutoCollapseSize;

  FGroupBox := TcxGroupBox.Create(Self);
  FGroupBox.Parent := Self;
  FGroupBox.Align := alClient;
  FGroupBox.Alignment := alTopLeft;

  FButtonPanel := TPanel.Create(Self);
  FButtonPanel.Parent := Self;
  FButtonPanel.Top := 0;
  FButtonPanel.Width := DEFAULTBUTTONWIDTH;
  FButtonPanel.Height := DEFAULTBUTTONWIDTH;
  FButtonPanel.Left := Width - DEFAULTBUTTONWIDTH - FButtonPadding;
  FButtonPanel.OnMouseDown := ButtonMouseDown;

  FButtonImage := TImage.Create(Self);
  FButtonImage.Parent := FButtonPanel;
  FButtonImage.Align := alClient;
  FButtonImage.Stretch := false;
  FButtonImage.Center := true;
  FButtonImage.OnMouseDown := ButtonMouseDown;

  UpdateImage;

  // The click should also work for the entire top of the group box.
  FGroupBox.OnMouseDown := ButtonMouseDown;

  FGroupBox.Caption := FOrigGroupBoxCaption;
  FGroupBox.Style.Font.Style := FGroupBox.Style.Font.Style + [fsBold];

  FButtonPadding := cButtonPadding;
  FCollapsePadding := cCollapsePadding;
  FCollapsedSize := cCollapsedSize;

end;

{
  TDynPanel.SetGroupBoxCaption
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetGroupBoxCaption(Value: String);
begin
  FOrigGroupBoxCaption := Value;
  ConfigurePanel;
end;

{
  TDynPanel.SetMinHeight
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetMinHeight(Value: TMinDemension);
begin
  if Value = FAutoCollapseHeight then
    Exit; // >>----->

  FAutoCollapseHeight := Value;

  if Showing then
    Resize;
end;

{
  TDynPanel.SetMinWidth
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetMinWidth(Value: TMinDemension);
begin
  if Value = FAutoCollapseWidth then
    Exit; // >>----->

  FAutoCollapseWidth := Value;

  if Showing then
    Resize;
end;

{
  TDynPanel.ButtonMouseDown
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button  mbLeft then
    Exit; // >>----->

  if ((FExpand = True) and (Y  FCollapsePadding)) or
     ((FExpand = False) and (FCollapseDirection = cdLeft) and (X >----->

  FExpand := Value;

  //ConfigurePanel;

  //--------------------------------------------------------------------------
  // Set the group box size
  //--------------------------------------------------------------------------
  //
  // I chose to do the resizing of the control here rather than in
  // ConfigurePanel because if you do it there the SetBounds will call ReSize
  // which will call ConfigurePanel again so that you would need to keep track
  // of a boolean variable to determine if you are making recursive calls into
  // ConfigurePanel. That is one reason. Another is that when the dfm values
  // are streamed in and the properties get set you will resize the control
  // before the actual Height and Width properties are set. This will cause
  // bogus default values to be stored for FOldHeight and FOldWidth and when
  // the control is displayed the dimensions will be wrong. If you size the
  // control here then, on creation, Resize will not get called and the
  // FOldHeight and FOldWidth values will not get saved off until
  // CMShowingChanged will explicitly call ReSize after the dimensions are
  // properly set. If you move this code into ConfigurePanel then when the
  // caption is streamed in and set from the dfm then ConfigurePanel would get
  // called, we would SetBounds there and then Resize would fire storing off the
  // default invalid values for the FOld variables as mentioned above.
  // Hope this makes sense. Leave the SetBounds calls here and make your life
  // easier. :)
  //--------------------------------------------------------------------------

  // Changing to Expanded
  if FExpand = True then
  begin
    // Up
    if FCollapseDirection = cdUp then
      SetBounds(Left, Top, Width, FOldHeight)
    // Right
    else if FCollapseDirection = cdRight then
      SetBounds((Left + Width) - FOldWidth, Top, FOldWidth, Height)
    // Left
    else if FCollapseDirection = cdLeft then
      SetBounds(Left, Top, FOldWidth, Height);
  end
  // Changing to Collapsed
  else
  begin
    // Up
    if FCollapseDirection = cdUp then
    begin
      // Reset the AutoCollapseHeight just to make sure we don't try to
      // recollapse on resize.
      if FAutoCollapseHeight  FGroupBox) and
       (Self.Controls[i]  FButtonPanel) then
    begin
      Self.Controls[i].Enabled := Value;
      Self.Controls[i].Visible := Value;
    end;
  end;
end;

{
  TDynPanel.CMShowingChanged
  ---------------------------------------------------------------------------
}
procedure TDynPanel.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Showing then
    Resize;
end;

{
  TDynPanel.Resize
  ---------------------------------------------------------------------------
}
procedure TDynPanel.Resize;
begin

  if FExpand = True then
  begin
    if (FCollapseDirection = cdUp) and (Height  FAutoCollapseHeight then
      begin
        FOldHeight := Height;
        Expand := True;
      end
      else
        Height := FCollapsedSize;
    end
    else if (FCollapseDirection = cdLeft) or (FCollapseDirection = cdRight) then
    begin
      if (Width > FAutoCollapseWidth) then
      begin
        FOldWidth := Width;
        Expand := True;
      end
      else
        Width := FCollapsedSize;
    end;
  end;

  ConfigurePanel;

end;


{
  TDynPanel.ChangeScale
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ChangeScale(M, D: Integer);
begin

  FAutoCollapseHeight := MulDiv(FAutoCollapseHeight, M, D);
  FAutoCollapseWidth := MulDiv(FAutoCollapseWidth, M, D);

  FButtonPadding := MulDiv(FButtonPadding, M, D);
  FCollapsePadding := MulDiv(FCollapsePadding, M, D);
  FCollapsedSize := MulDiv(FCollapsedSize, M, D);


  FOldHeight := MulDiv(FOldHeight, M, D);
  FOldWidth := MulDiv(FOldWidth, M, D);

  // inherited will cause resize to be called.  I need to update
  // my internal values before that happens, otherwise I will resize based
  // on the old values.
  inherited;

end;

{
  TDynPanel.SetCollapseDirection
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetCollapseDirection(Value: TCollapseDirection);
begin
  if Value = FCollapseDirection then
    Exit; // >>----->

  FCollapseDirection := Value;

  ConfigurePanel;
end;

{
  TDynPanel.ConfigurePanel
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ConfigurePanel;
begin
  //--------------------------------------------------------------------------
  // Set the group box style, caption alignment, caption, button position, and
  // button image
  //--------------------------------------------------------------------------

  // Changing to Expanded
  if FExpand = True then
  begin
    FGroupBox.Style.Color := clWhite;
    // Up
    if FCollapseDirection = cdUp then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end
    // Right
    else if FCollapseDirection = cdRight then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := '       ' + FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := FButtonPadding;
    end
    // Left
    else if FCollapseDirection = cdLeft then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end;
  end
  // Changing to Collapsed
  else
  begin
    FGroupBox.Style.Color := clGradientActiveCaption;
    // Up
    if FCollapseDirection = cdUp then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end
    // Right
    else if FCollapseDirection = cdRight then
    begin
      FGroupBox.Alignment := alRightTop;
      FGroupBox.Caption := '       ' + FOrigGroupBoxCaption;
      FButtonPanel.Top := FButtonPadding;
      FButtonPanel.Left := FCollapsePadding;
    end
    // Left
    else if FCollapseDirection = cdLeft then
    begin
      FGroupBox.Alignment := alLeftTop;
      FGroupBox.Caption := FOrigGroupBoxCaption + '       ';
      FButtonPanel.Top := FButtonPadding;
      FButtonPanel.Left := 0;
    end;
  end;

  UpdateImage;
  // Now draw the button and invalidate Self
  Self.Invalidate;
end;

{
  TDynPanel.UpdateImage
  ---------------------------------------------------------------------------
}
procedure TDynPanel.UpdateImage();
begin
  case FCollapseDirection of
    cdUp:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageUp')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageDown');
      end;
    cdLeft:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageLeft')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageRight');
      end;
    cdRight:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageRight')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageLeft');
      end;
  end;

end;

end.

靠近左侧
左开 左关闭

接近顶部
顶部打开


We ended up building our own control. We could not find anything that worked quite how we wanted. It ended up not being that hard. I'm sure there are situations we are not handling correctly, but so for this is working good for us.

The code below is using cxGroupBox because we needed that look to match the rest of our application. That can be switched out for a normal GroupBox.

We are using this in two places. In one case we have a number of these panels inside a standard Delphi Flow Panel (I'm not sure what version that was added). When our DynPanel collapses everything automatically moves up and fills the space.

In the other case we have a window that is split between a main section and a toolbox. The two are separated by a standard splitter. The main window is set to align to client. When our panel collapses or expands. the splitter automatically moves and expands the main section.

We never did quite get the "container" control stuff to work so items you add to the panel can be moved outside the bounds you would normally expect in a group box. But that does not cause us any major problems so we just left it. This also does not account for DPI changes in relation to the button size. The caption will get bigger but the button will not.


unit DynPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, cxGroupBox;

const
  DEFAULTBUTTONWIDTH = 16;
  DEFAULTWIDTH  = 161;
  DEFAULTHEIGHT = 81;
  cButtonPadding = 8;
  cCollapsePadding = 3;
  cCaptionPadding = '       ';
  cCollapsedSize = DEFAULTBUTTONWIDTH + cCollapsePadding;
  cAutoCollapseSize = DEFAULTBUTTONWIDTH + cButtonPadding;

type
  TCollapseDirection = (cdUp, cdRight, cdLeft);

  TMinDemension = cAutoCollapseSize..High(Integer);

  TDynPanel = class(TPanel)
  private
    FGroupBox: TcxGroupBox;
    FButtonPanel: TPanel;
    FButtonImage: TImage;

    FExpand: Boolean;
    FOldHeight: Integer;
    FOldWidth: Integer;
    FCollapseDirection: TCollapseDirection;
    FOrigGroupBoxCaption: String;
    FAutoCollapseHeight: TMinDemension;
    FAutoCollapseWidth: TMinDemension;

    FButtonPadding: integer;
    FCollapsePadding: integer;
    FCollapsedSize: integer;

    procedure SetExpand(Value: Boolean);
    procedure SetGroupBoxCaption(Value: string);
    procedure ButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure EnableControls(Value: Boolean);
    procedure SetCollapseDirection(Value: TCollapseDirection);
    procedure ConfigurePanel;
    procedure SetMinHeight(Value: TMinDemension);
    procedure SetMinWidth(Value: TMinDemension);
    procedure UpdateImage();

  protected
    procedure Resize; override;
    procedure ChangeScale(M, D: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property OldHeight: Integer read FOldHeight write FOldHeight;
    property OldWidth: Integer read FOldWidth write FOldWidth;
    property GroupBox: TcxGroupBox read FGroupBox;
  published
    property Caption: string read FOrigGroupBoxCaption write SetGroupBoxCaption;
    property Expand: Boolean read FExpand write SetExpand;
    property BevelOuter default bvNone;
    property CollapseDirection: TCollapseDirection read FCollapseDirection write SetCollapseDirection default cdUp;
    property AutoCollapseHeight: TMinDemension read FAutoCollapseHeight write SetMinHeight default cAutoCollapseSize;
    property AutoCollapseWidth: TMinDemension read FAutoCollapseWidth write SetMinWidth default cAutoCollapseSize;
  end;

procedure Register;

implementation

{$R 'ButtonImages\ButtonImages.res' 'ButtonImages\ButtonImages.rc'}

uses cxEdit;

procedure Register;
begin
  RegisterComponents('AgWare', [TDynPanel]);
end;


{ TDynPanel }

{
  TDynPanel.Create
  ---------------------------------------------------------------------------
}
constructor TDynPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Self.ControlStyle := ControlStyle - [csSetCaption];

  Self.Width := DEFAULTWIDTH;
  Self.Height := DEFAULTHEIGHT;
  BevelOuter := bvNone;

  FExpand := True;
  FOldHeight := Self.Height;
  FOldWidth := Self.Width;
  FOrigGroupBoxCaption := 'AgDynPanel';
  FCollapseDirection := cdUp;
  FAutoCollapseHeight := cAutoCollapseSize;
  FAutoCollapseWidth := cAutoCollapseSize;

  FGroupBox := TcxGroupBox.Create(Self);
  FGroupBox.Parent := Self;
  FGroupBox.Align := alClient;
  FGroupBox.Alignment := alTopLeft;

  FButtonPanel := TPanel.Create(Self);
  FButtonPanel.Parent := Self;
  FButtonPanel.Top := 0;
  FButtonPanel.Width := DEFAULTBUTTONWIDTH;
  FButtonPanel.Height := DEFAULTBUTTONWIDTH;
  FButtonPanel.Left := Width - DEFAULTBUTTONWIDTH - FButtonPadding;
  FButtonPanel.OnMouseDown := ButtonMouseDown;

  FButtonImage := TImage.Create(Self);
  FButtonImage.Parent := FButtonPanel;
  FButtonImage.Align := alClient;
  FButtonImage.Stretch := false;
  FButtonImage.Center := true;
  FButtonImage.OnMouseDown := ButtonMouseDown;

  UpdateImage;

  // The click should also work for the entire top of the group box.
  FGroupBox.OnMouseDown := ButtonMouseDown;

  FGroupBox.Caption := FOrigGroupBoxCaption;
  FGroupBox.Style.Font.Style := FGroupBox.Style.Font.Style + [fsBold];

  FButtonPadding := cButtonPadding;
  FCollapsePadding := cCollapsePadding;
  FCollapsedSize := cCollapsedSize;

end;

{
  TDynPanel.SetGroupBoxCaption
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetGroupBoxCaption(Value: String);
begin
  FOrigGroupBoxCaption := Value;
  ConfigurePanel;
end;

{
  TDynPanel.SetMinHeight
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetMinHeight(Value: TMinDemension);
begin
  if Value = FAutoCollapseHeight then
    Exit; // >>----->

  FAutoCollapseHeight := Value;

  if Showing then
    Resize;
end;

{
  TDynPanel.SetMinWidth
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetMinWidth(Value: TMinDemension);
begin
  if Value = FAutoCollapseWidth then
    Exit; // >>----->

  FAutoCollapseWidth := Value;

  if Showing then
    Resize;
end;

{
  TDynPanel.ButtonMouseDown
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button  mbLeft then
    Exit; // >>----->

  if ((FExpand = True) and (Y  FCollapsePadding)) or
     ((FExpand = False) and (FCollapseDirection = cdLeft) and (X >----->

  FExpand := Value;

  //ConfigurePanel;

  //--------------------------------------------------------------------------
  // Set the group box size
  //--------------------------------------------------------------------------
  //
  // I chose to do the resizing of the control here rather than in
  // ConfigurePanel because if you do it there the SetBounds will call ReSize
  // which will call ConfigurePanel again so that you would need to keep track
  // of a boolean variable to determine if you are making recursive calls into
  // ConfigurePanel. That is one reason. Another is that when the dfm values
  // are streamed in and the properties get set you will resize the control
  // before the actual Height and Width properties are set. This will cause
  // bogus default values to be stored for FOldHeight and FOldWidth and when
  // the control is displayed the dimensions will be wrong. If you size the
  // control here then, on creation, Resize will not get called and the
  // FOldHeight and FOldWidth values will not get saved off until
  // CMShowingChanged will explicitly call ReSize after the dimensions are
  // properly set. If you move this code into ConfigurePanel then when the
  // caption is streamed in and set from the dfm then ConfigurePanel would get
  // called, we would SetBounds there and then Resize would fire storing off the
  // default invalid values for the FOld variables as mentioned above.
  // Hope this makes sense. Leave the SetBounds calls here and make your life
  // easier. :)
  //--------------------------------------------------------------------------

  // Changing to Expanded
  if FExpand = True then
  begin
    // Up
    if FCollapseDirection = cdUp then
      SetBounds(Left, Top, Width, FOldHeight)
    // Right
    else if FCollapseDirection = cdRight then
      SetBounds((Left + Width) - FOldWidth, Top, FOldWidth, Height)
    // Left
    else if FCollapseDirection = cdLeft then
      SetBounds(Left, Top, FOldWidth, Height);
  end
  // Changing to Collapsed
  else
  begin
    // Up
    if FCollapseDirection = cdUp then
    begin
      // Reset the AutoCollapseHeight just to make sure we don't try to
      // recollapse on resize.
      if FAutoCollapseHeight  FGroupBox) and
       (Self.Controls[i]  FButtonPanel) then
    begin
      Self.Controls[i].Enabled := Value;
      Self.Controls[i].Visible := Value;
    end;
  end;
end;

{
  TDynPanel.CMShowingChanged
  ---------------------------------------------------------------------------
}
procedure TDynPanel.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Showing then
    Resize;
end;

{
  TDynPanel.Resize
  ---------------------------------------------------------------------------
}
procedure TDynPanel.Resize;
begin

  if FExpand = True then
  begin
    if (FCollapseDirection = cdUp) and (Height  FAutoCollapseHeight then
      begin
        FOldHeight := Height;
        Expand := True;
      end
      else
        Height := FCollapsedSize;
    end
    else if (FCollapseDirection = cdLeft) or (FCollapseDirection = cdRight) then
    begin
      if (Width > FAutoCollapseWidth) then
      begin
        FOldWidth := Width;
        Expand := True;
      end
      else
        Width := FCollapsedSize;
    end;
  end;

  ConfigurePanel;

end;


{
  TDynPanel.ChangeScale
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ChangeScale(M, D: Integer);
begin

  FAutoCollapseHeight := MulDiv(FAutoCollapseHeight, M, D);
  FAutoCollapseWidth := MulDiv(FAutoCollapseWidth, M, D);

  FButtonPadding := MulDiv(FButtonPadding, M, D);
  FCollapsePadding := MulDiv(FCollapsePadding, M, D);
  FCollapsedSize := MulDiv(FCollapsedSize, M, D);


  FOldHeight := MulDiv(FOldHeight, M, D);
  FOldWidth := MulDiv(FOldWidth, M, D);

  // inherited will cause resize to be called.  I need to update
  // my internal values before that happens, otherwise I will resize based
  // on the old values.
  inherited;

end;

{
  TDynPanel.SetCollapseDirection
  ---------------------------------------------------------------------------
}
procedure TDynPanel.SetCollapseDirection(Value: TCollapseDirection);
begin
  if Value = FCollapseDirection then
    Exit; // >>----->

  FCollapseDirection := Value;

  ConfigurePanel;
end;

{
  TDynPanel.ConfigurePanel
  ---------------------------------------------------------------------------
}
procedure TDynPanel.ConfigurePanel;
begin
  //--------------------------------------------------------------------------
  // Set the group box style, caption alignment, caption, button position, and
  // button image
  //--------------------------------------------------------------------------

  // Changing to Expanded
  if FExpand = True then
  begin
    FGroupBox.Style.Color := clWhite;
    // Up
    if FCollapseDirection = cdUp then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end
    // Right
    else if FCollapseDirection = cdRight then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := '       ' + FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := FButtonPadding;
    end
    // Left
    else if FCollapseDirection = cdLeft then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end;
  end
  // Changing to Collapsed
  else
  begin
    FGroupBox.Style.Color := clGradientActiveCaption;
    // Up
    if FCollapseDirection = cdUp then
    begin
      FGroupBox.Alignment := alTopLeft;
      FGroupBox.Caption := FOrigGroupBoxCaption;
      FButtonPanel.Top := 0;
      FButtonPanel.Left := Width - FButtonPanel.Width - FButtonPadding;
    end
    // Right
    else if FCollapseDirection = cdRight then
    begin
      FGroupBox.Alignment := alRightTop;
      FGroupBox.Caption := '       ' + FOrigGroupBoxCaption;
      FButtonPanel.Top := FButtonPadding;
      FButtonPanel.Left := FCollapsePadding;
    end
    // Left
    else if FCollapseDirection = cdLeft then
    begin
      FGroupBox.Alignment := alLeftTop;
      FGroupBox.Caption := FOrigGroupBoxCaption + '       ';
      FButtonPanel.Top := FButtonPadding;
      FButtonPanel.Left := 0;
    end;
  end;

  UpdateImage;
  // Now draw the button and invalidate Self
  Self.Invalidate;
end;

{
  TDynPanel.UpdateImage
  ---------------------------------------------------------------------------
}
procedure TDynPanel.UpdateImage();
begin
  case FCollapseDirection of
    cdUp:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageUp')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageDown');
      end;
    cdLeft:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageLeft')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageRight');
      end;
    cdRight:
      begin
        if FExpand = true then
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageRight')
        else
          FButtonImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'ButtonImageLeft');
      end;
  end;

end;

end.

Close to the Left
Left Open Left Closed

Close to the Top
Top Open


Top Closed

未蓝澄海的烟 2024-12-09 13:00:21

新的Delphi版本将包括这种滑动面板(通过FireMonkey的集成,以前的vgScene/dxScene)。您只需单击高度或位置道具,然后就会有一个选项允许为此创建动画,并具有各种选项(插值类型、持续时间等)。

在此处输入图像描述

The new Delphi version will include such kind of sliding panels ( trough the integration of FireMonkey, formely vgScene/dxScene ). You'll just have to click on height or position props and an option will allow to create a animation for this, with various option ( interpolation kind, duration etc).

enter image description here

落日海湾 2024-12-09 13:00:21

Since version 2009, there is a TCategoryPanelGroup where you add TCategoryPanel.
enter image description here

淡笑忘祈一世凡恋 2024-12-09 13:00:21

折叠面板
请参阅此处的 FoldingPanel v1.3: http://www.torry.net/authorsmore.php ?id=2386
我用了很多年了。
它还带有漂亮的 V 形位图。
小问题:它不支持复合控件(如 TLabeledEdit)。
优点:该组件作为单个 PAS 文件提供(易于安装到 Palette 中)。他们说它适用于 Delphi 5,但我已将其安装在 XE7 中并且工作没有问题(这表明质量)。
免费软件

TSplitView
如果您有较新版本的 Delphi(例如 Tokyo),您可以使用 TSplitView。
注意:缺少对齐属性。一开始似乎只能左对齐。但事实并非如此。它没有 Align 属性,而是有 Placement 属性(有两个值:svpRight / svpLeft)。
注意:它有一些与控件大小/位置相关的小故障。
注意:它并不(甚至远未)像 FoldingPanel 那样完整。您仍然需要编写一些代码来实现某种 V 形来折叠/展开面板。
https://www.youtube.com/watch?v=3hUG8o7PpCU
免费软件(如果您有 Delphi Tokyo)。

TCategoryPanelGroup
另请查看 TCategoryPanelGroup。它可能有效也可能无效,具体取决于您需要它的用途。
免费软件(如果您有 Delphi XE7)

FoldingPanel
See FoldingPanel v1.3 here: http://www.torry.net/authorsmore.php?id=2386
I used it for years.
It comes with nice chevron bitmap too.
Small issue: it does not support composite controls (like TLabeledEdit).
Advantage: The component comes as a single PAS file (easy to install into the Palette). They say that it is for Delphi 5 but I have it installed in XE7 and works without problems (which indicates quality).
Freeware

TSplitView
If you have a newer version of Delphi (like Tokyo) you can use TSplitView.
Note: The Align property it missing. And at the beginning it might seems that it can only be aligned to Left. But it is not true. Instead of an Align property it has a Placement property (with two values: svpRight / svpLeft).
Note: It has some small glitches related to control size/placement.
Note: It is not (NOT EVEN BY FAR) as complete as FoldingPanel. You still have to write some cod eto implement some kind of chevron to collapse/expend the panel.
https://www.youtube.com/watch?v=3hUG8o7PpCU
Freeware (if you have Delphi Tokyo).

TCategoryPanelGroup
Also take a look at TCategoryPanelGroup. It might or might not work, depending on what you need it for.
Freeware (if you have Delphi XE7)

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文