unit cPOSCompo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TOnMouseEvent =
procedure( Msg: TWMMouse )
of object;
TcPOSCompo =
class(TCustomControl)
protected
procedure WMMouseEnter(
var Msg : TWMMouse );
message CM_MOUSEENTER;
procedure WMMouseLeave(
var Msg : TWMMouse );
message CM_MOUSELEAVE;
procedure WMLButtonUp(
var Msg : TWMLButtonUp );
message WM_LBUTTONUP;
procedure WMLButtonDown(
var Msg : TWMLButtonUp );
message WM_LBUTTONDOWN;
private
FImage: TImage;
FLabel: TLabel;
FEntered : boolean;
FDown : boolean;
FPic : TPicture;
FPicDown : TPicture;
FPicUp : TPicture;
FOnMouseEnter : TOnMouseEvent;
FOnMouseLeave : TOnMouseEvent;
FOnMouseDown : TOnMouseEvent;
FOnMouseUp : TOnMouseEvent;
procedure setCaption(Value:
String);
function getCaption:
String;
procedure setFont(Value: TFont);
function getFont: TFont;
procedure SetPic( Value : TPicture );
procedure SetPicDown( Value : TPicture );
procedure SetPicUp( Value : TPicture );
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure Resize;
override;
published
property Caption:
String read getCaption
write setCaption;
property Font: TFont
read getFont
write setFont;
property Pic : TPicture
read FPic
write SetPic;
property PicDown : TPicture
read FPicDown
write SetPicDown;
property PicUp : TPicture
read FPicUp
write SetPicUp;
property OnMouseDown : TOnMouseEvent
read FOnMouseDown
write FOnMouseDown;
property OnMouseEnter : TOnMouseEvent
read FOnMouseEnter
write FOnMouseEnter;
property OnMouseLeave : TOnMouseEvent
read FOnMouseLeave
write FOnMouseLeave;
property OnMouseUp : TOnMouseEvent
read FOnMouseUp
write FOnMouseUp;
property OnClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
cPos_Live', [TcPOSCompo]);
end;
constructor TcPOSCompo.Create(AOwner: TComponent);
begin
Inherited;
FImage := TImage.Create(self);
FImage.Parent := self;
FLabel:= TLabel.create(self);
FLabel.Parent := self;
FPic := TPicture.Create;
FPicUp := TPicture.Create;
FPicDown := TPicture.Create;
FLabel.Visible := False;
FLabel.Transparent := True;
Self.AutoSize := True;
FImage.AutoSize := True;
FEntered := False;
FDown := False;
end;
destructor TcPOSCompo.Destroy;
begin
FPic.Free;
FPicDown.Free;
FPicUp.Free;
Inherited;
end;
procedure TcPOSCompo.Resize;
begin
FImage.Picture := FPic;
End;
procedure TcPOSCompo.WMMouseEnter(
var Msg: TWMMouse );
begin
FEntered := True;
if FDown
then FImage.Picture := FPicDown
else FImage.Picture := FPicUp;
if Assigned( FOnMouseEnter )
then FOnMouseEnter( Msg );
end;
procedure TcPOSCompo.WMMouseLeave(
var Msg: TWMMouse );
begin
FEntered := False;
FImage.Picture := FPic;
if Assigned( FOnMouseLeave )
then FOnMouseLeave( Msg );
end;
procedure TcPOSCompo.WMLButtonDown(
var Msg: TWMMouse);
begin
inherited;
FDown := True;
if FEntered
then FImage.Picture := FPicDown;
if Assigned( FOnMouseDown )
then FOnMouseDown( Msg );
end;
procedure TcPOSCompo.WMLButtonUp(
var Msg: TWMMouse);
begin
inherited;
FDown := False;
if FEntered
then FImage.Picture := FPicUp;
if Assigned( FOnMouseUp )
then FOnMouseUp( Msg );
end;
procedure TcPOSCompo.setCaption(Value:
String);
begin
FLabel.Caption := Value;
If FLabel.Caption = '
'
then FLabel.Visible := False
else FLabel.Visible := True;
end;
function TcPOSCompo.getCaption:
String;
begin
result := FLabel.Caption;
end;
procedure TcPOSCompo.setFont(Value: TFont);
begin
FLabel.Font := Value;
end;
function TcPOSCompo.getFont: TFont;
begin
result := FLabel.Font;
end;
procedure TcPOSCompo.SetPic( Value : TPicture );
begin
FPic.Assign( Value );
end;
procedure TcPOSCompo.SetPicDown( Value : TPicture );
begin
FPicDown.Assign( Value );
end;
procedure TcPOSCompo.SetPicUp( Value : TPicture );
begin
FPicUp.Assign( Value );
end;
end.