[Aleks26]

Я имею достаточно простой пример по использованию сообщений Windows:

Код:

unit unGMMain1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
  private
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMRButtonUp(var Msg: TWMRButtonUp); message WM_RButtonUp;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}
 Procedure TForm1.WMPaint(var Msg: TWMPaint);
 var
// R1: TRect;
 begin
  Panel1.Color := clRed;
  Beep;
   {R1 := Rect(0,0,200,200);
   Brush.Color := clYellow;
   Canvas.FrameRect(R1);}
  inherited;
 end;

 Procedure TForm1.WMRButtonUp(var Msg: TWMRButtonUp);
 Var
  pos: TPoint;
 begin
   GetCursorPos(pos);
  if (pos.X < Left+200) and (pos.Y < Top+200) then
  Close else
   begin
   Panel1.Color := clGreen;
   Panel1.Caption := 'X = '+ inttostr(Left)+'  Y = '+inttostr(Top);
   end;
  inherited;
 end;

При запуске приложения Panel1 закрашивается цветом из Инспектора объектов, а затем при нажатии и отпускании правой кнопки мыши на форме либо панель перекрашивается в зеленый цвет и на ней выводятся координаты нажатия, либо (при попадании в левый верхний квадрат размером 200) форма, а потому и все приложение закрывается.
Я хочу начертить этот квадрат (в процедуре WMPaint каким-то цветом - сейчас закомментировано), но не получается. Если заменить Canvas.FrameRect(R1) на Canvas.Rectangle(R1), бесцветный прямоугольник рисуется без проблем. Объясните кто-нибудь, почему не работают методы FrameRect или FillRect экземпляра класса TCanvas?

[YVitaliy]

Если рисуешь на канве, то свойство Brush.Color применяй для него:

Код:

Canvas.Brush.Color := clYellow;

[Aleks26]

Благодарю Вас. Еще один маленький вопрос по данному примеру: если канва пересекается с компонентом Panel1, можно ли вывести ее на передний план? Чтобы нарисованный квадрат был виден полностью?

[Pyro]

можно если это Panel2.Canvas

[Aleks26]

Я не совсем понял. Ведь компонент TPanel не имеет свойства Canvas. Как же это можно организовать?

[Pyro]

тогда на него можно paintbox положить – у него есть

[dr. F.I.N.]

Устанавливаем канву для панели

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CC: TControlCanvas;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  CC := TControlCanvas.Create;
  CC.Control := Panel1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CC.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CC.Rectangle(10, 10, 50, 50);
end;

end.

[dr. F.I.N.]

А можно еще интереснее - добавить свойство Canvas классу TPanel

Код:

unit Unit1;

interface

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

type
  TPanel = class(ExtCtrls.TPanel)
  private
    FCanvas: TControlCanvas;
    function GetCanvas: TCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Canvas: TCanvas read GetCanvas;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TPanel }

constructor TPanel.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
end;

destructor TPanel.Destroy;
begin
  FCanvas.Free;
  inherited;
end;

function TPanel.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Canvas.Rectangle(10, 10, 50, 50);
end;

end.

[NumLock]

тогда уж так:

Код:

unit Unit1;

interface

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

type
  TPanel = class(ExtCtrls.TPanel)
  public
    property Canvas;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Canvas.Brush.Color:=clYellow;
  Panel1.Canvas.FillRect(Rect(10, 10, 100, 100));
end;

end.

TPanel - TCustomPanel - TCustomControl

Код:

  TCustomControl = class(TWinControl)
  private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint; virtual;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

[Aleks26]

Сообщение от dr. F.I.N.

Устанавливаем канву для панели

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CC: TControlCanvas;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  CC := TControlCanvas.Create;
  CC.Control := Panel1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CC.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CC.Rectangle(10, 10, 50, 50);
end;

end.

Может быть я делаю что-то не так (я совсем новичок), но попытавшись установить канву для панели, свойства Canvas не нашел. Обнаружил только CanvasOrientation.

[Страдалецъ]

А вы когда Canvas ищете? В дизайн-моде? Так там ее и не будет. Тут рассматривается вариант добавления нового свойства в рантайм-моде. Можно конечно сделать, что-бы и в дизайн-моде появилось такое свойство, но это уже делается несколько иначе.

[Aleks26]

Сообщение от Страдалецъ

А вы когда Canvas ищете? В дизайн-моде? Так там ее и не будет. Тут рассматривается вариант добавления нового свойства в рантайм-моде. Можно конечно сделать, что-бы и в дизайн-моде появилось такое свойство, но это уже делается несколько иначе.

Я попробовал сейчас второй пример dr. F.I.N. (с добавлением свойства Canvas классу TPanel), но часть квадрата, закрытого формой так и осталась невидимой. Хотя Panel1 в этом случае канву получил.