В итоге мы создали собственный контроль.Мы не могли найти ничего, что работало бы так, как мы хотели.Это оказалось не так сложно.Я уверен, что есть ситуации, с которыми мы не справляемся правильно, но для нас это хорошо работает.
Приведенный ниже код использует 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.
Близко к левому краю
Близко к началу
