![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
||||
|
||||
|
Суть такая: Создал компонент на основе TImage. Теперь хочу создать в нём событие, которое будет реагировать, когда курсор на него наводиться. Но как это сделать? Если бонально просто, в TImage нет сообытия OnMove. Как же его туда добавить? Просто по сообщениям из Windows пока ни изучил материал. Как это хоть делаеться?
Код: Код:
type
TMyEvent = procedure(Sender: TObject) of object;
TButonImage = class (TImage)
private
Events: TApplicationEvents;
fIndex: Integer;
fOnMouseMove: TMyEvent;
procedure DoOnMouseMove(Sender:TObject);
procedure SetIndex(Index:Integer);
procedure SetPicture(Name:string);
published
property Index: Integer read fIndex write SetIndex;
property OnMouseMove: TMyEvent read fOnMouseMove;
public
constructor Create(Aowner: TComponent);
end;
implementation
uses Unit1;
{ ButonImage }
constructor TButonImage.Create(Aowner: TComponent);
begin
inherited Create(Aowner);
Parent:=TWinControl(Aowner);
Self.Height:=100;
Self.Width:=100;
SetIndex(0);
Self.Perform(WM_MOUSEMOVE,0,0);
end;
procedure TButonImage.DoOnMouseMove(Sender: TObject);
begin
if Sender = Self then
if Assigned(fOnMouseMove) then fOnMouseMove(Self)
else
begin
SetIndex(0);
end;
end;
procedure TButonImage.SetIndex(Index: Integer);
begin
fIndex:=Index;
case fIndex of
-1: SetPicture('11.png');
0: SetPicture('12.png');
1: SetPicture('13.png');
end;
end;
procedure TButonImage.SetPicture(Name: string);
begin
Self.Picture.LoadFromFile(Name);
end;
end. |
|
#2
|
||||
|
||||
|
Цитата:
Хоть в исходники ExtCtrls.pas загляни. |
|
#3
|
||||
|
||||
|
Цитата:
|
|
#4
|
||||
|
||||
|
Какое событие OnMove? В TImage имеется событие OnMouseMove.
|
|
#5
|
||||
|
||||
|
Цитата:
Так что я не так набираю? |
|
#6
|
||||
|
||||
|
Я так понимаю, нужно полностью самостоятельно обработать событие OnMouseMove. Можно сделать так:
Код:
TButonImage = class (TImage)
...
protected
procedure MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
...
end;
...
constructor TButonImage.Create(Aowner: TComponent);
begin
...
OnMouseMove := MouseMove;
end;
procedure TButonImage.MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
begin
...
end; |
| Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Fantomas_RUS (06.04.2012)
| ||
|
#7
|
||||
|
||||
|
Подскажи пожалуйста, я так понял, можно таким способом любые события ввести в мой компонент, какие есть в Delphi?
|
|
#8
|
||||
|
||||
|
Я привёл пример для события, которое уже существует. Если требуется такое, которого нет у "родителя", его нужно будет полностью описывать самому.
|
|
#9
|
||||
|
||||
|
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TExImage = class(TImage)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure MouseEnter(Sender: TObject);
procedure MouseLeave(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TExImage }
procedure TExImage.CMMouseEnter(var Message: TMessage);
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TExImage.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
with TExImage.Create(Self) do
begin
Parent:=Self;
Left:=10;
Top:=10;
Width:=100;
Height:=100;
Canvas.Brush.Color:=clBtnHighlight;
Canvas.FillRect(ClientRect);
OnMouseEnter:=MouseEnter;
OnMouseLeave:=MouseLeave;
end;
end;
procedure TForm1.MouseEnter(Sender: TObject);
begin
TExImage(Sender).Canvas.Brush.Color:=clBtnFace;
TExImage(Sender).Canvas.FillRect(ClientRect);
end;
procedure TForm1.MouseLeave(Sender: TObject);
begin
TExImage(Sender).Canvas.Brush.Color:=clBtnHighlight;
TExImage(Sender).Canvas.FillRect(ClientRect);
end;
end. |