flatimage.pas

请使用Mobile FBUS——用来创建与NOKIA手机连接的软件的理想解决方案！功能包括：发送SMS

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.