Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing MainMod.bas (7.45 KB)
Attribute VB_Name = "MainMod"
Private Const GWL_WNDPROC = (-4)
Private Const WM_DISPLAYCHANGE = &H7E
Private Const WM_HOTKEY = &H312
Private Const WM_TIMER = &H113
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private AppWnd As Long
Private ScreenWidth As Long
Private ScreenHeight As Long
Private DrawBrush As Long
Private DrawRectV(2) As RECT
Private DrawRectH(2) As RECT
Private DrawRectIndex As Integer
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Const DrawRedDotTimerID = 100
Private iDrawRedDotTimer As Long
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const MOD_WIN = &H8
Private Const KEY_F1 = 112
Private Const KEY_F2 = 113
Private Const KEY_F3 = 114
Private Const KEY_F4 = 115
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private PrevWindowProc As Long
Private iAtom_SmallRedDot As Long
Private iAtom_MedRedDot As Long
Private iAtom_LargeRedDot As Long
Private iAtom_NoRedDot As Long
Private Sub SetDrawRects()
DrawRectV(0) = SetRect((ScreenWidth / 2) - 2, (ScreenHeight / 2) - 1, (ScreenWidth / 2) + 2, (ScreenHeight / 2) + 1, True)
DrawRectH(0) = SetRect((ScreenWidth / 2) - 1, (ScreenHeight / 2) - 2, (ScreenWidth / 2) + 1, (ScreenHeight / 2) + 2, True)
DrawRectV(1) = SetRect((ScreenWidth / 2) - 3, (ScreenHeight / 2) - 2, (ScreenWidth / 2) + 3, (ScreenHeight / 2) + 2, True)
DrawRectH(1) = SetRect((ScreenWidth / 2) - 2, (ScreenHeight / 2) - 3, (ScreenWidth / 2) + 2, (ScreenHeight / 2) + 3, True)
DrawRectV(2) = SetRect((ScreenWidth / 2) - 4, (ScreenHeight / 2) - 3, (ScreenWidth / 2) + 4, (ScreenHeight / 2) + 3, True)
DrawRectH(2) = SetRect((ScreenWidth / 2) - 3, (ScreenHeight / 2) - 4, (ScreenWidth / 2) + 3, (ScreenHeight / 2) + 4, True)
End Sub
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim ScreenDC As Long
If hWnd = AppWnd Then
If uMsg = WM_HOTKEY Then
Select Case wParam
Case iAtom_SmallRedDot
DrawRectIndex = 0
If iDrawRedDotTimer = 0 Then iDrawRedDotTimer = SetTimer(AppWnd, DrawRedDotTimerID, 1, 0)
Case iAtom_MedRedDot
DrawRectIndex = 1
If iDrawRedDotTimer = 0 Then iDrawRedDotTimer = SetTimer(AppWnd, DrawRedDotTimerID, 1, 0)
Case iAtom_LargeRedDot
DrawRectIndex = 2
If iDrawRedDotTimer = 0 Then iDrawRedDotTimer = SetTimer(AppWnd, DrawRedDotTimerID, 1, 0)
Case iAtom_NoRedDot
If iDrawRedDotTimer Then
iDrawRedDotTimer = KillTimer(AppWnd, DrawRedDotTimerID)
iDrawRedDotTimer = 0
End If
End Select
ElseIf uMsg = WM_DISPLAYCHANGE Then
ScreenWidth = LoWord(lParam)
ScreenHeight = HiWord(lParam)
SetDrawRects
ElseIf uMsg = WM_TIMER Then
Select Case wParam
Case DrawRedDotTimerID
ScreenDC = GetDC(0)
FillRect ScreenDC, DrawRectV(DrawRectIndex), DrawBrush
FillRect ScreenDC, DrawRectH(DrawRectIndex), DrawBrush
ReleaseDC 0, ScreenDC
End Select
End If
End If
WindowProc = CallWindowProc(PrevWindowProc, hWnd, uMsg, wParam, lParam)
End Function
Private Function HiWord(wParam As Long) As Long
HiWord = wParam \ &H10000 And &HFFFF
End Function
Private Function LoWord(wParam As Long) As Long
If wParam And &H8000& Then
LoWord = &H8000& Or (wParam And &H7FFF&)
Else
LoWord = wParam And &HFFFF&
End If
End Function
Private Function SetRect(ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, Optional bNoCalc As Boolean) As RECT
SetRect.Left = X
SetRect.Top = Y
If bNoCalc = False Then
SetRect.Right = X + cx
SetRect.Bottom = Y + cy
Else
SetRect.Right = cx
SetRect.Bottom = cy
End If
End Function
Public Sub UnSubclass()
DeleteObject DrawBrush
If iDrawRedDotTimer Then iDrawRedDotTimer = KillTimer(AppWnd, DrawRedDotTimerID)
SetWindowLong AppWnd, GWL_WNDPROC, PrevWindowProc
End Sub
Public Sub UnregisterHotkeys()
UnregisterHotKey AppWnd, iAtom_SmallRedDot
GlobalDeleteAtom iAtom_SmallRedDot
UnregisterHotKey AppWnd, iAtom_MedRedDot
GlobalDeleteAtom iAtom_MedRedDot
UnregisterHotKey AppWnd, iAtom_LargeRedDot
GlobalDeleteAtom iAtom_LargeRedDot
UnregisterHotKey AppWnd, iAtom_NoRedDot
GlobalDeleteAtom iAtom_NoRedDot
End Sub
Sub Main()
If App.PrevInstance Then
MsgBox "The RedDotApp is already running.", vbInformation
End
End If
Load DrawForm
AppWnd = FindWindow("ThunderRT6Main", App.Title)
If AppWnd = 0 Then
MsgBox "An error occurred while initializing RedDotApp.", vbCritical
End
End If
DrawBrush = CreateSolidBrush(vbRed)
ScreenWidth = Int(Screen.Width / Screen.TwipsPerPixelY)
ScreenHeight = Int(Screen.Height / Screen.TwipsPerPixelY)
SetDrawRects
DrawRectIndex = 1
iAtom_SmallRedDot = GlobalAddAtom("SmallRedDot Hotkey")
RegisterHotKey AppWnd, iAtom_SmallRedDot, MOD_SHIFT, KEY_F1
iAtom_MedRedDot = GlobalAddAtom("MedRedDot Hotkey")
RegisterHotKey AppWnd, iAtom_MedRedDot, MOD_SHIFT, KEY_F2
iAtom_LargeRedDot = GlobalAddAtom("LargeRedDot Hotkey")
RegisterHotKey AppWnd, iAtom_LargeRedDot, MOD_SHIFT, KEY_F3
iAtom_NoRedDot = GlobalAddAtom("NoRedDot Hotkey")
RegisterHotKey AppWnd, iAtom_NoRedDot, MOD_SHIFT, KEY_F4
PrevWindowProc = SetWindowLong(AppWnd, GWL_WNDPROC, AddressOf WindowProc)
iDrawRedDotTimer = SetTimer(AppWnd, DrawRedDotTimerID, 1, 0)
End Sub