Create a Registry Control

Since the release of Windows and Visual Basic INI files have been the primary way to store program settings such as size, position and title.

But now the use of the registry seems to be overtaking the use of INI files. Visual Basic now has the GetSetting and SaveSetting commands which automate reading and writing to the registry.

The main problem with using these commands are that they will only save and retrieve settings from the VB and VBA Program Settings.

Add a module (mDeclares). Copy the following code into the module:

'Registry Constants
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
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1 ' Unicode nul
                        ' terminated string
Public Const REG_DWORD = 4
 
'Registry API Declarations
Public Declare Function RegCloseKey _
     Lib "advapi32.dll" _
     (ByVal HKey As Long) As Long

Public Declare Function RegCreateKey _
     Lib "advapi32.dll" Alias "RegCreateKeyA" _
        (ByVal HKey As Long, _
         ByVal lpSubKey As String, _
         phkResult As Long) As Long

Public Declare Function RegDeleteKey _
    Lib "advapi32.dll" Alias "RegDeleteKeyA" _
        (ByVal HKey As Long, _
        ByVal lpSubKey As String) As Long

Public Declare Function RegDeleteValue _
    Lib "advapi32.dll" Alias "RegDeleteValueA" _
        (ByVal HKey As Long, 
         ByVal lpValueName As String) As Long

Public Declare Function RegOpenKey _
    Lib "advapi32.dll" Alias "RegOpenKeyA" _
        (ByVal HKey As Long, _
         ByVal lpSubKey As String, _
         phkResult As Long) As Long

Public 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

Public Declare Function RegSetValueEx _
    Lib "advapi32.dll" Alias "RegSetValueExA" _
        (ByVal HKey As Long, ByVal lpValueName As String, _
         ByVal Reserved As Long, _
         ByVal dwType As Long, lpData As Any, _
         ByVal cbData As Long) As Long

Add a Usercontrol (cReg). Add the following code to it’s General Declarations procedure:

'Function for removing a key
Public Function fDeleteValue(ByVal HKey As Long, _
       ByVal strPath As String, _
       ByVal strValue As String)
Dim keyhand As Long
'Open it
r = RegOpenKey(HKey, strPath, keyhand)
'Delete it
r = RegDeleteValue(keyhand, strValue)
'Close it
r = RegCloseKey(keyhand)
End Function

 color="#FF00FF">'Function for getting a string
Public Function fGetstring(HKey As Long, _
       strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
'Open it
r = RegOpenKey(HKey, strPath, keyhand)
'Query the registry
lResult = RegQueryValueEx(keyhand, strValue, _
          0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
  strBuf = String(lDataBufSize, " ")
  lResult = RegQueryValueEx(keyhand, strValue, _
            0&, 0&, ByVal strBuf, lDataBufSize)
  If lResult = ERROR_SUCCESS Then
    intZeroPos = InStr(strBuf, Chr$(0))
	If intZeroPos > 0
  Then
    fGetstring = Left$(strBuf, intZeroPos - 1)
  Else
    fGetstring = strBuf
  End If
End If
End If
End Function

'Function for saving a string
Public Sub fSaveString(HKey As Long, _
                       strPath As String, _
                       strValue As String, _
                       strdata As String)

Dim keyhand As Long
Dim r As Long

'Create it
r = RegCreateKey(HKey, strPath, keyhand)
'Set it 
r = RegSetValueEx(keyhand, strValue, 0, _
    REG_SZ, ByVal strdata,Len(strdata))
'Close it
r = RegCloseKey(keyhand)
End Sub

Private Sub UserControl_Initialize()
'Set the width and height values
UserControl.Width = UserControl.Picture.Width
UserControl.Height = UserControl.Picture.Height
End Sub

Private Sub UserControl_Resize()
'Reset the width and height values
UserControl.Width = UserControl.Picture.Width
UserControl.Height = UserControl.Picture.Height
End Sub