unit FlatImage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TFlatImage = class(TPAintBox)
private
{ Private declarations }
MouseOn : Boolean;
IsMouseDown : Boolean;
FPicture: TPicture;
FStrValue: string;
procedure PictureChanged(Sender: TObject);
procedure SetPicture(const Value: TPicture);
protected
{ Protected declarations }
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function DestRect: TRect;
Procedure Paint;override;
public
{ Public declarations }
published
{ Published declarations }
Constructor Create(AOwner:TComponent);override;
Destructor Destroy;override;
property Picture: TPicture read FPicture write SetPicture;
property StrValue: string read FStrValue write FStrValue;
end;
implementation
{ TFlatImage }
procedure TFlatImage.CMMouseEnter(var Message: TMessage);
begin
MouseOn := True;
Repaint;
end;
procedure TFlatImage.CMMouseLeave(var Message: TMessage);
begin
MouseOn := False;
IsMouseDown := False;
Repaint;
end;
constructor TFlatImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MouseOn := False;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
Height := 105;
Width := 105;
end;
destructor TFlatImage.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
function TFlatImage.DestRect: TRect;
begin
Result := Bounds((Width - Picture.Width) div 2, (Height - Picture.Height) div 2,
Picture.Width, Picture.Height)
end;
procedure TFlatImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
Inherited MouseDown(Button,Shift,x,y);
If Button = mbLeft then
begin
IsMouseDown := True;
Repaint;
end;
end;
procedure TFlatImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
Inherited MouseUp(Button,Shift,x,y);
If Button = mbLeft then
begin
IsMouseDown := false;
Repaint;
end;
end;
procedure TFlatImage.Paint;
var PaintRect : TRect;
begin
Inherited Paint;
PaintRect := Rect(0, 0, Width-1, Height-1);
with inherited Canvas do
StretchDraw(DestRect, Picture.Graphic);
If IsMouseDown then DrawEdge(Canvas.Handle, PaintRect, BDR_SUNKENINNER,BF_RECT)
else If MouseOn then DrawEdge(Canvas.Handle, PaintRect, BDR_RAISEDOUTER,BF_RECT)
end;
procedure TFlatImage.PictureChanged(Sender: TObject);
begin
RePaint;
end;
procedure TFlatImage.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;
end.