Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/ARSBarDrawingMod.bas (5.42 KB)
Attribute VB_Name = "ARSBarDrawingMod"
Option Explicit
Private Const GWL_WNDPROC = (-4)
Private Const WM_DRAWITEM = &H2B
Private Const DT_VCENTER = &H4
Private Const TRANSPARENT = 1
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type DRAWITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long
hDC As Long
rcItem As RECT
itemData As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor 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 SubClassObject As Long
Private OldWindowProc As Long
Public Sub EndSBarParentSubClass()
UnSubClass SubClassObject, OldWindowProc
End Sub
Public Sub StartSBarParentSubClass(ByVal hWnd As Long)
SubClassObject = hWnd
SubClass SubClassObject
End Sub
Private Sub SubClass(hWnd As Long)
OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UnSubClass(hWnd As Long, PrevDefProc As Long)
SetWindowLong hWnd, GWL_WNDPROC, PrevDefProc
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 tmpstr As String
Dim i As Integer
Dim TextSize As SIZE
If SubClassObject = hWnd Then
If uMsg = WM_DRAWITEM Then
Dim di As DRAWITEMSTRUCT
CopyMemory di, ByVal lParam, Len(di)
If di.hwndItem = AutoRefreshForm.SBar.hWnd Then
If di.itemID = 0 Then
i = InStr(AutoRefreshForm.SBar.Panels(1).Text, ":")
If i > 0 Then i = Val(Trim(Mid(AutoRefreshForm.SBar.Panels(1).Text, i + 1)))
If i > 0 Then
SetBkMode di.hDC, TRANSPARENT
di.rcItem.Left = di.rcItem.Left + 3
DrawText di.hDC, "Reserve Slots: ", 15, di.rcItem, DT_VCENTER
GetTextExtentPoint32 di.hDC, "Reserve Slots: ", 15, TextSize
SetTextColor di.hDC, vbRed
di.rcItem.Left = di.rcItem.Left + TextSize.cx
DrawText di.hDC, CStr(i), Len(CStr(i)), di.rcItem, DT_VCENTER
Exit Function
End If
ElseIf di.itemID = 1 Then
i = InStr(AutoRefreshForm.SBar.Panels(2).Text, "Punkbuster") + _
InStr(AutoRefreshForm.SBar.Panels(2).Text, "Paladin") + _
InStr(AutoRefreshForm.SBar.Panels(2).Text, "Cheating-Death")
If i > 0 Then
i = InStr(AutoRefreshForm.SBar.Panels(2).Text, ":")
If i > 0 Then
tmpstr = Trim(Mid(AutoRefreshForm.SBar.Panels(2).Text, i + 1))
SetBkMode di.hDC, TRANSPARENT
di.rcItem.Left = di.rcItem.Left + 3
DrawText di.hDC, "Req Apps: ", 10, di.rcItem, DT_VCENTER
GetTextExtentPoint32 di.hDC, "Req Apps: ", 10, TextSize
SetTextColor di.hDC, vbRed
di.rcItem.Left = di.rcItem.Left + TextSize.cx
DrawText di.hDC, tmpstr, Len(tmpstr), di.rcItem, DT_VCENTER
Exit Function
End If
End If
ElseIf di.itemID = 2 Then
If InStr(AutoRefreshForm.SBar.Panels(3).Text, "Yes") > 0 Then
SetBkMode di.hDC, TRANSPARENT
di.rcItem.Left = di.rcItem.Left + 3
DrawText di.hDC, "Pass Req: ", 10, di.rcItem, DT_VCENTER
GetTextExtentPoint32 di.hDC, "Pass Req: ", 10, TextSize
SetTextColor di.hDC, vbRed
di.rcItem.Left = di.rcItem.Left + TextSize.cx
DrawText di.hDC, "Yes", 3, di.rcItem, DT_VCENTER
Exit Function
End If
End If
End If
End If
WindowProc = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
End If
End Function
Download QuickQuery HL Edition/ARSBarDrawingMod.bas