🚀 go-pugleaf

Hello people,
	I want to determine whether Win32 is using Large or Small
fonts.  I've found out what entry in the registry will tell me this.
	A guy on IRC helped me out and gave me a whole bunch of his
code I had to sort through.  It SHOULD work but Visual Basic 5
w/Service Pack 3 preforms and illegal opperation and is forced to
close.  I'm including the problem file with this message.
(MODULE1.BAS)
	I know exactly where the problem is:

            ReturnCode = RegQueryValueEx(hKey, "fonts.fon", 0&,
REG_SZ, lpData, lpcbData)

if I replace "fonts.fon" with a NULL string, it'll pass this line fine
but it doesn't do what I want it to.  However, whenever I add
"fonts.fon," it pauses after processing that line.  Someone told me to
put ByVal where necessary but I don't know how to use ByVal very well.
Could someone out there look at this code and fix parts that need
fixing?  Thanx a lot.

Chetan Phull
phull@interlog.com
Attribute VB_Name = "Module1"
Option Explicit
Global Const LISTVIEW_BUTTON = 11
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public fMainForm As frmMain

'Security Mask constants
Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

'Predefined Registry Keys used in hKey Argument
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004

' Return codes from Registration functions.
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_BADDB = 1009&
Public Const ERROR_BADKEY = 1010&
Public Const ERROR_CANTOPEN = 1011&
Public Const ERROR_CANTREAD = 1012&
Public Const ERROR_CANTWRITE = 1013&
Public Const ERROR_OUTOFMEMORY = 14&
Public Const ERROR_INVALID_PARAMETER = 87&
Public Const ERROR_ACCESS_DENIED = 5&

'Data type Public Constants
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10

Public Const SM_MOUSEPRESENT = 19
Public Const HKEY_CURRENT_CONFIG = &H80000005

Sub gAPIDisplayError(Code&)
  
  Select Case Code&
    Case ERROR_BADDB
      MsgBox "Corrupt Registry Database!"
    Case ERROR_BADKEY
      MsgBox "Key name is bad"
    Case ERROR_CANTOPEN
      MsgBox "Cannot Open Key"
    Case ERROR_CANTREAD
      MsgBox "Cannot Read Key"
    Case ERROR_CANTWRITE
      MsgBox "Cannot Write Key"
    Case ERROR_ACCESS_DENIED
      MsgBox "Access to Registry Denied"
    Case ERROR_OUTOFMEMORY
      MsgBox "Out of memory"
    Case ERROR_INVALID_PARAMETER
      MsgBox "Invalid Parameter"
    Case Else
      MsgBox "Undefined key error code!"
  End Select
End Sub



'Determine if OS is using Large or Small Font (display settings.)

Sub Main()
    Dim ScreenMode As String
    Dim OSSmallFont As Boolean
    Dim Result As Boolean
    Dim SearchWave As String
    Dim ReturnCode As Long
    Dim hKey As Long
    Dim KeyValue As String
    
    Dim lpName As String
    Dim lpcbName As Long
    Dim lpClass As String
    Dim lpcbClass As Long
    Dim lpData As String
    Dim lpcbData As Long
    
    Result = GetSystemMetrics(SM_MOUSEPRESENT)
    ScreenMode = Screen.Width \ Screen.TwipsPerPixelX & "x" & Screen.Height \ Screen.TwipsPerPixelY
    
    
    #If Win32 Then
        If ScreenMode <> "640x480" Then         'large/small fonts only available in higher resolutions
            'check if Win32 is using Large or Small Fonts
            ReturnCode = RegOpenKeyEx(HKEY_CURRENT_CONFIG, "Display\Settings", 0&, KEY_READ, hKey)
            lpcbData = 255
            lpData = Space$(lpcbData)
            lpcbName = 255
            lpName = Space$(lpcbName)
            ReturnCode = RegQueryValueEx(hKey, "fonts.fon", 0&, REG_SZ, lpData, lpcbData)
      
            If ReturnCode = ERROR_SUCCESS Then
                KeyValue = Left$(lpData, lpcbData - 1)
                If KeyValue = "vgasys.fon" Then
                    OSSmallFont = True
                Else
                    OSSmallFont = False
                End If
            Else
                gAPIDisplayError ReturnCode
            End If
            ReturnCode = RegCloseKey(hKey)
        End If
    #Else
        If ScreenMode <> "640x480" Then         'large/small fonts only available in higher resolutions
        
        End If
    #End If
    
    
    If ScreenMode <> "640x480" And OSSmallFont = 1 Then
        If Result <> True Then
            Beep
            MsgBox "Lambda32 requires a mouse.  Please connect a before running the program.", vbExclamation
            GoTo SKIPIT
        End If
        frmSplash.Show
        frmSplash.Refresh
        Set fMainForm = New frmMain
        Load fMainForm
        Unload frmSplash
        
        fMainForm.Show
    
    ElseIf ScreenMode <> "640x480" And OSSmallFont = 0 Then
        If Result <> True Then
            Beep
            MsgBox "Lambda32 requires a mouse.  Please connect a before running the program.", vbExclamation
        End If
        Beep
        MsgBox "Your desktop is being displayed using large fonts.  Lambda32 was developed to run in the small fonts environment.  To change your desktop to use small fonts, modify the desktop display settings.", vbExclamation
    Else    'screenmode is 640x480
        If Result <> True Then
            Beep
            MsgBox "Lambda32 requires a mouse.  Please connect a before running the program.", vbExclamation
            GoTo SKIPIT
        End If
        frmSplash.Show
        frmSplash.Refresh
        Set fMainForm = New frmMain
        Load fMainForm
        Unload frmSplash
        
        fMainForm.Show
        
    End If
SKIPIT:
End Sub