Komponente verpennt Mausklick??

[phlux]

Sers :hi:
Also ich habe eine Komponente abgeleitet von TCustomControl die wie eine Art Button funktioniert, jedoch passiert es, wenn ich drauf klicke nichts passiert, sondern erst nach dem 2ten klicken OnClick ausgeführt wird. Den Event OnClick habe ich einfach vererben lassen. Weiß jemand rat wie ich das beheben kann?

mfg phlux :hi:

[SirThornberry]

wird das OnClick gar nicht ausgelöst (würde mich wundern). Wenn doch wäre der einfachste Weg das ganze zu debuggen... Ohne etwas source kann man für deinen Fall kaum sagen wo der Fehler liegt.

[phlux]

Doch doch OnClick wird ausgelöst sonst würd ich nicht den Beep; hören :lol:

Hier mal der Code:

Delphi-Quellcode:

unit ImageButton;

interface

uses
  SysUtils, Classes, Controls, Windows, Graphics, Messages{, Dialogs};

type
  TButtonState = (bsNormal, bsHot, bsDown);
  TImageButton = class(TCustomControl)
  private
    { Private-Deklarationen }
    fGlyph: TBitmap;
    fButtonState: TButtonState;
    fMouseIn: Boolean;
    procedure SetGlyph(aGlyph: TBitmap);
    procedure SetButtonState(aState: TButtonState);
    procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(var Msg: TMessage); message WM_LBUTTONDOWN;
    procedure MouseUp(var Msg: TMessage); message WM_LBUTTONUP;
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property Glyph: TBitmap read fGlyph write SetGlyph;
    property ButtonState: TButtonState read fButtonState write SetButtonState;
    // Vererbte Properties
    property OnClick;
    property Align;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TImageButton]);
end;

constructor TImageButton.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fGlyph := TBitmap.Create;
  Width := 21;
  Height := 21;
  fButtonState := bsNormal;
  fMouseIn := False;
  Align := alRight;
end;

destructor TImageButton.Destroy;
begin
  inherited Destroy;
  fGlyph.Free;
end;

procedure TImageButton.SetGlyph(aGlyph: TBitmap);
begin
  if aGlyph <> fGlyph then
    fGlyph.Assign(aGlyph);
  invalidate;
end;

procedure TImageButton.Paint;
begin
  if fGlyph.Handle <> 0 then
  begin
    case fButtonState of
      bsNormal: begin
                  BitBlt(Canvas.Handle, 0, 0, Width, Height, fGlyph.Canvas.Handle, 0, 0, SRCCOPY);
                end;
      bsHot: begin
               BitBlt(Canvas.Handle, 0, 0, Width, Height, fGlyph.Canvas.Handle, fGlyph.Height * 1, 0, SRCCOPY);
             end;
      bsDown: begin
                BitBlt(Canvas.Handle, 0, 0, Width, Height, fGlyph.Canvas.Handle, fGlyph.Height * 2, 0, SRCCOPY);
              end;
    end;
  end;
  inherited Paint;
end;

procedure TImageButton.SetButtonState(aState: TButtonState);
begin
  if fButtonState <> aState then
    fButtonState := aState;
  invalidate;
end;

procedure TImageButton.MouseEnter(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
    SetButtonState(bsHot);
  fMouseIn := True;
  inherited;
end;

procedure TImageButton.MouseLeave(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
    SetButtonState(bsNormal);
  fMouseIn := False;
  inherited;
end;

procedure TImageButton.MouseDown(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
    SetButtonState(bsDown);
  inherited;
end;

procedure TImageButton.MouseUp(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
  begin
    if fMouseIn then SetButtonState(bsHot) else
      SetButtonState(bsNormal);
  end;
  inherited;
end;

end.

Ich vermute es liegt daran, dass ich bei den letzten 4 Prozeduren die Nachricht nicht richtig weitergebe, nachdem ich sie abgefangen habe :stupid:

[SirThornberry]

warum nutzt du nicht einfach das OnMouseDown und OnMouseUp??????

[phlux]

hmm.. stimmt könnt ich eigentlich tun ;) war wohl grad so in dem run events abzufangen :stupid:
ich melde mich, wenns immer noch ned klappt.