- unit ExtImage;
-
- interface
-
- uses
- Controls, ExtCtrls, Messages, Classes, Graphics;
-
- type
- //Classe de base, qui contient tout le code
- TCustomExtImage = class(TImage)
- private
- FOnMouseLeave: TNotifyEvent;
- FOnMouseEnter: TNotifyEvent;
- //interception des messages windows d'evenements de la souris qui nous interessent
- procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
- protected
- //nos proprietes
- property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
- property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
-
- //procedures appelées par les messages windows
- // permet de surcharger ces procedures si on herite le composant, sans se soucier des messages
- procedure MouseEnter; virtual;
- procedure MouseLeave; virtual;
- end;
-
- //class effective, permet simplement de "publisher" les proprietes voulues
- TExtImage = class(TCustomExtImage)
- published
- property OnMouseEnter;
- property OnMouseLeave;
- end;
-
- procedure Register;
-
- implementation
-
- procedure Register;
- begin
- RegisterComponents('Supplément', [TExtImage]);
- end;
-
- { TCustomExtImage }
-
- procedure TCustomExtImage.CMMouseEnter(var Message: TMessage);
- begin
- MouseEnter;
- end;
-
- procedure TCustomExtImage.CMMouseLeave(var Message: TMessage);
- begin
- MouseLeave;
- end;
-
- procedure TCustomExtImage.MouseEnter;
- begin
- if Assigned(FOnMouseEnter) then
- FOnMouseEnter(Self);
- end;
-
- procedure TCustomExtImage.MouseLeave;
- begin
- if Assigned(FOnMouseLeave) then
- FOnMouseLeave(Self);
- end;
-
-
- end.
unit ExtImage;
interface
uses
Controls, ExtCtrls, Messages, Classes, Graphics;
type
//Classe de base, qui contient tout le code
TCustomExtImage = class(TImage)
private
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
//interception des messages windows d'evenements de la souris qui nous interessent
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
//nos proprietes
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
//procedures appelées par les messages windows
// permet de surcharger ces procedures si on herite le composant, sans se soucier des messages
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
end;
//class effective, permet simplement de "publisher" les proprietes voulues
TExtImage = class(TCustomExtImage)
published
property OnMouseEnter;
property OnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Supplément', [TExtImage]);
end;
{ TCustomExtImage }
procedure TCustomExtImage.CMMouseEnter(var Message: TMessage);
begin
MouseEnter;
end;
procedure TCustomExtImage.CMMouseLeave(var Message: TMessage);
begin
MouseLeave;
end;
procedure TCustomExtImage.MouseEnter;
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TCustomExtImage.MouseLeave;
begin
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
end.