qlxbutton.pas

进销存以及BOM管理,SQl Server数据库程序

unit Qlxbutton;

interface

uses
  Windows, Graphics, controls, Messages, SysUtils, Classes, ExtCtrls;

type
  Tlxbutton = class(TCustomPanel)
  private
    FPiconMouseDown:Tpicture;
    FPiconMousein:Tpicture;
    FPicDisabled:Tpicture;
    FPicNorMal:Tpicture;
    Fpicture:Tpicture;

    Fautosize:Boolean;
    Ftransparent:boolean;

    FmouseINflag:boolean;
    Ftimer:TTimer;

    procedure pictureChangeed(sender:Tobject);
    procedure Mouseout();
    procedure TimerProc(sender:Tobject);

    procedure setPiconMousein(Value:Tpicture);
    procedure setPiconMouseDown(Value:Tpicture);
    procedure setPicDisabled(Value:Tpicture);
    procedure setpicNormal(value:Tpicture);
    procedure setauotsize(const Value: boolean);
    { Private declarations }
  protected
    procedure MouseDown(Button:TmouseButton;shift:TshiftState;x,y:integer);override;
    procedure Mouseup(Button:Tmousebutton;shift:Tshiftstate;x,y:integer);override;
    procedure MouseMove(shift:TshiftState;x,y:integer);override;
    procedure setEnabled(Value:boolean);override;
    procedure setTransparent(const Value:boolean);virtual;
    procedure setAutosize(value:boolean);override;
    procedure paint();override;
    { Protected declarations }
  public
    constructor create(Aowner:Tcomponent);override;
    destructor Destroy();override;
    { Public declarations }
  published
    property piconMousein:Tpicture read FpicOnmousein write setPiconMousein;
    property piconMouseDown:Tpicture read FpiconmouseDown write setpiconMouseDown;
    property picDisabled:Tpicture read fpicdisabled write SetpicDisabled;
    property PicNormal:Tpicture Read fpicnormal write setpicnormal;

    property autosize:boolean read fautosize write setauotsize;
    property transparent:boolean read Ftransparent write settransparent default false;

    property enabled;
    property Onclick;
    property onMousedown;
    property onMouseMove;
    property onMouseup;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('liuxiangvcl', [Tlxbutton]);
end;

{ Tlxbutton }

constructor Tlxbutton.create(Aowner: Tcomponent);
begin
  inherited Create(Aowner);
  FpicOnMouseIn:=Tpicture.Create();
  FpicOnMouseDown:=Tpicture.Create();
  FpicDisabled:=Tpicture.Create();
  FpicNormal:=Tpicture.Create();

  FpiconMousein.OnChange:=pictureChangeed;
  FpiconMouseDown.OnChange:=pictureChangeed;
  FpicDisabled.OnChange:=pictureChangeed;
  FpicNormal.OnChange:=pictureChangeed;

  Fpicture:=FpicNormal;

  BevelOuter:=bvNone;

  Caption:='';

end;

destructor Tlxbutton.Destroy;
begin
  Ftimer.Free();
  Ftimer:=nil;

  FpicNormal.Free();
  FpicNormal:=nil;

  FpicDisabled.Free();
  FpicDisabled:=nil;

  FpiconMouseDown.Free();
  FpiconMouseDown:=nil;

  FpiconMousein.Free();
  FpiconMousein:=nil;

  Fpicture:=nil;

  inherited Destroy();
end;

procedure Tlxbutton.MouseDown(Button: TmouseButton; shift: TshiftState; x,
  y: integer);
begin
  if Button=mbLeft then
    begin
      if (
        Assigned(Fpiconmousedown.Graphic) and
        Enabled
        )      then
        begin
          Fpicture:=FpicOnMouseDown;
          Repaint();
        end;
    end;
    Inherited;
end;

procedure Tlxbutton.MouseMove(shift: TshiftState; x, y: integer);
begin
  if (
    (x<0) or
    (y<0) or
    (x>width) or
    (y>height)
    )         then
    begin
      Mouseout();
      inherited;
      Exit;
    end;

    if (
       (FmouseInflag) or
       (not Enabled) or
       (FpiconMousein.Graphic=nil)
        )                        then
        begin
          inherited;
          exit;
        end;

        FmouseinFlag:=True;
        if (
          Assigned(FpiconMousein.Graphic) and
            Enabled
          )        then
          begin
            Fpicture:=FpiconMousein;
            Repaint();
          end;

      if (
          (Ftimer=nil) and
          assigned(Fpiconmousein.Graphic)
          )                             then
          begin
            Ftimer:=TTimer.Create(nil);
            Ftimer.Interval:=168;
            Ftimer.OnTimer:=Timerproc;
          end;


  inherited;

