德尔菲颜料盒没有关键事件
题
我看到我的版本的德尔菲,没有关键的活动(OnKeyDown,OnKeyUp,OnKeyPress)事件对TPaintBox.我想到处理这样的事情。有别人的颜料盒与这些活动?
解决方案
像TLama说,你会需要继承TCustomControl.但你会需要一些额外的代码发布的所有键盘的事件。你可以选择最容易的方法和继承TPanel由于TPanel已经暴露了一个帆布和数量的键盘的事件。
但这里的一些代码,以显示如何创建和注册一个新的控制,已发布的属性TCustomControl,并引入了一个新的OnPaint事件:
如果创建一个新的软件包,加入这一单元,并安装了,你会有一个新的TGTPaintBox控制,可以有焦点(虽然你看不见它)。它可以检索的键盘输入。
unit uBigPaintbox;
interface
uses Windows, Classes, Messages, Controls;
type
TGTPaintBox = class(TCustomControl)
private
FOnPaint: TNotifyEvent;
protected
// Three methods below are for transparent background. This may not work that great,
// and if you don't care about it, you can remove them.
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure CreateParams(var Params: TCreateParams); override;
procedure SetParent(AParent: TWinControl); override;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
property Canvas;
published
// Introduce OnPaint event
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
// Publish keyboard and mouse events.
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
property OnClick;
property OnDblClick;
property OnMouseUp;
property OnMouseDown;
property OnMouseMove;
// And some other behavioral property that relate to keyboard input.
property TabOrder;
property TabStop;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('GolezTrol', [TGTPaintBox]);
end;
{ TGTPaintBox }
procedure TGTPaintBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TGTPaintBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
// Focus the control when it is clicked.
if not (csDesigning in ComponentState) and CanFocus then
SetFocus;
end;
procedure TGTPaintBox.Paint;
begin
inherited;
// Call paint even if it is assigned.
if Assigned(FOnPaint) then
FOnPaint(Self);
end;
procedure TGTPaintBox.SetParent(AParent: TWinControl);
var
NewStyle: Integer;
begin
inherited;
if AParent = nil then
Exit;
// Make sure the parent is updated too behind the control.
NewStyle := GetWindowLong(AParent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN;
SetWindowLong(AParent.Handle, GWL_STYLE, NewStyle);
end;
procedure TGTPaintBox.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
SetBkMode(Msg.DC, TRANSPARENT);
Msg.Result := 1;
end;
end.
我已经增加了一些功能,在试图使的控制的透明,因为一个颜料盒。一个缺点是,你需要重新绘制的父母清除先前绘制的内容。在演示中的应用程序,这是很容易。我只是无效的形式,而不是控制。:p
如果你不需要它,你可以除去 WMEraseBkGnd
, CreateParams
和 SetParent
从控制。
小演示:把标签上的一种形式。把TGTPaintBox在它上面,并使它成为一个比较大。然后添加一个计时器,也许一些其他的控制。
确保你表位置的财产GTPaintBox到 True
.
然后,执行以下活动;
// To repaint the lot.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Invalidate;
end;
// Capture key input and save the last entered letter in the tag.
procedure TForm1.GTPaintBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key in ['a'..'z'] then
TGTPaintBox(Sender).Tag := Integer(Key);
end;
// Paint the control (this is called every second, when the timer invalidates the form
procedure TForm1.GTPaintBox1Paint(Sender: TObject);
var
PaintBox: TGTPaintBox;
begin
PaintBox := TGTPaintBox(Sender);
// Draw a focus rect too. If you want the control to do this, you would normally
// implement it in the control itself, and make sure it invalides as soon as it
// receives or loses focus.
if PaintBox.Focused then
PaintBox.Canvas.DrawFocusRect(PaintBox.Canvas.ClipRect);
// It just draws the character that we forced into the Tag in the KeyPress event.
PaintBox.Canvas.TextOut(Random(200), Random(200), Char(PaintBox.Tag));
end;
其他提示
您还可以创建一个带有颜料盒的框架(与alClient
对齐),然后根据需要重新使用该框架。TFrame
是一个窗口控件,因此具有所有键盘事件。它们没有发布,但是您可以在代码中分配它们。
不隶属于 StackOverflow