Mausradbewegung erkennen

[BAMatze]

Hallo nochmal an alle,

noch ein Problemchen. Also ich möchte in einer Paintbox die WM_MouseWheel verwenden (Ziel ist es einen Zoom in das Bild zu ermöglichen). Dies funktioniert, allerdings nicht so gut, wie ich mir das dachte. Also hier mal schnell, was ich dazu gefunden hab oder besser was ich aus den Quellen produziert hab:

Delphi-Quellcode:

// Quellcode in der Paintbox
const MouseWheel = WM_MouseWheel;
      
type TOnZoomOut = procedure(Sender: TObject) of Object;
     TOnZoomIn = procedure(Sender: TObject) of Object;

Type TPaintboxPos = Class(TPaintbox)
  private
    FOnZoomIn: TOnZoomIn;
    FOnZoomOut: TOnZoomOut;
    procedure WMMouseWheel(var Msg: TWMMouseWheel); message MouseWheel;
  protected
    procedure doZoomIn;
    procedure doZoomOut;
  published
    property OnZoomIn: TOnZoomIn read FOnZoomIn write FOnZoomIn;
    property OnZoomOut: TOnZoomOut read FOnZoomOut write FOnZoomOut;
  public
    ...//unwichtiges Zeug entfernt
End;

implementation

...//unwichtiges Zeug entfernt

procedure TPaintboxPos.WMMouseWheel(var Msg: TWMMouseWheel);
begin
  // Welche Variable muss überprüft werden von MSG?
  if Msg.WheelDelta > 0 then doZoomOut
  else doZoomIn;
end;

procedure TPaintBoxPos.doZoomIn;
begin
  if assigned(FOnZoomIn) then FOnZoomIn(Self);
end;

procedure TPaintBoxPos.doZoomOut;
begin
  if assigned(FOnZoomOut) then FOnZoomOut(Self);
end;

end.

Ok so weit so gut, das mit der MSG.WheelDelta hatte ich mal getestet und zumindest in dem Test kam in eine Richtung das Rad gedreht positive Werte raus und in die andere Richtung negative. Das ist auch schonmal ein Ansatz, dass es funktioniert. Allerdings funktioniert das irgendwie nur sporadisch und wenn deutliche Bewegungen an dem Mausrad anliegen. Also denke ich mal, dass ich vieleicht noch nicht den optimalen Weg gewählt hab.

Da ich in der Oberklasse (für die die PaintBoxklasse geschrieben hab) einen Timer verwende, dachte ich anfangs, dass dieser den Ärger macht. Dies konnte aber nach ein paar Überlegungen und Test (Timer einfach off schalten) ausgeschlossen werden. Ich habe deswegen ein kleines Testprogramm mal zusammen gestellt und da sind mir die oben genannten Probleme aufgefallen.

Vieleicht sieht jemand, was ich noch falsch mache oder kann sich mal das kleine Testprojekt anschauen, in dem ich euch meinen Versuch zur Verfügung stelle.

Vielen Dank
BAMatze

[Tyrael Y.]

Ich glaube dein Problem liegt woanders, weil folgendes funtioniert einwandfrei.

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private-Deklarationen }
     number: Integer;

     procedure Add();
     procedure Minus();
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Add;
begin
  number := number + 1;
end;

procedure TForm1.Minus;
begin
  number := number - 1;
end;

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if WheelDelta > 1 then
     Add()
  else
    Minus();

  label1.Caption := inttostr(number);
end;

[BAMatze]

Naja das wollte ich ja eigentlich auch gar nicht behaupten, dass der Fehler woanders liegen könnte. Die Frage ist ja eigentlich nur wo :-D

[Edit] ok am WM_MouseWheel/ CM_MouseWheel lag es mal nicht[/Edit]

[Garfield]

Hallo,

das Testprojekt funktioniert bei mir unter TurboDelphi leider nicht. Vielleicht könntest Du das OnMouseWheel-Event aus TControl auswerten!?

[BAMatze]

Ja das werde ich jetzt mal probieren, das Event von der Form (im Testprogramm) auszuwerten. Aber stellt sich mir eigentlich die Frage, warum das CM_MouseWheel nichts macht? :?:

[Tyrael Y.]

Hm, kommt die Wheel Nachricht als Sendmessage oder als Postmessage an, das weiss ich selber gerade nicht?

