01-31-2026, 05:17 PM
@Pete
try this:
try this:
Code: (Select All)
Option _Explicit
Declare Dynamic Library "user32"
Function GetAsyncKeyState% (ByVal vKey As Long)
Function VkKeyScanW% (ByVal wChar As Integer)
End Declare
Const VK_SHIFT = &H10
Const VK_CONTROL = &H11
Const VK_MENU = &H12 ' Alt
Const VK_ADD = &H6B ' Numpad +
Const VK_SUBTRACT = &H6D ' Numpad -
Dim Shared vkPlus As Long, needPlus As Long
Dim Shared vkEq As Long, needEq As Long
Dim Shared vkMinus As Long, needMinus As Long
Dim Shared prevPlus%, prevMinus%
Cls
Call InitCtrlPlusMinus
Print "Press: CTRL + + / CTRL + - (can be also numpad +- or CTRL+=)"
Print "ESC = End"
Print
Do
If CtrlPlusHit% Then
Print "CTRL + PLUS (or =, or numpad +)"
End If
If CtrlMinusHit% Then
Print "CTRL + MINUS (or numpad -)"
End If
_Limit 120
Loop Until _KeyHit = 27
End
Sub InitCtrlPlusMinus
Dim r%
' '+' (ASCII 43)
r% = VkKeyScanW(43)
Call SplitVkScan(r%, vkPlus, needPlus)
' '=' (ASCII 61) -> bez Shiftu na mnoha layoutech, super jako fallback pro zoom-in
r% = VkKeyScanW(61)
Call SplitVkScan(r%, vkEq, needEq)
' '-' (ASCII 45)
r% = VkKeyScanW(45)
Call SplitVkScan(r%, vkMinus, needMinus)
prevPlus% = 0
prevMinus% = 0
End Sub
Sub SplitVkScan (r%, vkOut As Long, needOut As Long)
Dim rr&
' VkKeyScanW vraci -1 kdyz znak nejde namapovat 'return -1 if chcaracter can not be mapped
If r% = -1 Then
vkOut = 0
needOut = 0
Exit Sub
End If
rr& = r%
vkOut = (rr& And &HFF&)
needOut = ((rr& And &HFF00&) \ &H100&) ' 1=Shift, 2=Ctrl, 4=Alt
End Sub
Function KeyDown% (vk As Long)
Dim st%
st% = GetAsyncKeyState(vk)
If st% < 0 Then
KeyDown% = -1
Else
KeyDown% = 0
End If
End Function
Function ModifiersOk% (need As Long)
Dim ok%
ok% = -1
If (need And 1) <> 0 Then
If KeyDown%(VK_SHIFT) = 0 Then ok% = 0
End If
If (need And 2) <> 0 Then
If KeyDown%(VK_CONTROL) = 0 Then ok% = 0
End If
If (need And 4) <> 0 Then
If KeyDown%(VK_MENU) = 0 Then ok% = 0
End If
ModifiersOk% = ok%
End Function
Function CtrlPlusHit%
Dim down%
down% = 0
If KeyDown%(VK_CONTROL) Then
' Numpad +
If KeyDown%(VK_ADD) Then down% = -1
' Layout-aware '+' a '='
If vkPlus <> 0 Then
If KeyDown%(vkPlus) Then
If ModifiersOk%(needPlus) Then down% = -1
End If
End If
If vkEq <> 0 Then
If KeyDown%(vkEq) Then
If ModifiersOk%(needEq) Then down% = -1
End If
End If
End If
If down% Then
If prevPlus% = 0 Then CtrlPlusHit% = -1
prevPlus% = -1
Else
prevPlus% = 0
CtrlPlusHit% = 0
End If
End Function
Function CtrlMinusHit%
Dim down%
down% = 0
If KeyDown%(VK_CONTROL) Then
' Numpad -
If KeyDown%(VK_SUBTRACT) Then down% = -1
' Layout-aware '-'
If vkMinus <> 0 Then
If KeyDown%(vkMinus) Then
If ModifiersOk%(needMinus) Then down% = -1
End If
End If
End If
If down% Then
If prevMinus% = 0 Then CtrlMinusHit% = -1
prevMinus% = -1
Else
prevMinus% = 0
CtrlMinusHit% = 0
End If
End Function