AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Immer im Control unter dem Mauszeiger scrollen

Immer im Control unter dem Mauszeiger scrollen

Ein Thema von himitsu · begonnen am 19. Nov 2010 · letzter Beitrag vom 30. Mai 2011
Antwort Antwort
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
34.931 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#1

Immer im Control unter dem Mauszeiger scrollen

  Alt 19. Nov 2010, 22:48
Einige finden es bestimmt nervig, daß immer im Control mit dem Eingabefokus gescrollt wird und nicht dort, worüber sich der Mauszeiger befindet.

Hier ist also eine mögliche einfache Lösung dafür:
Delphi-Quellcode:
Procedure TForm1.MessageEvent(Var Msg: TMsg; Var Handled: Boolean);
  Var H: HWND;

  Begin
    If ((Msg.message = WM_MOUSEWHEEL) or (Msg.message = WM_MOUSEHWHEEL))
        and (Msg.wParam and MK_CONTROL = 0) Then Begin
      H := WindowFromPoint(Msg.pt);
      If (H = 0) or ((Msg.hwnd <> H) and (GetWindowThreadProcessId(H, nil) <> GetCurrentThreadId)) Then Begin
        Msg.hwnd := 0;
        Msg.message := WM_NULL;
        Handled := True;
      End Else Msg.hwnd := H;
    End;
  End;
Und dann natürlich noch Application.OnMessage := MessageEvent; .

Achtung: Wenn noch was Anderes dem Application.OnMessage zugewiesen ist/wird, dann muß man dieses mit beachten.


Ach ja, dieser Code leitet die Scrollereignisse immer nur im eigenem Programm weiter.
Es wird also nichts an fremde Programme übergeben. (stattdessen würde das Scrollergeignis verworfen)
Und das auch nur, wenn das eigene Programm den Eingabefokus besitzt.
(sonst empfängt es ja keines der nötigen Ereignisse)

[add]
Durch Drücken der [Strg/Ctrl]-Taste kann man die Umleitung nun auch vorübergehend deaktivieren.
Angehängte Dateien
Dateityp: 7z ScrollDemo.7z (152,6 KB, 17x aufgerufen)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
Delphi-Tage 2005-2014

Geändert von himitsu (20. Nov 2010 um 14:25 Uhr)
  Mit Zitat antworten Zitat
wolfgang_SV

Registriert seit: 9. Nov 2007
Ort: Neumünster
39 Beiträge
 
#2

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 20. Nov 2010, 13:53
Dein Beispiel hat einen schweren Bug.

GetWindowLong(H, GWL_HINSTANCE) und HInstance können den gleichen
Wert haben.

Da unter 32-Bit Windows jeder Prozess in seinem eigenen Adressraum läuft und HInstance der Basisadresse entspricht, an die ein Prozess geladen wurde (Die in den meisten Fällen 0x00400000 sein wird, da dies die standard Adresse ist, an der ein Prozess geladen wird.), kann man damit natürlich einen Prozess nicht mehr eindeutig identifizieren.

Das heißt, dass verschiedene Anwendungen den gleichen Hinstance-Wert
haben können...

