Rollover Bild? Theme ohne Komponenten

[Bummi]

vielleicht kann Dir dies nützen oder als Anregung dienen:

Delphi-Quellcode:

unit ExTransIntellibutton;
// 201009 Thomas Wassermann
// www.explido-software.de

interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
           ExtCtrls,StdCtrls,Dialogs;
type
TState=(stDeactivated, stFocused, stUnFocused, stPressed);
TExTransIntellibutton=Class(TGraphicControl)
  private
    FmouseDown : Boolean;
    FOnClick: TNotifyEvent;
    FPenWidth: Integer;
    FX,FY:Integer;
    FControlColor: TColor;
    FimageList:TimageList;
    FOffSetPoint: TPoint;
    FTimer1, FTimer2:TTimer;
    FRepeatClick: Boolean;
    FState: TState;
    FRepeatInterval2_ms: Integer;
    FUseTimer2After_MS: Integer;
    FRepeatInterval1_ms: Integer;
    Ftimer1Started:Cardinal;
    FEnabled: Boolean;
    FOnMouseUp: TNotifyEvent;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMMouseEnter(var Msg: TMessage); message $B013;
    procedure WM_MouseLeave(var Msg: TMessage); message $B014;

    procedure SetControlColor(const Value: TColor);

    procedure SetImageList(const Value: TImageList);
    procedure SetOffSetPoint(const Value: TPoint);

    function CalcCursorPos: TPoint;
    procedure Ftimer1OnTimer(Sender: Tobject);
    procedure Ftimer2OnTimer(Sender: Tobject);
    procedure SetRepeatClick(const Value: Boolean);
    procedure SetRepeatInterval1_ms(const Value: Integer);
    procedure SetRepeatInterval2_ms(const Value: Integer);
    procedure SetState(const Value: TState);
    procedure SetUseTimer2After_MS(const Value: Integer);
    procedure Click;
    procedure DeactivateTimers;
    procedure SetEnabled(const Value: Boolean);

    Protected
    procedure Paint; override;
    Public
    Constructor Create(AOwner:TComponent);override;
    Destructor Destroy ; Override;

    Published
    Property Align;
    Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
    Property OnMouseUp:TNotifyEvent Read FOnMouseUp Write FOnMouseUp;
    Property ImageList:TImageList read FImageList write SetImageList;
    Property OffSetPoint:TPoint read FOffSetPoint write SetOffSetPoint;
    Property ControlColor:Tcolor read FControlColor Write SetControlColor;
    Property State:TState read FState write SetState;
    Property RepeatClick:Boolean read FRepeatClick write SetRepeatClick;
    Property UseTimer2After_MS:Integer read FUseTimer2After_MS write SetUseTimer2After_MS;
    Property RepeatInterval1_ms:Integer read FRepeatInterval1_ms write SetRepeatInterval1_ms;
    Property RepeatInterval2_ms:Integer read FRepeatInterval2_ms write SetRepeatInterval2_ms;
    Property Enabled:Boolean read FEnabled write SetEnabled;
    property Visible;
End;

procedure Register;
implementation

{ ExTransIntellibutton }






constructor TExTransIntellibutton.Create(AOwner: TComponent);
begin
  inherited;
    visible := true;
    Width  := 25;
    Height := 25;
    FRepeatClick := true;
    FEnabled := true;
    FTimer1 := TTimer.Create(self);
    FTimer2 := TTimer.Create(self);
    State   := stUnFocused;
    UseTimer2After_MS := 1500;
    FRepeatInterval1_ms := 200;
    FTimer1.Interval := FRepeatInterval1_ms;
    Ftimer1.Enabled  := false;
    FRepeatInterval2_ms := 10;
    FTimer2.Interval := FRepeatInterval2_ms;
    Ftimer2.Enabled  := false;
    Ftimer1.OnTimer  := Ftimer1OnTimer;
    Ftimer2.OnTimer  := Ftimer2OnTimer;
end;


procedure TExTransIntellibutton.Click;
begin
  if Assigned(FonClick) then FonClick(self);

end;

procedure TExTransIntellibutton.DeactivateTimers;
begin
  FTimer2.enabled := false;
  FTimer1.enabled := false;
end;

