{$A+,B-,D+,F-,G+,I-,L+,N-,P+,Q-,R-,S-,T+,V+,X+,Y+}
{$M 8192,0} {kein Heap}
{$DEFINE IE_HANDLER} {allerdings ist's nicht für RTL-Darstellung!}
{Wird eigentlich nur unter Windows95, nicht 98, gebraucht.}
library typhoon;
{Im Gegensatz zu dem, was der Name impliziert, läuft dieses nützliche
Programm anscheinend mit JEDER Rollmaus - und verhilft jedem noch
so alten Windows-Programm zur gewünschen Funktion.
Version 1.1 (06/02): "Schlauere", jedoch noch nicht perfekte Erkennung
rollfähiger Fenster, verhindert Disaster mit Win95-Desktop
Version 1.2 (08/02): Sonderfall: IE_Handler, getestet mit MSIE 5.0}
{$W-,K+}
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D 5-Tasten-Rollrad-Maus-Treiber}
{$R Typhoon} {Versionsinformation}
{Eine (normale) Drei-Tasten-Maus liefert folgende Codes an Mouse_Event:
Aktion AX BX CX (alles hex.)
Bewegung 0001 DeltaX DeltaY *
Linke Taste drücken 0002 0000 0000 *
Linke Taste loslassen 0004 0000 0000 *
Rechte Taste drücken 0008 0000 0000 *
Rechte Taste loslassen 0010 0000 0000 *
Mittlere Taste drücken 0020 0000 0000
Mittlere Taste losl. 0040 0000 0000
* auf MSDN-CD so dokumentiert
Diese Maus liefert unter Windows95A folgende Extra-Codes an Mouse_Event:
Aktion AX SI DI (alles hex.)
Rollrad weg (hoch) 0040 0078 4001 0078h=+120
Rollrad hin (runter) 0040 FF88 4001 FF88h=-120
Linke X-Taste drücken 0040 0100 4002
Linke X-Taste losl. 0040 0200 4002
Rechte X-Taste drücken 0040 0400 4002
Rechte X-Taste losl. 0040 0800 4002
Als DX wird dennoch stets 0003 (=3 Tasten) übergeben.
Aufgrund der speziellen Prozedur-Anzapfung ist der Treiber-Einsprung
nicht vernünftig zu debuggen, selbst SoftICE macht Probleme.
Womit belegt man eigentlich die X-Buttons?
Da sie bei dieser Maus relativ leicht ungewollt betätigt werden können,
liegt die Belegung mit SHIFT und CONTROL nahe.
Ansonsten ist der rechte X-Button auch ein Kandidat für SHIFT+RButton
für den Aufruf von Babylon.
Purer Luxus wäre die Zuordnung von WM_Command-IDs je nach Programm,
z.B. mit Anlernen durch langes Festhalten auf einem Menüpunkt oder
Toolbar-Knopf.
Ab Win98 werden auch WM_XButtonDown usw. unterstützt, aber von welchem
Programm? Explorer?
}
uses WinProcs,WinTypes,Win31;
var
ScrollWidth: Integer;
Hook: HHook;
type
PtrRec=record
Ofs,Sel:Word;
end;
LongRec=record
lo,hi: Word;
end;
WordRec=record
lo,hi: Byte;
end;
var
lasthitcode:Word; {Merker, weil Win98-Maustreiber zu doof}
lastwnd: HWnd; {bei HTNowhere ist das Fenster =GetActiveWindow}
function CheckScrollBar(Wnd:HWnd):Byte;
var
classname: array[0..11] of Char;
begin
CheckScrollBar:=0;
GetClassName(Wnd,classname,sizeof(classname));
if lstrcmpi('ScrollBar',classname)=0 then begin
if GetWindowLong(Wnd,GWL_Style) and SBS_Vert <>0
then CheckScrollBar:=2
else CheckScrollBar:=1;
end;
end;
function HasSiblingScrollBar(Wnd:HWnd; var WScroll:HWnd):Byte;
{Stellt fest, ob das Fenster <Wnd> Rollbalken als Nachbarn hat,
welche an das übergeordnete Fenster WM_HScroll oder WM_VScroll
senden könnten. Wenn ja, wird das Handle in <WScroll> geschrieben.
Findet auch die links befindlichen Rollbalken in RTL-Fenstern.}
var
hsw,vsw:HWnd;
begin
HasSiblingScrollBar:=0;
Wnd:=GetWindow(Wnd,GW_HWndFirst);
while Wnd<>0 do begin
asm push [Wnd]
call CheckScrollBar
mov dx,[Wnd]
test al,1
jz @@n1
mov [hsw],dx
@@n1: test al,2
jz @@n2
mov [vsw],dx
@@n2: or [@Result],al
end;
Wnd:=GetWindow(Wnd,GW_HWndNext);
end;
asm test [@Result],2 {Ein vertikaler?}
mov ax,[vsw]
jnz @@1 {ja, hat Vorzug}
mov ax,[hsw]
@@1: les di,[WScroll]
stosw {zurückgeben!}
end;
end;
function idiv2(x: Integer):Integer;
{weil Turbo's shr nicht arithmetisch schiebt!}
inline($58/$D1/$F8); {pop ax; sar ax,1}
function Point_Finder(Wnd:HWnd; var WScroll:HWnd):Byte;
{Ermittelt das Fenster, das sich RECHTS oder UNTEN befindet}
var
tmp: HWnd;
P: TPoint;
R: TRect;
begin
Point_Finder:=0;
{ Top:=Wnd;
repeat
tmp:=GetParent(Top);
if (tmp<>0) and (tmp<>GetDesktopWindow)
then Top:=tmp else break;
until false;
if Top=Wnd then exit; {kein Elternfenster}
tmp:=GetParent(Wnd);
if tmp=0 then exit;
if tmp=GetDesktopWindow then exit;
GetWindowRect(Wnd,R);
{nach rechts gucken}
P.x:=R.right+idiv2(GetSystemMetrics(SM_cxVScroll));
P.y:=idiv2(R.top+R.bottom);
tmp:=WindowFromPoint(P);
if (tmp<>0) and (CheckScrollBar(tmp)=2) then begin
Point_Finder:=2;
WScroll:=tmp;
exit;
end;
{nach unten gucken}
P.x:=idiv2(R.left+R.right);
P.y:=R.bottom+idiv2(GetSystemMetrics(SM_cyHScroll));
tmp:=WindowFromPoint(P);
if (tmp<>0) and (CheckScrollBar(tmp)=1) then begin
Point_Finder:=1;
WScroll:=tmp;
end;
end;
procedure HandleKeyState(var b:Char; press:Boolean); assembler;
asm les di,[b]
cmp [press],0
jz @@release
or es:byte ptr[di],0FEh {Gedrückt-Bits}
xor es:byte ptr[di],1 {Toggle-Bit}
jmp @@e
@@release:
and es:byte ptr[di],1 {Nur Toggle-Bit stehenlassen}
@@e:
end;
procedure HandleExtraButtons(b:Byte);
var
KS: TKeyboardState;
begin
GetKeyboardState(KS);
if b and $01 <>0 then HandleKeyState(KS[VK_Shift],true);
if b and $02 <>0 then HandleKeyState(KS[VK_Shift],false);
if b and $04 <>0 then HandleKeyState(KS[VK_Control],true);
if b and $08 <>0 then HandleKeyState(KS[VK_Control],false);
SetKeyboardState(KS);
end;
function MouseProc(code: Integer; wParam:Word; lParam:LongInt):
LongInt; export;
var
mhs: PMouseHookStruct absolute lParam;
wnd: HWnd;
hitcode: Word;
msg,wpar: Word;
lPar: LongInt;
rol: Integer;
style: LongInt;
pa: Boolean; {Schalter Zeilen(=false), Seiten(=true)}
{$IFDEF IE_HANDLER}
R: TRect;
s: array[0..25] of Char;
{$ENDIF}
begin
MouseProc:=CallNextHookEx(Hook,code,wParam,lParam);
wnd:=mhs^.hwnd;
hitcode:=mhs^.wHitTestCode;
if hitcode<>HTNowhere
then begin
lasthitcode:=hitcode;
lastwnd:=wnd;
end else begin
hitcode:=lasthitcode;
wnd:=lastwnd;
end;
case LongRec(mhs^.dwExtraInfo).hi of
{das war das Register DI bei Mouse_Event}
$4001: begin {Was das Rollrad betrifft...}
if wnd=0 then exit;
style:=GetWindowLong(wnd,GWL_Style);
{$IFDEF IE_HANDLER}
GetClassName(wnd,s,sizeof(s));
if lstrcmp(s,'Internet Explorer_Server')=0 then begin
style:=WS_VScroll;
if hitcode=HTClient then begin
GetClientRect(wnd,R);
ClientToScreen(wnd,PPoint(@R.right)^);
if mhs^.pt.x>R.right-GetSystemMetrics(SM_cxVScroll)
then hitcode:=HTVScroll;
end;
end;
{$ENDIF}
msg:=WM_VScroll;
pa:=false;
case hitcode of
HTClient: begin
if style and (WS_VScroll or WS_HScroll)=WS_HScroll
then msg:=WM_HScroll;
end;
HTHScroll: begin
msg:=WM_HScroll;
{ pa:=true;} {seitenweises Horizontal-Rollen ist oft zuviel}
end;
HTVScroll: begin
pa:=true;
end;
else exit;
end;
rol:=Integer(LongRec(mhs^.dwExtraInfo).lo);
lPar:=0; {bei Fenster mit Scroll-Stil Null lassen}
if style and (WS_VScroll or WS_HScroll) =0 then begin
{Viele Editoren, insbesondere, wenn sie auf RichEdit basieren,
verwenden eigene Rollbalken; diese werden hier als "Nachbarn"
(Siblings=Geschwister) erwartet und gesucht.
Ansonsten ist die VSCROLL-Nachricht für rollbalkenlose Fenster
problematisch bis verheerend, z.B. verschieben sich Desktop-Symbole,
oder MDI-Fenster verschwinden aus ihrem Rahmen.}
LongRec(lPar).hi:=Wnd;
case CheckScrollBar(Wnd) of
1: msg:=WM_HScroll; {HScroll: kleine Schritte}
2: pa:=true; {VScroll: seitenweise}
else case Point_Finder(Wnd,LongRec(lPar).hi) of
1: msg:=WM_HScroll; {nur horizontaler Rollbalken gefunden}
2: ;
else case HasSiblingScrollBar(Wnd,LongRec(lPar).hi) of
0: exit; {keine: nichts tun! Raus hier!}
1: msg:=WM_HScroll; {nur HScroll: horizontal rollen}
end; {VScroll oder beide: vertikal rollen}
end;
end;
Wnd:=GetParent(LongRec(lPar).hi); {Immer ans Elternfenster}
if Wnd=0 then exit;
end;
if pa then begin
if ScrollWidth<0 then rol:=-rol; {nur Vorzeichen}
end else rol:=rol*ScrollWidth; {Wert mit Vorzeichen}
wpar:=SB_LineUp; if pa then wpar:=SB_PageUp;
if rol<0 then begin
wpar:=SB_LineDown; if pa then wpar:=SB_PageDown;
rol:=-rol;
end;
while rol>0 do begin
PostMessage(wnd,msg,wpar,lPar);
Dec(rol,120);
end;
MouseProc:=1; {keine Maus-Nachricht ans Programm liefern!}
end;
$4002: begin {Was die Extra-Tasten betrifft...}
HandleExtraButtons(WordRec(LongRec(mhs^.dwExtraInfo).lo).hi);
{obere Bits - das war das Register SI bei Mouse_Event}
{Stack-Speicher für TKeyboardState sparen}
MouseProc:=1; {keine Maus-Nachricht ans Programm liefern!}
end;
end;
end;
procedure WEP;
begin
UnhookWindowsHookEx(Hook);
end;
var
ec: Integer;
begin
{RollMsg:=RegisterWindowMessage('MSWHEEL_ROLLMSG');}
{Leider wird diese Art Message nur stümperhaft unterstützt, daher
erfolgt ein Verzicht darauf; es wird nur noch gerollt.
Die WM_MOUSEWHEEL-Nachricht kann von 16bit aus nicht abgesetzt werden;
damit will wohl M$ diese geschützte Art ausrotten, aber nicht mit mir!}
ScrollWidth:=Integer(GetProfileInt('Windows','MouseWheelScroll',1));
if ScrollWidth=0 then ScrollWidth:=1; {sonst klemmt das Programm!}
Hook:=SetWindowsHookEx(WH_Mouse,MouseProc,HInstance,0);
end.
| Detected encoding: OEM (CP437) | 1
|
|
|