Geändert von wolfgang_SV (20. Nov 2010 um 14:18 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
34.931 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#3

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 20. Nov 2010, 14:31
Joar, ich wollte gestern auch das ProcessHandle, bzw die ProcessID verwenden, aber fand es nicht schnell genug.
Nja, und das HInstance lief halt auch ... nur daran hatte ich garnicht gedacht.

Aber jetzt hab ich doch nochmal gesucht und verwende nun lieber die ThreadID.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
Delphi-Tage 2005-2014
  Mit Zitat antworten Zitat
wolfgang_SV

Registriert seit: 9. Nov 2007
Ort: Neumünster
39 Beiträge
 
#4

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 20. Nov 2010, 17:11
mit der ThreadID funtioniert es fehlerfrei..

aber was mir jetzt aufgefallen ist , versteh ich überhaupt nicht..

wenn ich den Focus auf ein dbgrid setze, funktioniert das Weiterleiten
auf ein anders Control nicht mehr.

die Scroll-message bleibt trotzdem im dbgrid hängen..

nehm ich den Focus wieder aus dem dbgrid raus, funktionierts wieder.

Vielleicht hast du ne Ahnung...
  Mit Zitat antworten Zitat
Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#5

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 20. Nov 2010, 17:14

wenn ich den Focus auf ein dbgrid setze, funktioniert das Weiterleiten
auf ein anders Control nicht mehr.
Hilft das? http://delphi.about.com/cs/adptips20...ltip1102_3.htm
Thomas
  Mit Zitat antworten Zitat
wolfgang_SV

Registriert seit: 9. Nov 2007
Ort: Neumünster
39 Beiträge
 
#6

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 20. Nov 2010, 17:24
danke für den Tipp.
aber das kenn ich schon und hab es bei mir auch schon implementiert.
Doch das ist nicht das Problem...
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
3.679 Beiträge
 
Delphi XE3 Ultimate
 
#7

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 29. Mai 2011, 17:35
Gibt es auch eine Lösung für (mehrere) Scrollboxen?
Ich will also nicht prüfen müssen, ob Handle = ScrollBox1.Handle oder ScrollBox2.Handle ist o.ä.
Anbei mal ein XE-Testprojekt.
Ich dachte, so sollte es funktionieren!? Ob man mit SendMessage o.ä. weiter kommt?


EDIT: Anhang entfernt (später neu)
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)

Geändert von stahli (30. Mai 2011 um 13:35 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
34.931 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#8

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 29. Mai 2011, 18:10
eigenlich sollte es egal sein, ob eine oder mehrere Scrollboxen,

aber wenn der Mauszeiger nicht über der Scrollbox, sondern auf etwas Anderem liegt und dieses das Scrollereignis an die Scrollbox weiterreicht, dann geht's natürlich nicht.

In diesem Fall müßte myn irgendwie prüfen, oder das Control (H) Scrollereignisse verarbeiten kann/tut und wenn nicht, dann den Parent prüfen und sich so bis zur ScrollBox vorarbeiten.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
Delphi-Tage 2005-2014
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
3.679 Beiträge
 
Delphi XE3 Ultimate
 
#9

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 29. Mai 2011, 18:26
So dachte ich das ja.
Die ScrollBox finde ich auch. Sie erhält aber das Scrollereignis nicht (auch mit Perform nicht)!?
Ich bin mit den Messages nicht so vertraut und kann nicht erkennen, wo es da klemmt:

Delphi-Quellcode:
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MessageEvent(var Msg: TMsg; var Handled: Boolean);
Var
  H: HWND;
  C: TControl;
  WC: TWinControl;

  function GetParentScrollBox(WC: TWinControl): TWinControl;
  begin
    Result := WC;
    if (not (WC is TScrollBox)) and (WC.Parent <> nil) then
      Result := GetParentScrollBox(WC.Parent);
  end;

begin
  if ((Msg.Message = WM_MOUSEWHEEL) or (Msg.Message = WM_MOUSEHWHEEL)) and (Msg.wParam and MK_CONTROL = 0) then
  begin
    H := WindowFromPoint(Msg.Pt);
    C := FindControl(H);
    if C is TWinControl then
    begin
      WC := GetParentScrollBox(C as TWinControl);
      if WC <> nil then
      begin
// WC.Perform(Msg.Message, Msg.wParam, Msg.lParam);
// H := 0;
        H := WC.Handle;
      end;
    end;
    if (H = 0) or ((Msg.HWND <> H) and (GetWindowThreadProcessId(H, nil) <> GetCurrentThreadId)) then
    begin
      Msg.HWND := 0;
      Msg.message := WM_NULL;
      Handled := True;
    end
    else
      Msg.HWND := H;
  end;
end;

procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox).VertScrollBar.Position + Mouse.WheelScrollLines;
end;

procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox).VertScrollBar.Position - Mouse.WheelScrollLines;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MessageEvent;
end;
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)

