activebutton.pas

含此文档只表示此压缩包来自于DELPHI盒子网站 ------------------------------------------------------------------------

////////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   ActiveButton.pas
//  Creater     :   Shen Min
//  Date        :   2001-7-31
//  Comment     :
//
//
////////////////////////////////////////////////////////////////////////////////////

unit ActiveButton;

interface

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

type

    TActiveButton = class(TCustomPanel)
    private
        FPicOnMouseDown : TPicture;
        FPicOnMouseIn : TPicture;
        FPicDisabled : TPicture;
        FPicNormal : TPicture;
        FPicture : TPicture;

        FAutoSize : Boolean;
        FTransparent : Boolean;

        FMouseInFlag : Boolean;
        FTimer : TTimer;

        procedure PictureChanged(Sender: TObject);
        procedure MouseOut();
        procedure TimerProc(Sender: TObject);

        procedure SetPicOnMouseIn(Value : TPicture);
        procedure SetPicOnMouseDown(Value : TPicture);
        procedure SetPicDisabled(Value : TPicture);
        procedure SetPicNormal(Value : TPicture);

    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;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy(); override;

    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 SetAutoSize;
        property Transparent : Boolean Read FTransparent Write SetTransparent default false;
        property Enabled;

        property OnClick;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
    end;


procedure Register;

implementation

constructor TActiveButton.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    FPicOnMouseIn := TPicture.Create();
    FPicOnMouseDown := TPicture.Create();
    FPicDisabled := TPicture.Create();
    FPicNormal := TPicture.Create();

    FPicOnMouseIn.OnChange := PictureChanged;
    FPicOnMouseDown.OnChange := PictureChanged;
    FPicDisabled.OnChange := PictureChanged;
    FPicNormal.OnChange := PictureChanged;

    FPicture:= FPicNormal;

    BevelOuter := bvNone;
    Caption := ' ';
end;

destructor TActiveButton.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 TActiveButton.Paint(); //override
var
    Rect : TRect;
begin
    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 TActiveButton.PictureChanged(Sender: TObject);
begin
    RePaint();
end;

procedure TActiveButton.SetEnabled(Value: Boolean); //override
begin
    if (
        (not Value) and
        (Assigned(FPicDisabled.Graphic))
    ) then
        FPicture := FPicDisabled
    else
        FPicture := FPicNormal;

    RePaint();
    Inherited SetEnabled(Value);
end;

procedure TActiveButton.SetPicDisabled(Value: TPicture);
begin
    FPicDisabled.Assign(Value);

    RePaint();
end;

procedure TActiveButton.SetPicOnMouseDown(Value: TPicture);
begin
    FPicOnMouseDown.Assign(Value);
end;

procedure TActiveButton.SetPicOnMouseIn(Value: TPicture);
begin
     FPicOnMouseIn.Assign(Value);
end;

procedure TActiveButton.SetPicNormal(Value: TPicture);
begin
    FPicNormal.Assign(Value);

    RePaint();
end;

procedure TActiveButton.SetAutoSize(Value: Boolean);
begin
    FAutoSize := Value;

    RePaint();
end;

procedure TActiveButton.SetTransparent(const Value: Boolean);
begin
    FTransparent := Value;

    RePaint();
end;

procedure TActiveButton.MouseOut();
begin
    FMouseInFlag := false;
    FTimer.Free;
    FTimer := nil;

    if Enabled then
        FPicture := FPicNormal
    else
        FPicture := FPicDisabled;
    RePaint();
end;

procedure TActiveButton.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 > LeftTop.y)      and
        (CurPos.y < RightBottum.y)
    ) then
        Exit;   // in

    // out
    MouseOut();
end;

procedure Register;
begin
    RegisterComponents('Sunisoft', [TActiveButton]);
end;

procedure TActiveButton.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 TActiveButton.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 TActiveButton.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;

end.