Hallo Andreas,
ich weiß nicht ob ich dein Problem richtig verstanden habe.
Aber wenn ich das Zeichnen in die Paint Methode packe reagiert bei mir der Button auf den Klick.
Code: Alles auswählen
unit ImgButton;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls;
const
nothing = 0;
down = 1;
up = 2;
type
{ TImgButton }
TImgButton = class(TCustomImage)
private
FBorder: integer;
FColor: TColor;
FImageIndex: integer;
FImageList: TImageList;
modus : byte;
procedure InMouseDown;
procedure InMouseEnter;
procedure InMouseLeave;
procedure InMouseUp;
protected
procedure Click; override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure Paint;override;
public
constructor Create(AOwner: TComponent); override;
published
property Border: integer read FBorder write FBorder default 3;
property Color: TColor read FColor write FColor default clDefault;
property ImageIndex: integer read FImageIndex write FImageIndex default -1;
property ImageList: TImageList read FImageList write FImageList default nil;
// stolen from TImage in ExtCtrl
property AntialiasingMode;
property Align;
property Anchors;
property AutoSize;
property BorderSpacing;
property Center;
property KeepOriginXWhenClipped;
property KeepOriginYWhenClipped;
property Constraints;
property DragCursor;
property DragMode;
property Enabled;
property OnChangeBounds;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaint;
property OnPictureChanged;
property OnPaintBackground;
property OnResize;
property OnStartDrag;
property ParentShowHint;
property Picture;
property PopupMenu;
property Proportional;
property ShowHint;
property Stretch;
property StretchOutEnabled;
property StretchInEnabled;
property Transparent;
property Visible;
end;
procedure Register;
implementation
uses
Types;
procedure Register;
begin
{$I imgbutton_icon.lrs}
RegisterComponents('AF',[TImgButton]);
end;
{ TImgButton }
procedure TImgButton.Click;
begin
InMouseDown;
inherited Click;
Invalidate;
end;
procedure TImgButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
InMouseDown;
inherited MouseDown(Button, Shift, X, Y);
Invalidate;
end;
procedure TImgButton.InMouseDown;
begin
if (ImageList <> nil) and (ImageIndex >= 0) then begin
if (ImageIndex < ImageList.Count) then begin
modus:=down;
//ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(0, 0, self.Width, self.Height),true);
self.Invalidate;
end;
end;
Invalidate;
end;
procedure TImgButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
InMouseUp;
inherited MouseUp(Button, Shift, X, Y);
Invalidate;
end;
procedure TImgButton.InMouseUp;
begin
if PtInRect(self.BoundsRect, ScreenToClient(Mouse.CursorPos)) then
InMouseEnter
else
InMouseLeave;
Invalidate;
end;
procedure TImgButton.MouseEnter;
begin
InMouseEnter;
inherited MouseEnter;
Invalidate;
end;
procedure TImgButton.InMouseEnter;
begin
if (ImageList <> nil) and (ImageIndex >= 0) then begin
if (ImageIndex < ImageList.Count) then begin
modus:=up;
{
Self.Canvas.Brush.Color:= Color;
Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border, Border, self.Width-Border, self.Height-Border),true);
}
end;
end;
Invalidate;
end;
procedure TImgButton.MouseLeave;
begin
inherited MouseLeave;
InMouseLeave;
end;
constructor TImgButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
modus:=nothing;
InMouseLeave;
end;
procedure TImgButton.InMouseLeave;
begin
if (ImageList <> nil) and (ImageIndex >= 0) then begin
if (ImageIndex < ImageList.Count) then begin
//ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border div 2, Border div 2, self.Width-(Border div 2), self.Height-(Border div 2)),true);
end;
end;
Invalidate;
end;
procedure TImgButton.Paint;
begin
inherited;
self.Canvas.Brush.Color:=clwhite;
self.Canvas.Rectangle(0,0,self.Width,self.Height);
if modus=down then
ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(0, 0, self.Width, self.Height),true);
if modus= up then
begin
Self.Canvas.Brush.Color:= cllime;
Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(20, 20, self.Width-20, self.Height-20),true);
end;
end;
end.
Vielleicht bringt dich das auf die richtige Idee.
Viele Grüße
Bernd
Verein
Links
