Delphi PaintBox без ключевых событий - PullRequest
Новая
       37

Delphi PaintBox без ключевых событий

0 голосов
/ 02 декабря 2011

Я вижу свою версию delphi, у которой нет событий Key Events (OnKeyDown, OnKeyUp, OnKeyPress) для TPaintBox. Я хотел бы обработать что-то подобное. У кого-нибудь была коробка с этими событиями?

Ответы [ 2 ]

9 голосов
/ 02 декабря 2011

Как сказал TLama, вам нужно наследовать от TCustomControl. Но вам понадобится дополнительный код для публикации всех событий клавиатуры. Вы можете выбрать простой способ и наследовать от TPanel, поскольку TPanel уже предоставляет Canvas и ряд событий клавиатуры.

Но вот некоторый код, показывающий, как создать и зарегистрировать новый элемент управления, который опубликовал свойства 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.

Я добавил некоторые функции в попытке сделать элемент управления прозрачным, потому что PaintBox тоже. Одним из недостатков является то, что вам нужно перекрасить родительский элемент, чтобы очистить ранее нарисованный контент. В демонстрационном приложении это достаточно просто. Я просто аннулирую форму вместо элемента управления. : p
Если вам это не нужно, вы можете удалить WMEraseBkGnd, CreateParams и SetParent из элемента управления.

Небольшая демонстрация: Поместите ярлык на форму. Поместите TGTPaintBox поверх него и сделайте его немного больше. Затем добавьте таймер и, возможно, некоторые другие элементы управления.

Убедитесь, что вы установили свойство TabStop 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;
4 голосов
/ 02 декабря 2011

Вы также можете создать рамку с окраской (выровненной по alClient) и повторно использовать рамку по мере необходимости. TFrame - это оконный элемент управления, поэтому он содержит все события клавиатуры. Они не опубликованы, но вы можете назначить их в коде.

...