tradeimage.pas

机房管理系统 是用VB设计的简单的管理系统

unit TradeImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls,Graphics;

type
  TTradeImg = class(TGraphicControl)
  private
    { Private declarations }
    frGlyph:TBitmap;
    bkGlyph:TBitmap;
    r:TRect;
    FAutoSize:Boolean;
    fOnClick, fOnDblClick: TNotifyEvent;
    fOnMouseDown, fOnMouseUp: TMouseEvent;
    fOnMouseMove: TMouseMoveEvent;
    InMousePress:boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetfrGlyph(Value: TBitmap);
    procedure SetbkGlyph(Value: TBitmap);
    procedure SetAutoSize(Value: Boolean);override;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
   property Action;
   property Align;
   property AutoSize:Boolean read FAutoSize write SetAutoSize default true;
   property Enabled;
   property frontGlyph: TBitmap read frGlyph write SetfrGlyph;
   property backGlyph: TBitmap read bkGlyph write SetbkGlyph;
   property ParentShowHint;
   property PopupMenu;
   property ShowHint;
   property Visible;
   property OnClick: TNotifyEvent read fOnClick write fOnClick;
   property OnDblClick: TNotifyEvent read fOnDblClick write fOnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDrag;
   {$IFNDEF VER80}
   property OnStartDrag;
   {$ENDIF}
   property OnMouseDown: TMouseEvent read fOnMouseDown write fOnMouseDown;
   property OnMouseMove: TMouseMoveEvent read fOnMouseMove write fOnMouseMove;
   property OnMouseUp: TMouseEvent read fOnMouseUp write fOnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Wuqiu', [TTradeImg]);
end;

procedure TTradeImg.CMEnabledChanged(var Message: TMessage);
begin
//  if (frGlyph<>nil)and self.Enabled  then
    Canvas.CopyRect(r, frGlyph.Canvas, r)
//  else
//    Canvas.CopyRect(r, bkGlyph.Canvas, r);
end;

procedure TTradeImg.CMMouseEnter(var Message: TMessage);
begin
  if (bkGlyph<>nil)and self.Enabled  then
    Canvas.CopyRect(r, bkGlyph.Canvas, r);
end;

procedure TTradeImg.CMMouseLeave(var Message: TMessage);
begin
  if (frGlyph<>nil)and self.Enabled  then
    Canvas.CopyRect(r, frGlyph.Canvas, r);
end;

constructor TTradeImg.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  frGlyph:=TBitmap.Create;
  bkGlyph:=TBitmap.Create;
  width:=25;
  height:=25;
  r:=Rect(0,0,width,height);
  cursor:=crHandPoint;
  Enabled :=true;
end;

destructor TTradeImg.Destroy;
begin
  frGlyph.Free;
  bkGlyph.Free;
  inherited Destroy;
end;

procedure TTradeImg.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Enabled then
  begin
    if Assigned(fOnMouseDown) then
      fOnMouseDown(Self, Button, Shift, X, Y);
    if (Button = mbLeft) then
    begin
      InMousePress := True;
      if (ssDouble in Shift) and Assigned(fOnDblClick) then
        fOnDblClick(Self);
    end;
  end;

end;

procedure TTradeImg.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(fOnMouseMove) then
    fOnMouseMove(Self, Shift, X, Y);

end;

procedure TTradeImg.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if InMousePress then
  begin
    InMousePress := False;
    if (X>=0)and(X<=Width)and(Y>0)and(Y<=Height) then
      if Assigned(fOnClick) then
        fOnClick(Self);
  end;
  if Assigned(fOnMouseUp) then
    fOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TTradeImg.Paint;
begin
    Canvas.CopyRect(r, frGlyph.Canvas, r);
end;

procedure TTradeImg.SetAutoSize(Value:boolean);
begin
  if FAutoSize<>Value then
  begin
    FAutoSize:=value;
    if value and (frGlyph<>nil) then
    begin
      width:=frGlyph.Width;
      height:=frGlyph.Height;
    end;
  end;
end;

procedure TTradeImg.SetbkGlyph(Value: TBitmap);
begin
  if bkGlyph <> Value then
  begin
    bkGlyph.Assign(Value);
    Invalidate;
  end;
end;

procedure TTradeImg.SetfrGlyph(Value: TBitmap);
begin
  if frGlyph <> Value then
  begin
    frGlyph.Assign(Value);
    if Value <>nil then
    begin
      frGlyph.Width := Value.Width;
      frGlyph.Height := Value.Height;
      if FAutoSize then
      begin
        width:=Value.Width;
        height:=Value.Height;
      end;
      r := Rect(0, 0, Value.Width, Value.Height);
    end;
    Invalidate;
  end;
end;

end.