Création d'une calculatrice pour vos applications Access

    ledCopy.BackColor = RGB(0, 255, 0) ' Vert
    ledPaste.BackColor = RGB(255, 0, 0) ' Rouge

''' ************************************************************************************
'''     PROJECT NAME  :   Calculator for MS Access Applications
'''     MODULE NAME   :   frmCalculator
'''     AUTHOR        :   Jean-Philippe AMBROSINO
'''     CONTACT       :   http://cerbermail.com/?wDzGFhHk1g
'''
'''     PUBLISHED ON  :   http://access.developpez.com/
'''
''' ************************************************************************************

Option Compare Database
Option Explicit

Private m_dblFirstEntry As Double
Private m_dblSecondEntry As Double
Private m_blnWithDecimal As Integer
Private m_blnOperationNumber As Integer
Private m_strLastFlagEntry As String
Private m_strFlagOperator As String
Private m_vntTotalDisplayed As Variant
Private m_intMaxDigit As Integer
Private m_dblBufferMemory As Double

Private m_vntFinalResult As Double
Private m_dblEuroValue As Double

Private m_strSeparator As String

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub btn0_Click()
''' Bouton 0 appuyé
'''------------------------
  FlagActionButtons "0"
  KeepFocus "btn0"
  ConvertToFRF
End Sub

Private Sub btn1_Click()
''' Bouton 1 appuyé
'''------------------------
  FlagActionButtons "1"
  KeepFocus "btn1"
  ConvertToFRF
End Sub
Private Sub btn2_Click()
''' Bouton 2 appuyé
'''------------------------
  FlagActionButtons "2"
  KeepFocus "btn2"
  ConvertToFRF
End Sub

Private Sub btn3_Click()
''' Bouton 3 appuyé
'''------------------------
  FlagActionButtons "3"
  KeepFocus "btn3"
  ConvertToFRF
End Sub

Private Sub btn4_Click()
''' Bouton 4 appuyé
'''------------------------
  FlagActionButtons "4"
  KeepFocus "btn4"
  ConvertToFRF
End Sub

Private Sub btn5_Click()
''' Bouton 5 appuyé
'''------------------------
  FlagActionButtons "5"
  KeepFocus "btn5"
  ConvertToFRF
End Sub

Private Sub btn6_Click()
''' Bouton 6 appuyé
'''------------------------
  FlagActionButtons "6"
  KeepFocus "btn6"
  ConvertToFRF
End Sub

Private Sub btn7_Click()
''' Bouton 7 appuyé
'''------------------------
  FlagActionButtons "7"
  KeepFocus "btn7"
  ConvertToFRF
End Sub

Private Sub btn8_Click()
''' Bouton 8 appuyé
'''------------------------
  FlagActionButtons "8"
  KeepFocus "btn8"
  ConvertToFRF
End Sub

Private Sub btn9_Click()
''' Bouton 9 appuyé
'''------------------------
  FlagActionButtons "9"
  KeepFocus "btn9"
  ConvertToFRF
End Sub

Private Sub btnDec_Click()
''' Bouton , appuyé
'''------------------------
  If m_strLastFlagEntry <> "ActionIsNumber" Then
    Me!txtLCDDisplayEUR = "0" & m_strSeparator
  ElseIf m_blnWithDecimal = False Then
    Me!txtLCDDisplayEUR = Me!txtLCDDisplayEUR & m_strSeparator
    m_intMaxDigit = m_intMaxDigit + 1
  End If
  
  m_blnWithDecimal = True
  m_strLastFlagEntry = "ActionIsNumber"
End Sub

Private Sub btnEqual_Click()
''' Bouton = appuyé
'''------------------------
  FunctionOperator "="
  m_intMaxDigit = 0
  KeepFocus "btnEqual"
  ConvertToFRF
End Sub

Private Sub btnAdd_Click()
''' Bouton + appuyé
'''------------------------
  FunctionOperator "+"
  m_intMaxDigit = 0
  KeepFocus "btnAdd"
  ConvertToFRF
End Sub

Private Sub btnSubst_Click()
''' Bouton - appuyé
'''------------------------
  FunctionOperator "-"
  m_intMaxDigit = 0
  KeepFocus "btnSubst"
  ConvertToFRF
End Sub

Private Sub btnDivide_Click()
''' Bouton / appuyé
'''------------------------
  FunctionOperator "/"
  m_intMaxDigit = 0
  KeepFocus "btnDivide"
End Sub

Private Sub btnMult_Click()
''' Bouton X appuyé
'''------------------------
  FunctionOperator "*"
  m_intMaxDigit = 0
  KeepFocus "btnMult"
  ConvertToFRF
End Sub

Private Sub btnC_Click()
''' Bouton C appuyé
'''------------------------
  Me!txtLCDDisplayEUR = "0" & m_strSeparator
  Me!txtLCDDisplayFRF = "0" & m_strSeparator
  m_blnWithDecimal = False
  m_strLastFlagEntry = "C"
  KeepFocus "btnC"
  m_intMaxDigit = 0
  m_dblEuroValue = 0
End Sub

Private Sub btnCE_Click()
''' Bouton CE appuyé
'''------------------------
  m_strLastFlagEntry = "CE"
  KeepFocus "btnCE"
End Sub

Private Sub btnOnOff_Click()
''' Bouton On/Off appuyé
'''------------------------
  btnOnOff.Caption = "O F F"
  btnOnOff.ForeColor = RGB(255, 0, 0)
  shpLED.BackColor = RGB(255, 0, 0)
  DoEvents
  Call Sleep(1000)
  KeepCurrentResult
End Sub

Private Sub btnSQRT_Click()
''' Bouton Vx appuyé
'''------------------------
  m_dblFirstEntry = Val(Me!txtLCDDisplayEUR)
  If m_dblFirstEntry < 0 Then
      MsgBox "La racine carrée d´un nombre négatif n´est pas valable !" & vbCrLf & _
      vbCrLf & "Le calcul est impossible", 48, "Erreur"
  Else
      m_dblFirstEntry = Sqr(m_dblFirstEntry)
      m_intMaxDigit = 0
  End If
      Me!txtLCDDisplayEUR = str$(m_dblFirstEntry)
      m_blnOperationNumber = 1
      m_strLastFlagEntry = "ActionIsOperator"
      m_strFlagOperator = vbNullString
      ConvertToFRF
End Sub

Private Sub btnInvert_Click()
''' Bouton 1/x appuyé
'''------------------------
  m_dblFirstEntry = Val(Me!txtLCDDisplayEUR)
  
  If m_dblFirstEntry = 0 Then
    MsgBox "Cette opération est une division par zéro !" & vbCrLf & vbCrLf & _
    "Le calcul est impossible", 48, "Erreur"
  Else
    m_dblFirstEntry = 1 / m_dblFirstEntry
    m_intMaxDigit = 0
  End If
  
  Me!txtLCDDisplayEUR = str$(m_dblFirstEntry)
  m_blnOperationNumber = 1
  m_strLastFlagEntry = "ActionIsOperator"
  m_strFlagOperator = vbNullString
  KeepFocus "btnInvert"
  ConvertToFRF
End Sub

Private Sub btnPercent_Click()
''' Bouton % appuyé
'''------------------------
  Me!txtLCDDisplayEUR = Format$(m_dblFirstEntry * Val(Me!txtLCDDisplayEUR) / 100)
  m_intMaxDigit = 0
  KeepFocus "btnPercent"
  ConvertToFRF
End Sub

Private Sub btnX2_Click()
''' Bouton X² appuyé
'''------------------------
  On Error GoTo L_ErrOverFow
    m_dblFirstEntry = Val(Me!txtLCDDisplayEUR)
    m_dblFirstEntry = m_dblFirstEntry * m_dblFirstEntry
        m_intMaxDigit = 0
          Me!txtLCDDisplayEUR = str$(m_dblFirstEntry)
          m_blnOperationNumber = 1
    m_strLastFlagEntry = "ActionIsOperator"
    m_strFlagOperator = vbNullString
    ConvertToFRF
  
L_ExOverFow:
      Exit Sub
L_ErrOverFow:
    MsgBox "Vous avez atteint la capacité maximum de calcul du processeur...", 48, "Calcul dépassé"
    Resume L_ExOverFow
End Sub

Private Sub btnMemClear_Click()
''' Bouton MC appuyé
'''------------------------
  If m_dblBufferMemory Then
    If MsgBox("Effacer le contenu de la mémoire maintenant ?", 52, "Effacer") = 6 Then
        m_dblBufferMemory = 0
    End If
  End If
End Sub

Private Sub btnMemLess_Click()
''' Bouton M- appuyé
'''------------------------
  m_dblBufferMemory = m_dblBufferMemory - Me!txtLCDDisplayEUR
End Sub

Private Sub btnMemMore_Click()
  m_dblBufferMemory = m_dblBufferMemory + Me!txtLCDDisplayEUR
End Sub

Private Sub btnMemRecall_Click()
''' Bouton MR appuyé
'''------------------------
    Me!txtLCDDisplayEUR = vbNullString
    Me!txtLCDDisplayEUR = str(m_dblBufferMemory)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
''' Gestion des touches du clavier
'''------------------------
  Select Case KeyCode
      Case 96, 48: btn0_Click
      Case 97, 49: btn1_Click
      Case 98, 50: btn2_Click
      Case 99, 51: btn3_Click
      Case 100, 52: btn4_Click
      Case 101, 53: btn5_Click
      Case 102, 54: btn6_Click
      Case 103, 55: btn7_Click
      Case 104, 56: btn8_Click
      Case 105, 57: btn9_Click
      Case 110: btnDec_Click
      Case 111: btnDivide_Click
      Case 106: btnMult_Click
      Case 107: btnAdd_Click
      Case 109: btnSubst_Click
      Case 46: btnCE_Click
      Case 13: btnEqual_Click
      Case 27: InitializeCalculator: btnC_Click
  End Select
End Sub

Private Sub Form_Load()
''' Chargement... (intialise le séparateur de décimales)
'''------------------------
  m_strSeparator = GetSystemDecimalSeparator()
  btnC.SetFocus
End Sub

Private Sub txtLCDDisplayEUR_KeyPress(KeyAscii As Integer)
''' Effet de frappe dans l´afficheur annulé
'''------------------------
  KeyAscii = 0
End Sub

Private Sub ConvertToFRF()
''' Procédure de conversion en francs
'''----------------------------------------
Const EURO As Double = 6.55957
Dim dblResultFound As Double

  dblResultFound = ConvertToDouble(Me!txtLCDDisplayEUR)
  If dblResultFound = 0 Then
      Exit Sub
  End If
  m_dblEuroValue = dblResultFound
  dblResultFound = dblResultFound * EURO
  dblResultFound = RoundNumber(dblResultFound, 2)
  Me!txtLCDDisplayFRF = str$(dblResultFound)
End Sub

Private Function ConvertToDouble(ByVal varValue As Variant) As Double
''' Fonction de conversion en double
'''----------------------------------------
Const CHR_DECIMALSEP_COMMA As String = ","
Const CHR_DECIMALSEP_DOT As String = "."

Dim strNumberSeparator As String
Dim strTempNumber As String
Dim dblResult As Double
  
  If InStr(1, varValue, CHR_DECIMALSEP_COMMA) Then
    strTempNumber = Replace(varValue, CHR_DECIMALSEP_COMMA, m_strSeparator, 1, -1, vbTextCompare)
  ElseIf InStr(1, varValue, CHR_DECIMALSEP_DOT) Then
    strTempNumber = Replace(varValue, CHR_DECIMALSEP_DOT, m_strSeparator, 1, -1, vbTextCompare)
  Else
    strTempNumber = varValue
  End If
  dblResult = CDbl(strTempNumber)
  ConvertToDouble = dblResult
End Function

Private Function RoundNumber(ByVal NValue As Double, ByVal nDigits As Integer) As Double
''' Fonction d´arrondi à n décimales
'''------------------------------------------------
    RoundNumber = Int(NValue * (10 ^ nDigits) + 0.5) / (10 ^ nDigits)
End Function

Private Sub FunctionOperator(ByVal Operator As String)
''' Fonction déterminant l´opérateur choisi
'''----------------------------------------
  If m_strLastFlagEntry = "ActionIsNumber" Then
      m_blnOperationNumber = m_blnOperationNumber + 1
  End If
  
  If m_blnOperationNumber = 1 Then
      m_dblFirstEntry = ConvertToDouble(Me!txtLCDDisplayEUR)
  ElseIf m_blnOperationNumber = 2 Then
      m_dblSecondEntry = ConvertToDouble(Me!txtLCDDisplayEUR)
          Select Case m_strFlagOperator
               Case "+"
             m_dblFirstEntry = m_dblFirstEntry + m_dblSecondEntry
               Case "-"
             m_dblFirstEntry = m_dblFirstEntry - m_dblSecondEntry
               Case "*"
             m_dblFirstEntry = m_dblFirstEntry * m_dblSecondEntry
               Case "/"
                  If m_dblSecondEntry = 0 Then
                          MsgBox "Cette opération est une division par zéro !" & vbCrLf & vbCrLf & _
                          "Le calcul est impossible", 48, "Erreur"
                  Else
                     m_dblFirstEntry = m_dblFirstEntry / m_dblSecondEntry
                  End If
               Case "="
             m_dblFirstEntry = m_dblSecondEntry
          End Select
      Me!txtLCDDisplayEUR = m_dblFirstEntry
      m_blnOperationNumber = 1
  End If
  m_strLastFlagEntry = "ActionIsOperator"
  m_strFlagOperator = Operator
End Sub

Sub KeepFocus(ByVal CtrlName As String)
''' Fonction permettant de garder le focus
'''----------------------------------------
Dim oForm As Form
Dim oCtl As Control

  Set oForm = Form
  Set oCtl = oForm.Controls(CtrlName)
  oCtl.SetFocus
  Set oCtl = Nothing
  Set oForm = Nothing
End Sub

Private Sub InitializeCalculator()
''' Procédure d'initialisation
'''----------------------------------------
  m_blnWithDecimal = False
  m_blnOperationNumber = 0
  m_strLastFlagEntry = "ActionIsNothing"
  m_strFlagOperator = vbNullString
End Sub

Private Sub FlagActionButtons(ByVal EnterNum As String)
''' Procédure de gestion des actions
'''----------------------------------------
  If m_strLastFlagEntry <> "ActionIsNumber" Then
     Me!txtLCDDisplayEUR = vbNullString
     Me!txtHiddenFinalResult = 0
     m_blnWithDecimal = False
  End If
  If m_intMaxDigit > 13 Then
    Beep
    Exit Sub
  End If
  Me!txtLCDDisplayEUR = Me!txtLCDDisplayEUR + LTrim$(EnterNum)
  Me!txtHiddenFinalResult = ConvertToDouble(Me!txtLCDDisplayEUR)
  m_intMaxDigit = m_intMaxDigit + 1
  m_strLastFlagEntry = "ActionIsNumber"
End Sub

Private Sub KeepCurrentResult()
''' Procédure de mise en mémoire du résultat
'''-----------------------------------------
Const MSG_CLIPBOARD_01 = "Votre résultat "
Const MSG_CLIPBOARD_02 = " est copié en mémoire..."
Const MSG_CLIPBOARD_03 = "Vous pourrez le coller en utilisant les touches Ctrl+V !"
Const MSG_CLIPBOARD_00 = "Copie"
Const MMSG_KEEP_RESULT_01 = "Voulez-vous conserver les résultats de votre calcul pour un usage ultérieur ?"
Const MMSG_KEEP_RESULT_00 = "Conserver le résultat de "

  m_vntTotalDisplayed = Val(Me!txtLCDDisplayEUR)

If m_vntTotalDisplayed = 0 Then GoTo L_ExCopyFail
    If MsgBox(MMSG_KEEP_RESULT_01, 36, MMSG_KEEP_RESULT_00 & txtLCDDisplayEUR) = 6 Then
      DoCmd.GoToControl "txtLCDDisplayEUR"
      m_vntFinalResult = ConvertToDouble(Me!txtLCDDisplayEUR)
      txtHiddenFinalResult.Visible = True
      Me!txtHiddenFinalResult = m_vntFinalResult
      txtHiddenFinalResult.SetFocus
      txtHiddenFinalResult.SelStart = 0
      txtHiddenFinalResult.SelLength = Len(Me!txtHiddenFinalResult)
      On Error GoTo L_ErrCopyFail
      DoCmd.RunCommand acCmdCopy
      MsgBox MSG_CLIPBOARD_01 & m_vntFinalResult & MSG_CLIPBOARD_02 & vbCrLf & _
      vbCrLf & MSG_CLIPBOARD_03, , MSG_CLIPBOARD_00
    End If
L_ExCopyFail:
    DoCmd.Close 2, "frmCalculator"
    Exit Sub
L_ErrCopyFail:
    MsgBox "Désolé, la copie a échoué...", 48, "Copie"
    Resume L_ExCopyFail
End Sub

Private Sub cmdCopy_Click()
''' Bouton Copier appuyé
'''------------------------
  m_vntTotalDisplayed = Val(Me!txtLCDDisplayEUR)
  If m_vntTotalDisplayed = 0 Then Exit Sub
    CopyResultToClipboard
    ledCopy.BackColor = RGB(0, 255, 0)
    ledPaste.BackColor = RGB(255, 0, 0)
End Sub

Private Sub cmdPaste_Click()
''' Bouton Coller appuyé
'''------------------------
Dim dblPastedValue
  
  txtPasteData.Visible = True
  txtPasteData.SetFocus
  On Error Resume Next
  Application.RunCommand acCmdPaste
  dblPastedValue = Me!txtPasteData
  
  If dblPastedValue <> 0 And IsNumeric(dblPastedValue) Then
      Me!txtLCDDisplayEUR = dblPastedValue
      ConvertToFRF
      ledCopy.BackColor = RGB(255, 0, 0)
      ledPaste.BackColor = RGB(0, 255, 0)
  Else
      MsgBox "Aucun résultat valide n´est applicable à l´afficheur de la calculatrice !", _
      48, "Donnée non numérique ou nulle"
  End If
  txtPasteData.Visible = False
End Sub

Private Sub cmdNoTopMost_Click()
''' Bouton Mode Non Modal appuyé
'''------------------------
  If MsgBox("La calculatrice est affichée en mode verrouillé et vous devrez l'éteindre pour intervenir " & _
  "sur la fenêtre en arrière-plan...", 49, "Mode d´affichage") = 1 Then
      cmdTopMost.Visible = True
      Me.Modal = True
      cmdNoTopMost.Visible = False
      ledTopMost.BackColor = RGB(255, 0, 0)
  End If
End Sub

Private Sub cmdTopMost_Click()
''' Bouton Mode Modal appuyé
'''------------------------
If MsgBox("La calculatrice n´est plus en mode exclusif de fenêtre et vous pouvez intervenir " & _ 
"sur la fenêtre en arrière-plan...", 65, "Mode d´affichage") = 1 Then
    cmdNoTopMost.Visible = True
    Me.Modal = False
    cmdTopMost.Visible = False
    ledTopMost.BackColor = RGB(0, 255, 0)
End If
End Sub

Private Sub CopyResultToClipboard()
''' Procédure de gestion du presse-papier
'''----------------------------------------
  m_vntTotalDisplayed = Val(Me!txtLCDDisplayEUR)
  
  If m_vntTotalDisplayed = 0 Then GoTo L_ExCopyFail

  DoCmd.GoToControl "txtLCDDisplayEUR"
  m_vntFinalResult = ConvertToDouble(Me!txtLCDDisplayEUR)
  txtHiddenFinalResult.Visible = True
  Me!txtHiddenFinalResult = m_vntFinalResult
  txtHiddenFinalResult.SetFocus
  txtHiddenFinalResult.SelStart = 0
  txtHiddenFinalResult.SelLength = Len(Me!txtHiddenFinalResult)
  On Error GoTo L_ErrCopyFail
  DoCmd.RunCommand acCmdCopy
  btnOnOff.SetFocus
  txtHiddenFinalResult.Visible = False
  
L_ExCopyFail:
        Exit Sub
L_ErrCopyFail:
    MsgBox "Désolé, la copie a échoué...", 48, "Copie"
        Resume L_ExCopyFail
End Sub

Private Function GetSystemDecimalSeparator() As String
''' Fonction retournant le séparateur du système
'''---------------------------------------------
Const HKEY_CPANEL_INTLKEYS As String = "Control Panel\International"
Dim strDecimal As String
  
  strDecimal = fRegistryGetKeyValue(rootHKeyCurrentUser, HKEY_CPANEL_INTLKEYS, "sDecimal")
  If VarType(strDecimal) = vbError Then
    Exit Function
  End If
  GetSystemDecimalSeparator = strDecimal
End Function

''' ************************************************************************************
'''     PROJET        :   Calculator for MS Access Applications
'''     MODULE        :   basRegistry
'''     AUTEUR        :   Jean-Philippe AMBROSINO
'''     CONTACT       :   http://cerbermail.com/?wDzGFhHk1g
'''
'''     PUBLIÉ SUR    :   http://access.developpez.com/
'''
''' ************************************************************************************
Option Compare Database
Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngHKey As Long) _
    As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal lngHKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal _
    lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) _
    As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal _
    lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExBinary Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal _
    lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As _
    Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal _
    lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As _
    Long
    
