Hab's im Autostart drin und läuft bei mir jetzt seit ca. einem Jahr fehlerfrei. Der Code ist PD. Hab's versucht schön Anfängerfreundlich zu kommentieren. Viel Spaß damit!
Änderungen:
2016-01-31: #PB_Editor_BuildCount = "?" und #PB_Editor_CompileCount = "?" (falls in Compileroptionen deaktiviert)
Code: Alles auswählen
EnableExplicit
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
CompilerError "Ja! Lass uns einen Windows-Treiber-Fix auf Linux oder MacOSX kompilieren! Jippie! Anarchie! ;)"
CompilerEndIf
CompilerSelect #PB_Compiler_Processor
CompilerCase #PB_Processor_x64 : #PB_Compiler_Processor$ = "x64"
CompilerCase #PB_Processor_x86 : #PB_Compiler_Processor$ = "x86"
CompilerDefault : CompilerError "Processor <> x64 And Processor <> x86"
CompilerEndSelect
; #PB_Editor_BuildCount kann in den Compileroptinen aktiviert werden.
CompilerIf Defined( PB_Editor_BuildCount , #PB_Constant ) = #False
#PB_Editor_BuildCount = "?"
CompilerEndIf
; #PB_Editor_CompileCount kann in den Compileroptinen aktiviert werden.
CompilerIf Defined( PB_Editor_CompileCount , #PB_Constant ) = #False
#PB_Editor_CompileCount = "?"
CompilerEndIf
#ProgName$ = "Däll-Stupidio-KeyFix"
#ProgVersion$ = "1.00." + #PB_Editor_BuildCount + "." + #PB_Editor_CompileCount + " (" + #PB_Compiler_Processor$ + ")"
#ProgNameUndVersion$ = #ProgName$ + " " + #ProgVersion$
CompilerIf Defined( NUL$ , #PB_Constant ) = #False
#NUL$ = #Empty$
CompilerEndIf
Macro Inc( Variable )
EnableASM : INC Variable : DisableASM ; Variable = Variable + 1
EndMacro
Macro Dec( Variable )
EnableASM : DEC Variable : DisableASM ; Variable = Variable - 1
EndMacro
; VORWORT: Bei Objekten, bei denen es nur
; ein einziges dieses Typs gibt (z.B. Fenster)
; habe ich keine Konstanten verwendet.
; Ja, das ist eigentlich ein mieser Stil...
; Timer für die Key-Up-Verzögerungen
Enumeration enum_Timer
#TIMER_ReleaseVolUp
#TIMER_ReleaseVolDown
EndEnumeration
; Menüeinträge
Enumeration enum_MenuItems
#POPMEN_Tray_aktiviert
#POPMEN_Tray_Quellcode
#POPMEN_Tray_ueber
#POPMEN_Tray_beenden
EndEnumeration
; Globale Variablen
Global KeyUpDelay ; Zeit für Key-Up-Verzögerung in Millisekunden
Global KbdHookID ; Tastatur-Callback-ID
Global KbdHoodAktiv ; Merker zum Keyboardhook pausieren
; Tastatur-Callbackprozedur (wird bei jedem Tastendruck oder -loslassen aufgerufen)
Procedure CALLBACK__LowLevelKeyboardProc( nCode , wParam, *lParam.KBDLLHOOKSTRUCT )
If KbdHoodAktiv And nCode = #HC_ACTION And wParam = #WM_KEYDOWN ; "#HC_ACTION" bedeutet hier "wParam und lParam enthalten Informationen".
Select *lParam\vkCode
Case #VK_VOLUME_UP
AddWindowTimer( 0 , #TIMER_ReleaseVolUp , KeyUpDelay ) ; Timer zum Loslassen der Lauter-Taste (damit das OS nicht ausgebremst wird)
; Wenn der Timer schon läuft, dann wird er rückgesetzt. Gut für Keyretrigger
; bei gehaltener Taste um nur ein "Key-Up" am Ende zu Senden.
Case #VK_VOLUME_DOWN
AddWindowTimer( 0 , #TIMER_ReleaseVolDown , KeyUpDelay ) ; Timer zum Loslassen der Leiser-Taste (damit das OS nicht ausgebremst wird)
; Wenn der Timer schon läuft, dann wird er rückgesetzt. Gut für Keyretrigger
; bei gehaltener Taste um nur ein "Key-Up" am Ende zu Senden.
EndSelect
EndIf
; Nachricht zum nächsten Hook weiterleiten (betrifft das ganze System und nicht nur dieses Programm)
ProcedureReturn CallNextHookEx_( 0 , nCode , wParam , *lParam )
EndProcedure
; Programm kontrolliert beenden
Procedure Beenden( FehlerZeile = #NO_ERROR ) ; #NO_ERROR = 0 ;)
; Keyhook entfernen...
If KbdHookID
UnhookWindowsHookEx_( KbdHookID )
EndIf
; ...und Ende-Gelände!
End FehlerZeile
EndProcedure
; Macro zum bequemen Aufruf von "_Error()"
Macro Error( Text = #NUL$ , Fatal = #True , AddFlags = 0 )
_Error( #PB_Compiler_Line , Text , Fatal , AddFlags )
EndMacro
; Fehlermeldung und Programm beenden (wenn Fatal)
Procedure.i _Error( PB_Compiler_Line , Text$ = #NUL$ , Fatal = #True , AddFlags = 0 )
If Text$
Text$ = #CRLF$ + #CRLF$ + Text$
EndIf
Text$ = "Fehlerzeile: " + Str( PB_Compiler_Line ) + Text$
If Fatal
Text$ + #CRLF$ + #CRLF$ + #ProgName$ + " wird nun kontrolliert beendet..."
EndIf
Define Ergebnis = MessageRequester( #ProgNameUndVersion$ , Text$ , #MB_ICONERROR | AddFlags )
If Fatal
Beenden( PB_Compiler_Line )
EndIf
ProcedureReturn Ergebnis
EndProcedure
; Infomeldung anzeigen
Procedure.i Info( Text$ , AddFlags = 0 )
ProcedureReturn MessageRequester( #ProgNameUndVersion$ , Text$ , #MB_ICONINFORMATION | AddFlags )
EndProcedure
; Warnmeldung anzeigen
Procedure.i Warn( Text$ , AddFlags = 0 )
ProcedureReturn MessageRequester( #ProgNameUndVersion$ , Text$ , #MB_ICONWARNING | AddFlags )
EndProcedure
; Voreinstellungen laden
Procedure Init_Prefs()
; Prefs öffnen (Datei "[ExeOhneErweiterung].prefs")
OpenPreferences( GetPathPart(ProgramFilename()) + GetFilePart(ProgramFilename(),#PB_FileSystem_NoExtension) + ".prefs" )
; Key-Up-Verzögerung in Millisekunden
KeyUpDelay = ReadPreferenceInteger( "KeyUpDelay" , 100 )
If KeyUpDelay < 10
KeyUpDelay = 10
EndIf
; Einstellungen rückschreiben
WritePreferenceInteger( "KeyUpDelay" , KeyUpDelay )
; Prefs schließen
ClosePreferences()
EndProcedure
; Key-Up-Daten für "SendInput_()" vordefinieren (siehe Hauptschleife)
Procedure Init_KeyInput()
; Lauter-Taste loslassen
Global ReleaseVolUp.INPUT
With ReleaseVolUp
\type = #INPUT_KEYBOARD
\ki\wVk = #VK_VOLUME_UP
\ki\wScan = $30
\ki\dwFlags = #KEYEVENTF_EXTENDEDKEY | #KEYEVENTF_KEYUP
\ki\time = 0 ; <-- d.h. Zeitstempel automatisch setzen
EndWith
; Leiser-Taste loslassen
Global ReleaseVolDown.INPUT
With ReleaseVolDown
\type = #INPUT_KEYBOARD
\ki\wVk = #VK_VOLUME_DOWN
\ki\wScan = $2E
\ki\dwFlags = #KEYEVENTF_EXTENDEDKEY | #KEYEVENTF_KEYUP
\ki\time = 0 ; <-- d.h. Zeitstempel automatisch setzen
EndWith
EndProcedure
; Fenster öffnen (unsichtbar!)
Procedure Init_Window()
Define flags = #PB_Window_BorderLess |
#PB_Window_NoGadgets |
#PB_Window_Invisible ; <-- unsichtbar, da nur Zielfenster für
; Timer, Systray-Icon & Popup-Menü.
If OpenWindow( 0 , 0 , 0 , 0 , 0 , #ProgNameUndVersion$ + " (unsichtbar)" , flags ) = #False
Error( "Kann unsichtbares Hauptfenster nicht öffnen." , #MB_ICONERROR )
EndIf
EndProcedure
; Icon fürs Systray zeichnen
Procedure Init_DrawIcons()
Define AktivIcon = 1 ; = #True
Define InaktivIcon = 0 ; = #False
Define TempIcon = 2 ; = #MirDochEgal ;)
; Farben definieren
Define col1 = $FF59E000
Define col2 = $FF000000
; Icon-Beschriftung
Define txt$ = "DKF" ; wofür könnte das nur stehen... :\
; Temporäres Image zum bekritzeln erstellen
If CreateImage( TempIcon , 200 , 200 , 32 , col1 ) = #False
Error( "Kann temporäres Image für Systray-Icon nicht erstellen" )
EndIf
; und loskritzeln :D
If StartDrawing( ImageOutput(TempIcon) )
DrawingMode( #PB_2DDrawing_AllChannels )
Define w = TextWidth(txt$) + 4
Define h = TextHeight(txt$) + 4
DrawText( 2 , 2 , txt$ , col2, col1 )
; "aktiv" Systray-Icon ausschnippeln
If GrabDrawingImage( AktivIcon , 0 , 0 , w , h ) = #False
Error( "Kann Image für 'aktiv' Systray-Icon nicht erstellen" )
EndIf
; Wachsmalstifte aufräumen
StopDrawing()
EndIf
; Temporäres Image in die Mülltonne
FreeImage(TempIcon)
; "aktiv" Icon auf Standardgröße fürs Systray verkleinern
ResizeImage( AktivIcon , 16 , 16 , #PB_Image_Smooth )
; "aktiv" Systray-Icon als "inaktiv" kopieren
If CopyImage( AktivIcon , InaktivIcon ) = #False
Error( "Kann Image für 'inaktiv' Systray-Icon nicht erstellen" )
EndIf
; "inaktiv" Systray-Icon "durchstreichen"
If StartDrawing( ImageOutput(InaktivIcon) )
DrawingMode( #PB_2DDrawing_AllChannels | #PB_2DDrawing_XOr )
LineXY( 0 , 14 , 15 , -1 , $00FFFFFF )
LineXY( 0 , 15 , 15 , 0 , $00FFFFFF )
LineXY( 0 , 16 , 15 , 1 , $00FFFFFF )
StopDrawing()
EndIf
EndProcedure
; Systray-Icon setzen
Procedure Init_SysTray()
If AddSysTrayIcon( 0 , WindowID(0) , ImageID( KbdHoodAktiv ) ) = #False
Error( "Kann Systray-Icon nicht erstellen." )
EndIf
SysTrayIconToolTip( 0 , #ProgName$ )
EndProcedure
; Popup-Menü erstellen (für Systray-Icon)
Procedure Init_PopupMenu()
If CreatePopupMenu(0) = #False
Error( "Kann Popup-Menü nicht erstellen." )
EndIf
MenuItem( #POPMEN_Tray_aktiviert , "aktiviert" )
MenuBar()
MenuItem( #POPMEN_Tray_Quellcode , "Quellcode speichern…" )
MenuItem( #POPMEN_Tray_ueber , "über…" )
MenuItem( #POPMEN_Tray_beenden , "beenden" )
EndProcedure
; Initiales Laustärketasten-Loslassen
Procedure Init_VolumeKeys()
Define CountOut
; Lauter-Taste loslassen
While CountOut < 200 And GetAsyncKeyState_( #VK_VOLUME_UP ) & $8000
SendInput_( 1 , ReleaseVolUp , SizeOf(INPUT) )
Delay( 50 )
Inc( CountOut )
Wend
; Leiser-Taste loslassen
While CountOut < 200 And GetAsyncKeyState_( #VK_VOLUME_DOWN ) & $8000
SendInput_( 1 , ReleaseVolDown , SizeOf(INPUT) )
Delay( 50 )
Inc( CountOut )
Wend
; Bei einem "halben K.O." gibt es eine Warn- bzw. Infomeldung, evtl.
; ist ja nur der Rechner gerade am rödeln und daher etwas langsam...
; Alle Werte wurden einfach Pi-mal-Daumen gewählt.
If CountOut >= 100
Error( "Sorry... Loslassen der Laustärketasten will einfach nicht funktionieren... :-((" )
ElseIf CountOut >= 50
Warn( "Sorry... Loslassen der Laustärketasten scheint nur mäßig gut zu funktionieren... :-(" )
ElseIf CountOut >= 25
Info( "Möglicher Weise funktioniert das Loslassen der Laustärketasten nicht 100%ig... :-/" )
EndIf
EndProcedure
; Tastatur-Callback setzen
Procedure Init_KeyHook()
; Merker für "aktiviert" setzen
KbdHoodAktiv = #True
; Tastaturcallback auf "CALLBACK__LowLevelKeyboardProc()" setzen
KbdHookID = SetWindowsHookEx_( #WH_KEYBOARD_LL , @CALLBACK__LowLevelKeyboardProc() , 0 , 0 )
EndProcedure
; ===== Initialisierung =====
Init_Prefs() ; Voreinstellungen laden
Init_KeyInput() ; Key-Up-Daten für "SendInput_()" vordefinieren
Init_Window() ; Fenster unsichbar öffnen
Init_DrawIcons() ; Icons fürs Systray zeichnen
Init_SysTray() ; SysTray-Icon erstellen
Init_PopupMenu() ; Popup-Menü erstellen (für Systray-Icon)
Init_VolumeKeys() ; Initiales Laustärketasten-Loslassen (Initialisieren = in einen definierten Grundzustand versetzen) ;o)
Init_KeyHook() ; Tastaturcallback setzen
; Häkchen bei "aktiviert" im Menü initialisieren
SetMenuItemState( 0 , #POPMEN_Tray_aktiviert , KbdHoodAktiv )
; richtiges Systrayicon verwenden
ChangeSysTrayIcon( 0 , ImageID( KbdHoodAktiv ) )
; ===== sontige Event-Callbacks (inkl. -Bindings) =====
Procedure ToggleHookActivity()
KbdHoodAktiv = Bool( Not KbdHoodAktiv )
SetMenuItemState( 0 , #POPMEN_Tray_aktiviert , KbdHoodAktiv )
ChangeSysTrayIcon( 0 , ImageID( KbdHoodAktiv ) )
If KbdHoodAktiv
Init_VolumeKeys() ; während inaktiv könnte es ja zum Tastenhänger gekommen sein...
EndIf
; (noch evtl. laufende Timer vernachlässige ich bei Deaktivierung einfach mal)
EndProcedure
Procedure CALLBACK__PB_Event_CloseWindow()
Beenden( #NO_ERROR )
EndProcedure
BindEvent( #PB_Event_CloseWindow , @CALLBACK__PB_Event_CloseWindow() )
Procedure CALLBACK__PB_Event_Menu__POPMEN_Tray_aktiviert()
ToggleHookActivity()
EndProcedure
BindMenuEvent( 0 , #POPMEN_Tray_aktiviert , @CALLBACK__PB_Event_Menu__POPMEN_Tray_aktiviert() )
Procedure CALLBACK__PB_Event_Menu__POPMEN_Tray_Quellcode()
Static datei_alt$ = #SOH$
If datei_alt$ = #SOH$
datei_alt$ = GetPathPart(ProgramFilename()) + GetFilePart(ProgramFilename(),#PB_FileSystem_NoExtension) + ".pb"
EndIf
Define datei$ = SaveFileRequester( "Quellcode speichern…" ,
datei_alt$ ,
"Alle Dateien (*.*)|*.*|" +
"PureBasic-Dateien (*.pb;*.pbi;*.pbp)|*.pb;*.pbi;*.pbp" ,
0)
; "Abbrechen" geklickt
If datei$ = #NUL$
ProcedureReturn
EndIf
datei_alt$ = datei$
; falls keine Erweiterung angegeben ".pb"
If GetExtensionPart( datei$ ) = #NUL$
datei$ + ".pb"
EndIf
; Existiert die Datei bereits?
If FileSize( datei$ ) >= 0
; Dateiattribute ermitteln
Define attribs = GetFileAttributes( datei$ )
; Warntext erstellen (unnötig umständlich, aber... schön!)
Define warntext$
If attribs & #PB_FileSystem_ReadOnly
warntext$ + "WARNUNG! Schreibgeschützte Datei!" + #CRLF$
EndIf
If attribs & #PB_FileSystem_System
warntext$ + "WARNUNG! Betriebssystemdatei!" + #CRLF$
EndIf
If attribs & #PB_FileSystem_Hidden
warntext$ + "WARNUNG! Versteckte Datei!" + #CRLF$
EndIf
If warntext$
warntext$ = #CRLF$ + warntext$ + #CRLF$
EndIf
warntext$ = "Es existiert bereits eine Datei mit diesem Namen." + #CRLF$ +
warntext$ + "Datei überschreiben?"
; "#MB_DEFBUTTON2" bedeutet "zweiter Knopf ist der Standardknopf", hier also "Nein".
If Warn( warntext$ , #PB_MessageRequester_YesNo | #MB_DEFBUTTON2 ) = #PB_MessageRequester_No
ProcedureReturn
EndIf
; Dateiattribute ändern (der User will "überschreiben"... alles Weitere ist mir egal...) ;o)
SetFileAttributes( datei$ , attribs & ~( #PB_FileSystem_Hidden | #PB_FileSystem_ReadOnly | #PB_FileSystem_System ) )
EndIf
; Datei erstellen
Repeat
Define datei = CreateFile( #PB_Any , datei$ )
Until datei Or Error( "Kann Datei nicht erstellen." + #CRLF$ + "Nochmal versuchen?" , #False ,
#PB_MessageRequester_YesNo ) = #PB_MessageRequester_No
If datei = #False
ProcedureReturn
EndIf
; Quellcode aus "DataSection" lesen und in Datei schreiben
WriteData( datei , ?Quelltext_START , ?Quelltext_STOPP - ?Quelltext_START )
; Und endlich fertig! ;)
CloseFile( datei )
DataSection ; Quelltext (IncludeBinary)
Quelltext_START:
IncludeBinary #PB_Compiler_File
Quelltext_STOPP:
EndDataSection
EndProcedure
BindMenuEvent( 0 , #POPMEN_Tray_Quellcode , @CALLBACK__PB_Event_Menu__POPMEN_Tray_Quellcode() )
Procedure CALLBACK__PB_Event_Menu__POPMEN_Tray_ueber()
; Die der heldenhafte Quintensprung ;)
Beep_( 500 , 100 ) : Delay( 1 )
Beep_( 625 , 100 ) : Delay( 1 )
Beep_( 750 , 100 ) : Delay( 1 )
Beep_( 1000 , 400 ) : Delay( 1 )
Beep_( 500 , 100 ) : Delay( 1 )
Beep_( 1000 , 800 )
Info( "////////// " + #ProgName$ + " \\\\\\\\\\"+ #CRLF$ +
#CRLF$ +
"Version " + #ProgVersion$ + #CRLF$ +
#CRLF$ +
"Dieses Programm ist Gemeingut (Public Domain)!" + #CRLF$ +
"Es werden keine Urheberrecht vorbehalten!" + #CRLF$ +
"Mach damit was immer Du willst!" + #CRLF$ +
#CRLF$ +
"=== NUTZUNG AUF EIGENES RISIKO! ===" + #CRLF$ +
#CRLF$ +
"Timo Acker - " + Str( Year(#PB_Compiler_Date) ) )
EndProcedure
BindMenuEvent( 0 , #POPMEN_Tray_ueber , @CALLBACK__PB_Event_Menu__POPMEN_Tray_ueber() )
Procedure CALLBACK__PB_Event_Menu__POPMEN_Tray_beenden()
Beenden( #NO_ERROR )
EndProcedure
BindMenuEvent( 0 , #POPMEN_Tray_beenden , @CALLBACK__PB_Event_Menu__POPMEN_Tray_beenden() )
Procedure CALLBACK__PB_Event_SysTray__PB_EventType_LeftClick()
ToggleHookActivity()
EndProcedure
BindEvent( #PB_Event_SysTray , @CALLBACK__PB_Event_SysTray__PB_EventType_LeftClick() , 0 , 0 , #PB_EventType_LeftClick )
Procedure CALLBACK__PB_Event_SysTray__PB_EventType_RightClick()
DisplayPopupMenu( 0 , WindowID(0) )
EndProcedure
BindEvent( #PB_Event_SysTray , @CALLBACK__PB_Event_SysTray__PB_EventType_RightClick() , 0 , 0 , #PB_EventType_RightClick )
Procedure CALLBACK__PB_Event_Timer__TIMER_ReleaseVolUp()
; "Lauter-Taste loslassen" senden
SendInput_( 1 , @ReleaseVolUp , SizeOf(INPUT) )
; Timer entfernen
RemoveWindowTimer( 0 , #TIMER_ReleaseVolUp )
EndProcedure
BindEvent( #PB_Event_Timer , @CALLBACK__PB_Event_Timer__TIMER_ReleaseVolUp() , 0 , #TIMER_ReleaseVolUp )
Procedure CALLBACK__PB_Event_Timer__TIMER_ReleaseVolDown()
; "Leiser-Taste loslassen" senden
SendInput_( 1 , @ReleaseVolDown , SizeOf(INPUT) )
; Timer entfernen
RemoveWindowTimer( 0 , #TIMER_ReleaseVolDown )
EndProcedure
BindEvent( #PB_Event_Timer , @CALLBACK__PB_Event_Timer__TIMER_ReleaseVolDown() , 0 , #TIMER_ReleaseVolDown )
; ===== Hauptschleife =====
Repeat
WaitWindowEvent() ; Rückgabewert nicht abgefragt, da alles per
; "BindEvent()" und BindMenuEvent()" verbandelt!
ForEver
; Ausreißer einfangen >:(
Error( "Hauptschleife unkrontrolliert verlassen." + #CRLF$ +
"WIE KONNTE DAS DENN PASSIEREN?! O.O'" )