Geändert von stahli (29. Mai 2011 um 18:31 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
3.679 Beiträge
 
Delphi XE3 Ultimate
 
#10

AW: Immer im Control unter dem Mauszeiger scrollen

  Alt 30. Mai 2011, 13:34
Genial, so klappt es wunderbar!
Allerdings eher realisiert durch Versuch+Irrtum als durch ein komplexes Verständnis der Zusammenhänge

Ich habe mal die zwei VCL-Wheel-Handler angesehen und eine passende Lösung zusammengestrickt.
Falls jemand noch etwas optimieren kann, immer her damit...

Delphi-Quellcode:
// Die VCL-Wheel-Handler:

procedure TControl.MouseWheelHandler(var Message: TMessage);
var
  Form: TCustomForm;
  Capture: TControl;
begin
  Form := GetParentForm(Self);
  Capture := GetCaptureControl;
  if Assigned(Capture) and (Capture <> Form) and (Capture <> Self) and (Capture.Parent = nil) then
    Capture.WndProc(Message);
  if Message.Result = 0 then
  begin
    if (Form <> nil) and (Form <> Self) then
      Form.MouseWheelHandler(Message)
    else
      Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
  end;
end;

procedure TCustomForm.MouseWheelHandler(var Message: TMessage);
begin
  with Message do
  begin
    if FFocusedControl <> nil then
      Result := FFocusedControl.Perform(CM_MOUSEWHEEL, WParam, LParam)
    else
      inherited MouseWheelHandler(Message);
  end;
end;
Hier die Formularunit. Projekt+Exe nochmal im Anhang.

Delphi-Quellcode:
unit fScrollTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Panel11: TPanel;
    Panel12: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    ScrollBox2: TScrollBox;
    Panel2: TPanel;
    Panel13: TPanel;
    Panel14: TPanel;
    Panel15: TPanel;
    Panel16: TPanel;
    Panel17: TPanel;
    Panel18: TPanel;
    Panel19: TPanel;
    Panel20: TPanel;
    Panel21: TPanel;
    Panel22: TPanel;
    Edit3: TEdit;
    Button2: TButton;
    ScrollBox3: TScrollBox;
    Panel23: TPanel;
    Panel24: TPanel;
    Panel25: TPanel;
    Panel26: TPanel;
    Panel27: TPanel;
    Panel28: TPanel;
    Panel29: TPanel;
    Panel30: TPanel;
    Panel31: TPanel;
    Panel32: TPanel;
    Panel33: TPanel;
    Edit4: TEdit;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    procedure MessageEvent(var Msg: TMsg; var Handled: Boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MessageEvent(var Msg: TMsg; var Handled: Boolean);
Var
  H: HWND;
  C: TControl;
  WC: TWinControl;
  I: Integer;

  function GetParentScrollBox(WC: TWinControl): TWinControl;
  begin
    Result := WC;
    if (not(WC is TScrollBox)) and (WC.Parent <> nil) then
      Result := GetParentScrollBox(WC.Parent);
  end;

begin
  if ((Msg.Message = WM_MOUSEWHEEL) or (Msg.Message = WM_MOUSEHWHEEL)) and
    (Msg.wParam and MK_CONTROL = 0) then
  begin
    H := WindowFromPoint(Msg.Pt);
    C := FindControl(H);
    if C is TWinControl then
    begin
      WC := GetParentScrollBox(C as TWinControl);
      if WC <> nil then
      begin
        for I := 0 to Mouse.WheelScrollLines do
          WC.Perform(CM_MOUSEWHEEL, Msg.wParam, Msg.lParam); // Msg.Message funktioniert nicht
        H := 0;
      end;
    end;
    if (H = 0) or ((Msg.HWND <> H) and (GetWindowThreadProcessId(H, nil) <>
      GetCurrentThreadId)) then
    begin
      Msg.HWND := 0;
      Msg.Message := WM_NULL;
      Handled := True;
    end
    else
      Msg.HWND := H;
  end;
end;

procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox)
    .VertScrollBar.Position + Mouse.WheelScrollLines;
end;

procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox)
    .VertScrollBar.Position - Mouse.WheelScrollLines;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MessageEvent;
end;

end.


EDIT: In der Schleife
Delphi-Quellcode:
for I := 1 to Mouse.WheelScrollLines do
  WC.Perform(CM_MOUSEWHEEL, Msg.wParam, Msg.lParam); // Msg.Message funktioniert nicht
muss man ab 1 zählen.

PS: TScrollBox sollte einen AutoWheel-Modus erhalten.
Angehängte Dateien
Dateityp: zip ScrollTest.zip (577,2 KB, 8x aufgerufen)
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)

Geändert von stahli (30. Mai 2011 um 13:56 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf