Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

QuickQuery Half-Life Edition

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

Back to file list


Back to project page