unit cPosCompo;
interface
uses
Classes, Graphics, Controls, Messages, Jpeg;
type
TcPosCompo =
class(TGraphicControl)
private
FUpPic : TJpegImage;
FDownPic : TJpegImage;
FOverPic : TJpegImage;
FBoolTruePic : TBitmap;
FBoolFalsePic : TBitmap;
FShowBoolPic : Boolean;
FButtonDown : Boolean;
FLabelXPos : Integer;
FLabelYPos : Integer;
FEntered : Boolean;
procedure WMLButtonUp(
var Message: TWMLButtonUp);
message WM_LBUTTONUP;
procedure WMLButtonDown(
var Message: TWMLButtonDown);
message WM_LBUTTONDOWN;
procedure WMMouseEnter(
var Message : TWMMouse );
message CM_MOUSEENTER;
procedure WMMouseLeave(
var Message : TWMMouse );
message CM_MOUSELEAVE;
procedure SetDownPic(
const Value: TJpegImage);
procedure SetUpPic(
const Value: TJpegImage);
procedure SetOverPic(
const Value: TJpegImage);
procedure SetBoolTruePic(
const Value: TBitmap);
procedure SetBoolFalsePic(
const Value: TBitmap);
procedure SetText(
const Value: TCaption);
reintroduce;
procedure SetShowBoolPic(
const Value: Boolean);
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property Caption
write SetText;
property UpPicture: TJpegImage
read FUpPic
write SetUpPic;
property DownPicture: TJpegImage
read FDownPic
write SetDownPic;
property OverPicture: TJpegImage
read FOverPic
write SetOverPic;
property BoolTruePicture: TBitmap
read FBoolTruePic
write SetBoolTruePic;
property BoolFalsePicture: TBitmap
read FBoolFalsePic
write SetBoolFalsePic;
property ShowBoolPic: Boolean
read FShowBoolPic
write SetShowBoolPic;
property OnMouseDown;
property OnMouseUp;
property OnClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
cPOS_Live', [TcPosCompo]);
end;
{ TcPosCompo }
constructor TcPosCompo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FUpPic := TJpegImage.Create();
FDownPic := TJpegImage.Create();
FOverPic := TJpegImage.Create();
FBoolTruePic := TBitmap.Create();
FboolTruePic.TransparentColor := clblack;
FboolTruePic.Transparent := True;
FBoolFalsePic := TBitmap.Create();
FboolFalsePic.TransparentColor := clblack;
FboolFalsePic.Transparent := True;
FButtonDown := False;
FEntered := False;
FShowBoolPic := False;
FLabelXPos := 0;
FLabelYPos := 0;
Canvas.Brush.Style := bsClear;
end;
destructor TcPosCompo.Destroy;
begin
FUpPic.Free();
FDownPic.Free();
FOverPic.Free();
FBoolTruePic.Free();
FBoolFalsePic.Free();
inherited;
end;
procedure TcPosCompo.Paint;
begin
if FButtonDown
then
begin
Canvas.Draw(0, 0, FDownPic);
if FShowBoolPic
then Canvas.Draw(5, 4, FBoolTruePic)
else Canvas.Draw(5, 4, FBoolFalsePic);
Canvas.Font.Color := clWhite;
Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
Canvas.Font.Color := clBlack;
Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
end else
begin
if FEntered
then Canvas.Draw(0, 0, FOverPic)
else
Canvas.Draw(0, 0, FUpPic);
if FShowBoolPic
then Canvas.Draw(5, 4, FBoolTruePic)
else Canvas.Draw(5, 4, FBoolFalsePic);
Canvas.Font.Color := clBlack;
Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
Canvas.Font.Color := clWhite;
Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
end;
end;
procedure TcPosCompo.SetBoolTruePic(
const Value: TBitmap);
begin
FBoolTruePic.Assign(Value);
end;
procedure TcPosCompo.SetBoolFalsePic(
const Value: TBitmap);
begin
FBoolFalsePic.Assign(Value);
end;
procedure TcPosCompo.SetOverPic(
const Value: TJpegImage);
begin
FOverPic.Assign(Value);
end;
procedure TcPosCompo.SetDownPic(
const Value: TJpegImage);
begin
FDownPic.Assign(Value);
end;
procedure TcPosCompo.SetUpPic(
const Value: TJpegImage);
begin
FUpPic.Assign(Value);
end;
procedure TcPosCompo.WMLButtonDown(
var Message: TWMLButtonDown);
begin
FButtonDown := True;
Repaint();
inherited;
end;
procedure TcPosCompo.WMLButtonUp(
var Message: TWMLButtonUp);
begin
FButtonDown := False;
Repaint();
inherited;
end;
procedure TcPosCompo.WMMouseEnter(
var Message: TWMMouse );
begin
FEntered := True;
Repaint();
inherited;
end;
procedure TcPosCompo.WMMouseLeave(
var Message: TWMMouse );
begin
FEntered := False;
Repaint();
inherited;
end;
procedure TcPosCompo.SetText(
const Value: TCaption);
begin
if Caption <> Value
then
begin
SetTextBuf(PChar(Value));
Repaint();
end;
end;
procedure TcPosCompo.SetShowBoolPic(
const Value: Boolean);
begin
if ShowBoolPic <> Value
then
begin
FShowBoolPic := Value;
Repaint();
end;
end;
end.