[Aleks26]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

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 применяй для него:

Код:

1	<b>Canvas</b>.Brush.Color := clYellow;

[Aleks26]

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

[Pyro]

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

[Aleks26]

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

[Pyro]

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

[dr. F.I.N.]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

unit Unit1;   interface   uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ExtCtrls, StdCtrls;   type   <b>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;</b>     TForm1 = class(TForm)     Panel1: TPanel;     Button1: TButton;     procedure Button1Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;   var   Form1: TForm1;   implementation   <b>{ 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;</b>   {$R *.dfm}   procedure TForm1.Button1Click(Sender: TObject); begin   Panel1.Canvas.Rectangle(10, 10, 50, 50); end;   end.

[NumLock]

тогда уж так:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

unit Unit1;   interface   uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, ExtCtrls;   type <font color="Red">  TPanel = class(ExtCtrls.TPanel)   public     property Canvas;   end; </font>   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

Код:

1 2 3 4 5 6 7 8 9 10 11 12

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

[Aleks26]

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

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

Код:

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

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

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

[Aleks26]

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

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

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