Mausrad (mousewheel event ) in TFrame aktivieren

[decibel666]

Hallo!

Ich habe eine Form welche während der Laufzeit ein Frame erzeugt und dieses mit Elementen befüllt. Das alles funktioniert einwandfrei!
Jetzt würde ich aber auch gerne das generiete Frame per mousewheel event (mit Mausrad) scrollen! Ich habe das folgendes gefunden, der Code produziert aber leider einen Stockoverflow und ich weiss nicht warum, villeicht kann mir ja jemand helfen :

Code:

type
  TMainForm = class(TForm)
  private
    procedure MouseWheelHandler(var AMessage: TMessage); override;
  public
    { Public declarations }
  end;

implementation

procedure TMainForm.MouseWheelHandler(var AMessage: TMessage);
var
  Control: TWinControl;
begin
  Control := FindVCLWindow(SmallPointToPoint(TWMMouseWheel(AMessage).Pos));
  if Assigned(Control) then
  begin
    AMessage.Result := Control.Perform(CM_MOUSEWHEEL, AMessage.WParam,
      AMessage.LParam);
    if AMessage.Result = 0 then
      Control.DefaultHandler(AMessage);
  end
  else
    inherited MouseWheelHandler(AMessage);
end;

Vielen DAnk
DeCi

[TiGü]

1. Welche Delphi-Version?
2. Bitte Test-Projekt zum nachvollziehen anhängen.
Dazu DPR-, PAS- und DFM- zippen und anhängen.

Mit einen leeren Formular und diesen Code lässt sich nämlich nicht ein Stack Overflow reproduzieren.

[decibel666]

Version ist Delphi Version 7 Enterprise unter Windows 7 64Bit

Der Stackoverflow passiert bei mir auch wenn ich ein neues Projekt aufmache , ein Frame auf die Form lege und dann versuche mit dem Mouserad zu scrollen..

[TiGü]

Aha, das tritt tatsächlich nur mit den Frame auf.

Wahrscheinlich ruft Control.DefaultHandler immer wieder rekursiv TMainForm.MouseWheelHandler auf.
Versuche mal ggf. diesen Ausdruck nach der if-Abfrage wegzulassen.

Wenn unumgänglich, kannst du dir auch mit folgenden Workaround helfen.
Die Klassen-Variable FEntered ist von Typ Boolean, also im private-Abschnitt des Formular anlegen.

Delphi-Quellcode:

procedure TMainForm.MouseWheelHandler(var AMessage: TMessage);
var
  Control: TWinControl;
begin
  try
    if not FEntered then
    begin
      FEntered := True;
      Control := FindVCLWindow(SmallPointToPoint(TWMMouseWheel(AMessage).Pos));
      if Assigned(Control) then
      begin
        AMessage.Result := Control.Perform(CM_MOUSEWHEEL, AMessage.WParam, AMessage.LParam);
        if AMessage.Result = 0 then
          Control.DefaultHandler(AMessage);
      end
      else
        inherited MouseWheelHandler(AMessage);
    end;
  finally
    FEntered := False;
  end;
end;

[decibel666]

Vielen Dank!

Es kommt zwar kein Fehler mehr, funktioniert aber leider nicht

[TiGü]

Zitat von decibel666:

...funktioniert aber leider nicht

Welcher von den zwei angesprochenden Lösungen denn genau?