end;

procedure Tlxbutton.Mouseout;
begin
  FmouseinFlag:=False;
  Ftimer.Free;
  Ftimer:=nil;

  if Enabled then
    Fpicture:=FpicNormal
  else
    Fpicture:=FpicDisabled;
  Repaint();
end;

procedure Tlxbutton.Mouseup(Button: Tmousebutton; shift: Tshiftstate; x,
  y: integer);
begin
  if (
    (x<0) or
    (y<0) or
    (x>width) or
    (y>height)
    )        then
    exit;

  if Button=mbLeft then
  begin
    if (
      (FmouseinFlag) and
      (assigned(FpicOnMousein.Graphic)) and
      Enabled
      )      then
      Fpicture:=FpiconMousein
      else
      if enabled then
        Fpicture:=FpicNormal
          else
          Fpicture:=FpicDisabled;
      repaint();
  end;


  inherited;

end;

procedure Tlxbutton.paint;
var
  Rect:Trect;
begin
  inherited;
  if Assigned(Fpicture.Graphic) then
    begin
      Canvas.Brush.Style:=bsClear;
      canvas.Font:=Font;
      if Fpicture.Graphic.Transparent<>Ftransparent then
        fpicture.Graphic.Transparent:=Ftransparent;
      if Fautosize then
        begin
          Height:=Fpicture.Height;
          Width:=Fpicture.Width;
        end;
      Canvas.StretchDraw(ClientRect,Fpicture.Graphic);
      Rect:=GetclientRect();
      DrawText(
              canvas.Handle,
              pchar(caption),
              -1,
              Rect,
              DT_CENTER or DT_SINGLELINE or DT_VCENTER
              );
    end
    else
      inherited paint();
end;

procedure Tlxbutton.pictureChangeed(sender: Tobject);
begin
  rePaint()
end;

procedure Tlxbutton.setauotsize(const Value: boolean);
begin
  fautosize := Value;
end;

procedure Tlxbutton.setAutosize(value: boolean);
begin
  inherited;
  Fautosize:=Value;
  Repaint();
end;

procedure Tlxbutton.setEnabled(Value: boolean);
begin
  inherited;
  if (
    (not Value) and
    (Assigned(FpicDisabled.Graphic))
    ) then
    Fpicture:=FpicDisabled
    else
    Fpicture:=FpicNormal;

    Repaint();
    inherited setEnabled(Value);
end;

procedure Tlxbutton.setPicDisabled(Value: Tpicture);
begin
  FpiCDisabled.Assign(Value);
  Repaint();
end;

procedure Tlxbutton.setpicNormal(value: Tpicture);
begin
  FpicNormal.Assign(Value);
  rePaint();
end;

procedure Tlxbutton.setPiconMouseDown(Value: Tpicture);
begin
  FpiconMouseDown.Assign(Value);
end;

procedure Tlxbutton.setPiconMousein(Value: Tpicture);
begin
  FpiconMousein.Assign(Value);
end;

procedure Tlxbutton.setTransparent(const Value: boolean);
begin
  Ftransparent:=Value;
  rePaint();
end;

procedure Tlxbutton.TimerProc(sender: Tobject);
var
  curpos:Tpoint;
  LeftTop:Tpoint;
  RightBottum:Tpoint;
begin
  Lefttop.X:=0;
  Lefttop.Y:=0;
  rightbottum.X:=Width;
  rightbottum.Y:=height;
  Getcursorpos(curPos);

  if Parent<>nil then
    begin
      Lefttop:=Clienttoscreen(Lefttop);
      Rightbottum:=Clienttoscreen(Rightbottum);
    end
    else
      Mouseout();

    if (
      (Curpos.X > lefttop.X) and
      (curpos.X < rightbottum.x) and
      (curpos.Y > rightbottum.Y) and
      (curpos.Y < rightbottum.Y)
      ) then
      exit;

      MouseOut();
end;

end.