如何像窗体设计器一样将控件置于设计状态模式?
How to put controls into a Design State Mode just like the Form Designer does?
这个问题让我困惑了一段时间,也许答案很简单,或者它可能涉及更多的 VCL 黑客或魔法来完成我正在寻找的东西,但无论哪种方式我都不知所措如何解决我的问题。
如果您查看 Delphi 表单设计器,您会看到 none 的控件在鼠标移到它们上面时会动画化,它们也无法接收焦点或输入(例如,您无法输入TEdit、单击 TCheckBox 或移动 TScrollBar 等),只有在运行时控件才能正常运行并响应用户交互。
我想知道如何在运行时对任何控件实现这种类型的行为,例如将控件设置为设计器状态模式?但是,控件还应该响应 OnMouseDown
、OnMouseMove
、OnMouseUp
等鼠标事件,以便在需要时可以移动它们并调整其大小。
这是我管理的最接近的:
procedure SetControlState(Control: TWinControl; Active: Boolean);
begin
SendMessage(Control.Handle, WM_SETREDRAW, Ord(Active), 0);
InvalidateRect(Control.Handle, nil, True);
end;
可以简单地这样称呼:
procedure TForm1.chkActiveClick(Sender: TObject);
begin
SetControlState(Button1, chkActive.Checked);
SetControlState(Button2, chkActive.Checked);
SetControlState(Edit1, chkActive.Checked);
end;
或者例如,窗体上的所有控件:
procedure TForm1.chkActiveClick(Sender: TObject);
var
I: Integer;
Ctrl: TWinControl;
begin
for I := 0 to Form1.ControlCount -1 do
begin
if Form1.Controls[I] is TWinControl then
begin
Ctrl := TWinControl(Form1.Controls[I]);
if (Ctrl <> nil) and not (Ctrl = chkActive) then
begin
SetControlState(Ctrl, chkActive.Checked);
end;
end;
end;
end;
我注意到上面的两个问题是,虽然控件确实看起来像设计状态,但某些控件(如 TButton)仍然具有绘制在其上的动画效果。另一个问题是当控件处于设计状态时按下左 Alt 键会导致它们消失。
所以我的问题是,如何在运行时将控件置于设计状态模式,就像 Delphi 表单设计器所做的那样,这些控件不设置动画(基于 Windows 主题)无法接收焦点或输入?
为了更清楚一点,请查看基于上述代码示例的示例图像,其中控件不再处于活动状态,但 TButton 的动画绘制仍然处于活动状态:
但实际上应该是:
从上面两张图片来看,只有TCheckBox控件可以交互。
是否有隐藏在某个地方的程序可以改变控件的状态?或者也许是更合适的方法来实现这一目标?到目前为止,我设法获得的代码存在更多问题。
将控件设置为 Enabled := False
也不是我正在寻找的答案,是的,行为有点相同,但当然控件的绘制方式不同以显示它们已被禁用,这不是我想要的寻找。
您要查找的不是控件本身的功能,而是窗体设计器本身的实现。在 design-time,用户输入在被任何给定控件处理之前被拦截。 VCL 定义了一个 CM_DESIGNHITTEST
消息,以允许每个控件指定它是否要在 design-time 处接收用户输入(例如,允许视觉调整 list/grid 列 headers 的大小)。这是一个 opt-in 功能。
不过,您可以将所需的控件放在无边框 TPanel
上,然后根据需要简单地 enable/disable TPanel
本身。这将有效地 enable/disable 其 child 控件的所有用户输入和动画。此外,当 TPanel
被禁用时,child 控件将不会呈现为看起来已禁用。
我不确定这是否是您想要的,但 Greatis 有一个 Form Designer 组件。参见:http://www.greatis.com/delphicb/formdes/
Remy Lebeau 关于将控件放入容器(如 TPanel)然后将面板设置为 Enabled := False
的回答确实将控件置于我正在寻找的状态。我还发现覆盖控件 WM_HITTEST
会将控件置于相同的状态,例如,它们没有获得焦点并且无法与之交互。这两个的问题是控件仍然需要能够响应 MouseDown
、MouseMove
和 MouseUp
事件等,但它们不再不能。
Remy 还建议写一个 class 并实现 Vcl.Forms.IDesignerHook
,我还没有尝试过,因为它可能需要太多的工作才能满足我的需要。
无论如何,经过大量尝试我找到了另一种替代方法,它涉及使用 PaintTo
将控件绘制到 canvas 上。我做的步骤如下:
- 创建自定义
TPanel
并公开 Canvas
- 在
FormCreate
创建自定义面板并将其与客户对齐
- 在运行时向表单添加控件(将自定义面板置于最前面)
- 在自定义面板上调用控件
PaintTo
方法 Canvas
这实际上是在创建组件并使用 Form 作为父级,我们的自定义面板位于顶部。然后将控件绘制到面板上 canvas,这使得它看起来好像控件在面板上,而实际上它位于窗体下方不受干扰。
因为控件在面板下方,为了让它们响应 MouseDown
、MouseMove
和 MouseUp
等事件,我覆盖了 WM_NCHitTest
面板并将结果设置为 HTTRANSPARENT
.
在代码中它看起来像这样:
自定义面板:
type
TMyPanel = class(TPanel)
protected
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
end;
{ TMyPanel }
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alClient;
BorderStyle := bsNone;
Caption := '';
end;
destructor TMyPanel.Destroy;
begin
inherited Destroy;
end;
procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;
形式:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMyPanel: TMyPanel;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyPanel := TMyPanel.Create(nil);
FMyPanel.Parent := Form1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMyPanel.Free;
end;
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Sender is TWinControl then
begin
ShowMessage('You clicked: ' + TWinControl(Sender).Name);
end;
end;
向表单添加TButton的示例:
procedure TForm1.Button1Click(Sender: TObject);
var
Button: TButton;
begin
Button := TButton.Create(Form1);
Button.Parent := Form1;
FMyPanel.BringToFront;
with Button do
begin
Caption := 'Button';
Left := 25;
Name := 'Button';
Top := 15;
OnMouseDown := ControlMouseDown;
PaintTo(FMyPanel.Canvas, Left, Top);
Invalidate;
end;
end;
如果您尝试 运行 上面的操作,您会看到我们创建的 TButton 没有动画或接收焦点,但它可以响应我们在上面的代码中附加的 MouseDown
事件,即是因为我们实际上并没有在查看控件,而是在查看控件的图形副本。
这个问题让我困惑了一段时间,也许答案很简单,或者它可能涉及更多的 VCL 黑客或魔法来完成我正在寻找的东西,但无论哪种方式我都不知所措如何解决我的问题。
如果您查看 Delphi 表单设计器,您会看到 none 的控件在鼠标移到它们上面时会动画化,它们也无法接收焦点或输入(例如,您无法输入TEdit、单击 TCheckBox 或移动 TScrollBar 等),只有在运行时控件才能正常运行并响应用户交互。
我想知道如何在运行时对任何控件实现这种类型的行为,例如将控件设置为设计器状态模式?但是,控件还应该响应 OnMouseDown
、OnMouseMove
、OnMouseUp
等鼠标事件,以便在需要时可以移动它们并调整其大小。
这是我管理的最接近的:
procedure SetControlState(Control: TWinControl; Active: Boolean);
begin
SendMessage(Control.Handle, WM_SETREDRAW, Ord(Active), 0);
InvalidateRect(Control.Handle, nil, True);
end;
可以简单地这样称呼:
procedure TForm1.chkActiveClick(Sender: TObject);
begin
SetControlState(Button1, chkActive.Checked);
SetControlState(Button2, chkActive.Checked);
SetControlState(Edit1, chkActive.Checked);
end;
或者例如,窗体上的所有控件:
procedure TForm1.chkActiveClick(Sender: TObject);
var
I: Integer;
Ctrl: TWinControl;
begin
for I := 0 to Form1.ControlCount -1 do
begin
if Form1.Controls[I] is TWinControl then
begin
Ctrl := TWinControl(Form1.Controls[I]);
if (Ctrl <> nil) and not (Ctrl = chkActive) then
begin
SetControlState(Ctrl, chkActive.Checked);
end;
end;
end;
end;
我注意到上面的两个问题是,虽然控件确实看起来像设计状态,但某些控件(如 TButton)仍然具有绘制在其上的动画效果。另一个问题是当控件处于设计状态时按下左 Alt 键会导致它们消失。
所以我的问题是,如何在运行时将控件置于设计状态模式,就像 Delphi 表单设计器所做的那样,这些控件不设置动画(基于 Windows 主题)无法接收焦点或输入?
为了更清楚一点,请查看基于上述代码示例的示例图像,其中控件不再处于活动状态,但 TButton 的动画绘制仍然处于活动状态:
但实际上应该是:
从上面两张图片来看,只有TCheckBox控件可以交互。
是否有隐藏在某个地方的程序可以改变控件的状态?或者也许是更合适的方法来实现这一目标?到目前为止,我设法获得的代码存在更多问题。
将控件设置为 Enabled := False
也不是我正在寻找的答案,是的,行为有点相同,但当然控件的绘制方式不同以显示它们已被禁用,这不是我想要的寻找。
您要查找的不是控件本身的功能,而是窗体设计器本身的实现。在 design-time,用户输入在被任何给定控件处理之前被拦截。 VCL 定义了一个 CM_DESIGNHITTEST
消息,以允许每个控件指定它是否要在 design-time 处接收用户输入(例如,允许视觉调整 list/grid 列 headers 的大小)。这是一个 opt-in 功能。
不过,您可以将所需的控件放在无边框 TPanel
上,然后根据需要简单地 enable/disable TPanel
本身。这将有效地 enable/disable 其 child 控件的所有用户输入和动画。此外,当 TPanel
被禁用时,child 控件将不会呈现为看起来已禁用。
我不确定这是否是您想要的,但 Greatis 有一个 Form Designer 组件。参见:http://www.greatis.com/delphicb/formdes/
Remy Lebeau 关于将控件放入容器(如 TPanel)然后将面板设置为 Enabled := False
的回答确实将控件置于我正在寻找的状态。我还发现覆盖控件 WM_HITTEST
会将控件置于相同的状态,例如,它们没有获得焦点并且无法与之交互。这两个的问题是控件仍然需要能够响应 MouseDown
、MouseMove
和 MouseUp
事件等,但它们不再不能。
Remy 还建议写一个 class 并实现 Vcl.Forms.IDesignerHook
,我还没有尝试过,因为它可能需要太多的工作才能满足我的需要。
无论如何,经过大量尝试我找到了另一种替代方法,它涉及使用 PaintTo
将控件绘制到 canvas 上。我做的步骤如下:
- 创建自定义
TPanel
并公开Canvas
- 在
FormCreate
创建自定义面板并将其与客户对齐 - 在运行时向表单添加控件(将自定义面板置于最前面)
- 在自定义面板上调用控件
PaintTo
方法Canvas
这实际上是在创建组件并使用 Form 作为父级,我们的自定义面板位于顶部。然后将控件绘制到面板上 canvas,这使得它看起来好像控件在面板上,而实际上它位于窗体下方不受干扰。
因为控件在面板下方,为了让它们响应 MouseDown
、MouseMove
和 MouseUp
等事件,我覆盖了 WM_NCHitTest
面板并将结果设置为 HTTRANSPARENT
.
在代码中它看起来像这样:
自定义面板:
type
TMyPanel = class(TPanel)
protected
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
end;
{ TMyPanel }
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alClient;
BorderStyle := bsNone;
Caption := '';
end;
destructor TMyPanel.Destroy;
begin
inherited Destroy;
end;
procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;
形式:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMyPanel: TMyPanel;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyPanel := TMyPanel.Create(nil);
FMyPanel.Parent := Form1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMyPanel.Free;
end;
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Sender is TWinControl then
begin
ShowMessage('You clicked: ' + TWinControl(Sender).Name);
end;
end;
向表单添加TButton的示例:
procedure TForm1.Button1Click(Sender: TObject);
var
Button: TButton;
begin
Button := TButton.Create(Form1);
Button.Parent := Form1;
FMyPanel.BringToFront;
with Button do
begin
Caption := 'Button';
Left := 25;
Name := 'Button';
Top := 15;
OnMouseDown := ControlMouseDown;
PaintTo(FMyPanel.Canvas, Left, Top);
Invalidate;
end;
end;
如果您尝试 运行 上面的操作,您会看到我们创建的 TButton 没有动画或接收焦点,但它可以响应我们在上面的代码中附加的 MouseDown
事件,即是因为我们实际上并没有在查看控件,而是在查看控件的图形副本。