Ich will darauf hinaus, daß SendMessage eine blockiert bis die Nachricht als empfangen gewertet wird.
Die Nachricht gilt als empfangen, wenn der MessageHandler abgearbeitet wurde.

Wenn ZoomIn und ZoomOut im selben Thread wie dieser MessageHandler sind, wird auf das Bestätigen gewartet bis ZoomIn bzw. ZoomOut durchlaufen worden sind.

Das bedeutet dieser Thread ist solange blockiert und neue Wheel Nachrichten werden nicht entgegen genommen.

Alles Vermuutungen.
Keine Ahnung, ob es stimmt.

[BAMatze]

Der Weg, den ich hier beschreite scheint so nicht machbar zu sein, hab nach etwas suchen hier einen anderen Threat gefunden, wo ähnliches schonmal besprochen wurde zwischen DeddyH und Baeuerle. Zumindest wird folgendes erwähnt:

Zitat:

Zitat:

Zitat von DeddyH

Versuch mal, in der Scrollbox die Message CM_MOUSEWHEEL abzufangen.

Zitat:

Zitat von Baeuerle

du meinst

Delphi-Quellcode:

TBlubViewer = class(TScrollBox) 
private
  procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
...

geht leider nicht, die Prozedur wird nicht erreicht..

Zitat:

Zitat von DeddyH

Wäre auch Quatsch, stelle ich gerade fest, TWinControl hat schon ein Event OnMouseWheel. Nur wird das hier unter Delphi 5 auch nicht ausgeführt :gruebel:

Hier auch nochmal der gesamte Threat.

Also muss ich wohl einen neuen Weg suchen.

Hat jemand einen Vorschlag?

Vielen Dank
BAMatze

[hadschi92]

Ich hab bei mir ein TImage und löse das Ganz so:

Delphi-Quellcode:

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  //Bild zoomen
  if ssCtrl in Shift then begin
    Image1.Left := Round(Image1.Left - (((Image1.Width * 1.1) - Image1.Width) / 2));
    Image1.Top := Round(Image1.Top - (((Image1.Height * 1.1) - Image1.Height) / 2));
    Image1.Width := Round(Image1.Width * 1.1);
    Image1.Height := Round(Image1.Height * 1.1);
  end;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  //Bild verkleinern
  if ssCtrl in Shift then begin
    Image1.Left := Round(Image1.Left + (((Image1.Width * 1.1) - Image1.Width) / 2));
    Image1.Top := Round(Image1.Top + (((Image1.Height * 1.1) - Image1.Height) / 2));
    Image1.Width := Round(Image1.Width / 1.1);
    Image1.Height := Round(Image1.Height / 1.1);
  end;
end;

Ja der Zoom ist ein wenig verbuggt, aber die Funktion funktioniert auf jeden Fall. Es wird gezoomt wenn Form1 den Focus hat und ich STRG + Mausrad drücke.

[mleyen]

Zitat:

Zitat von BAMatze

Hat jemand einen Vorschlag?

Ja.
Ich glaub ich hatte damals das selbe Problem, hab auch google/dp wie will durchstöbert und bin irgendwann auch ein paar Posts gestoßen, das Delphi intern irgendwas verwurschtelt. (Ich glaub das Handled war das Problem)
Naja auf jedenfall hatte ich letztendlich nur 3 wirklich funktionierende Möglichkeiten um die Mausscrollrichtung zu bekommen:
1. Die Form OnMouseWheelDown / Up - Events nutzen
2. In der Application.OnMessage Methode auf WM_MOUSEWHEEL reagieren und dabei wParamHi checken
3. Einen MouseHook schreiben

Natürlich fiel meine Wahl auf 2. aber eine andere Lösung für das Problem hab ich damals auch nicht gefunden.
Die Posts such ich jetzt aber nicht wieder alle zusammen. :P

[BAMatze]

Ok danke euch schonmal, werde ich mir mal anschauen eure Möglichkeiten. Muss aber auch nochmal schauen, wie ich das zoom zeichnen ordentlich realisiere. Einfach vergrößern sieht leider irgendwie sch...<piep> aus. Von daher noch eine Menge an Informationen, die ich sammeln muss.

Vielen Dank
BAMatze

[Garfield]

Du kannst Dir ja das mal ansehen: http://atorg.net.ru/delphi/atimagebox.htm

Da wird direkt von TGraphicControl abgeleitet und zum Zoomen wird in der Demo eine TTrackbar verwendet.