procedure TExTransIntellibutton.Ftimer1OnTimer(Sender:Tobject);
begin
   if State = stPressed then Click else DeactivateTimers;
   if Ftimer1Started + UseTimer2After_MS < GetTickCount then
      begin
        FTimer1.Enabled := false;
        Ftimer2.Enabled := State = stPressed;
      end;

end;

procedure TExTransIntellibutton.Ftimer2OnTimer(Sender:Tobject);
begin
       if State = stPressed then Click else DeactivateTimers;
end;


destructor TExTransIntellibutton.Destroy;
begin
  DeactivateTimers;
  inherited;
end;


function TExTransIntellibutton.CalcCursorPos: TPoint;
begin
  GetCursorPos(Result);
  Result := ScreenToClient(Result);
end;


procedure TExTransIntellibutton.Paint;
var
  Index:Integer;
  s:String;
  mr:TRect;

begin
  Canvas.Brush.Style := bsClear;
  inherited;

    begin
        Canvas.Brush.Style := bsClear;
        Canvas.Font.Color := ControlColor;
        if Assigned(FimageList) and (FimageList.Count>3) then
            begin
              case State of
                stDeactivated: Index := 0;
                stUnFocused: Index := 1;
                stFocused: Index := 2;

                stPressed: Index := 3;
              end;
              FimageList.Draw(Canvas,FOffSetPoint.X ,FOffSetPoint.Y,Index);
            end
         else
            begin
               mr.Left   := 0;
               mr.Top    := 0;
               mr.Right  := width;
               mr.Bottom := Height;
               s := 'BITTE EINRICHTEN';
               Canvas.TextRect( mr , s,[tfVerticalCenter,tfCenter,tfSingleLine]);
            end;
    end;
end;


procedure TExTransIntellibutton.SetControlColor(const Value: TColor);
begin
  FControlColor := Value;
  invalidate;
end;


procedure TExTransIntellibutton.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
  if not Value then State := stDeactivated else State := stUnfocused;
end;

procedure TExTransIntellibutton.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  invalidate;
end;

procedure TExTransIntellibutton.SetOffSetPoint(const Value: TPoint);
begin
  FOffSetPoint := Value;
  invalidate;
end;






procedure TExTransIntellibutton.SetRepeatClick(const Value: Boolean);
begin
  FRepeatClick := Value;
end;

procedure TExTransIntellibutton.SetRepeatInterval1_ms(const Value: Integer);
begin
  FRepeatInterval1_ms := Value;
  FTimer1.Interval := FRepeatInterval1_ms;
end;

procedure TExTransIntellibutton.SetRepeatInterval2_ms(const Value: Integer);
begin
  FRepeatInterval2_ms := Value;
  FTimer2.Interval := FRepeatInterval2_ms;
end;

procedure TExTransIntellibutton.SetState(const Value: TState);
begin
  FState := Value;
  if state = stPressed then
    begin
    Click;
    if FRepeatClick then
      begin
      Ftimer2.Enabled := false;
      Ftimer1.Enabled := true;
      Ftimer1Started := getTickCount;
      end;
    end
  else
    begin
    DeactivateTimers;
    end;
  invalidate;
end;

procedure TExTransIntellibutton.SetUseTimer2After_MS(const Value: Integer);
begin
  FUseTimer2After_MS := Value;
end;

procedure TExTransIntellibutton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FmouseDown := true;
  With CalcCursorPos do
    begin
      FX := x;
      FY := Y;
      if Visible and Assigned(FimageList) and (FimageList.Count>3) then
          begin
            if Enabled then State := stPressed;
          end;
    end;
  inherited;
end;

procedure TExTransIntellibutton.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FmouseDown := false;
  if Enabled then State :=  stFocused;
  if Assigned(FOnMouseUp) then FOnMouseUp(Self);

  inherited;

end;

procedure TExTransIntellibutton.WMMouseEnter(var Msg: TMessage);
begin
    if  Enabled then State :=  stFocused;
end;

procedure TExTransIntellibutton.WMMouseMove(var Message: TWMMouseMove);
begin
   inherited;
end;
procedure TExTransIntellibutton.WM_MouseLeave(var Msg: TMessage);
begin
     if Enabled then State :=  stUnFocused;

end;

procedure Register;
begin
  RegisterComponents('Explido', [TExTransIntellibutton]);
end;

end.