Public Enum EnumRegistryRootKeys
  rootHKeyClassesRoot = &H80000000
  rootHKeyCurrentUser = &H80000001
  rootHKeyLocalMachine = &H80000002
  rootHKeyUsers = &H80000003
End Enum

Public Enum EnumRegistryValueType
  RRKREGSZ = 1
  RRKREGBINARY = 3
  RRKREGDWORD = 4
End Enum

Public Const HKEYLOCALMACHINE As String = "HKEY_LOCAL_MACHINE"
Public Const HKEYCURRENTUSER As String = "HKEY_CURRENT_USER"

Private Const mcregOptionNonVolatile = 0

Private Const MCREGERRORNONE = 0
Private Const MCREGKEYALLACCESS = &H3F
Private Const MCREGKEYQUERYVALUE = &H1

Public Function fRegistryGetKeyValue(ByVal eRootKey As EnumRegistryRootKeys, ByVal strKeyName As String, _
ByVal strValueName As String) As Variant
''' Fonction permettant la lecture d'une clé du registre
'''----------------------------------------------------
Dim lngRetVal As Long
Dim lngHKey As Long
Dim varValue As Variant
Dim strValueData As String
Dim abytValueData() As Byte
Dim lngValueData As Long
Dim lngValueType As Long
Dim lngDataSize As Long
  
  On Error GoTo L_ErrRegistryOperation
  varValue = Empty
  lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0&, MCREGKEYQUERYVALUE, lngHKey)
  If MCREGERRORNONE = lngRetVal Then
    lngRetVal = RegQueryValueExNULL(lngHKey, strValueName, 0&, lngValueType, 0&, lngDataSize)
    If lngRetVal = MCREGERRORNONE Then
      Select Case lngValueType
        Case RRKREGSZ:
          If lngDataSize > 0 Then
            strValueData = String(lngDataSize, 0)
            lngRetVal = RegQueryValueExString(lngHKey, strValueName, 0&, lngValueType, _
            strValueData, lngDataSize)
            If InStr(strValueData, vbNullChar) > 0 Then
              strValueData = Mid$(strValueData, 1, InStr(strValueData, vbNullChar) - 1)
            End If
          End If
          If MCREGERRORNONE = lngRetVal Then
            varValue = Left$(strValueData, lngDataSize)
          Else
            varValue = Empty
          End If
        Case RRKREGDWORD:
          lngRetVal = RegQueryValueExLong(lngHKey, strValueName, 0&, _
          lngValueType, lngValueData, lngDataSize)
          If MCREGERRORNONE = lngRetVal Then
            varValue = lngValueData
          End If
        Case RRKREGBINARY
          If lngDataSize > 0 Then
            ReDim abytValueData(lngDataSize) As Byte
            lngRetVal = RegQueryValueExBinary(lngHKey, strValueName, 0&, _
            lngValueType, VarPtr(abytValueData(0)), lngDataSize)
          End If
          If MCREGERRORNONE = lngRetVal Then
            varValue = abytValueData
          Else
            varValue = Empty
          End If
                
        Case Else
          lngRetVal = -1
      End Select
      
    End If
    RegCloseKey (lngHKey)
  End If
  fRegistryGetKeyValue = varValue
  
L_ExRegistryOperation:
  Erase abytValueData
  Exit Function
L_ErrRegistryOperation:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "fRegistryGetKeyValue"
  Resume L_ExRegistryOperation
End Function