vbAccelerator - Contents of code file: fNewItem.frm

VERSION 5.00
Begin VB.Form fNewItem 
   Caption         =   "New Registry Item"
   ClientHeight    =   4695
   ClientLeft      =   9330
   ClientTop       =   3780
   ClientWidth     =   4695
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "fNewItem.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4695
   ScaleWidth      =   4695
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   435
      Left            =   2040
      TabIndex        =   16
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   435
      Left            =   3360
      TabIndex        =   15
      Top             =   4200
      Width           =   1215
   End
   Begin VB.Frame fraType 
      Caption         =   "Type:"
      Height          =   1155
      Left            =   600
      TabIndex        =   11
      Top             =   2820
      Width           =   4035
      Begin VB.OptionButton optValueType 
         Caption         =   "&Binary"
         Enabled         =   0   'False
         Height          =   255
         Index           =   2
         Left            =   180
         TabIndex        =   14
         Top             =   720
         Width           =   3735
      End
      Begin VB.OptionButton optValueType 
         Caption         =   "&DWord"
         Height          =   255
         Index           =   1
         Left            =   180
         TabIndex        =   13
         Top             =   480
         Width           =   3735
      End
      Begin VB.OptionButton optValueType 
         Caption         =   "&String"
         Height          =   255
         Index           =   0
         Left            =   180
         TabIndex        =   12
         Top             =   240
         Value           =   -1  'True
         Width           =   3735
      End
   End
   Begin VB.Frame fraNew 
      Caption         =   "New:"
      Height          =   915
      Left            =   60
      TabIndex        =   8
      Top             =   540
      Width           =   4695
      Begin VB.OptionButton optType 
         Caption         =   "&Value"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   10
         Top             =   480
         Width           =   3675
      End
      Begin VB.OptionButton optType 
         Caption         =   "&Key"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Value           =   -1  'True
         Width           =   3675
      End
   End
   Begin VB.TextBox txtValue 
      Height          =   735
      Left            =   600
      MultiLine       =   -1  'True
      TabIndex        =   7
      Text            =   "fNewItem.frx":014A
      Top             =   2040
      Width           =   4035
   End
   Begin VB.TextBox txtName 
      Height          =   315
      Left            =   600
      TabIndex        =   4
      Text            =   "Pants"
      Top             =   1560
      Width           =   4035
   End
   Begin VB.Frame fraSep 
      Height          =   75
      Index           =   1
      Left            =   -60
      TabIndex        =   3
      Top             =   4020
      Width           =   5955
   End
   Begin VB.Frame fraSep 
      Height          =   75
      Index           =   0
      Left            =   -540
      TabIndex        =   2
      Top             =   420
      Width           =   5955
   End
   Begin VB.Label lblValue 
      Caption         =   "Value:"
      Height          =   255
      Left            =   60
      TabIndex        =   6
      Top             =   2040
      Width           =   615
   End
   Begin VB.Label lblName 
      Caption         =   "Name:"
      Height          =   255
      Left            =   60
      TabIndex        =   5
      Top             =   1620
      Width           =   615
   End
   Begin VB.Label lblParent 
      Height          =   315
      Left            =   660
      TabIndex        =   1
      Top             =   120
      Width           =   3555
   End
   Begin VB.Label lblParentCap 
      Caption         =   "Parent:"
      Height          =   255
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   675
   End
End
Attribute VB_Name = "fNewItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_sParent As String
Private m_bLoaded As Boolean
Private m_bCancel As Boolean
Private m_iType As Integer
Private m_iValueType As Integer
Private m_sName As String
Private m_svalue As Variant
Private m_eMode As ERegItemMode

Public Enum ERegItemMode
    eNew
    eUpdate
End Enum

Public Property Get mode() As ERegItemMode
    mode = m_eMode
End Property
Public Property Let mode(eMode As ERegItemMode)
    m_eMode = eMode
    If (m_bLoaded) Then
        Form_Load
    End If
End Property

Public Property Get ItemName() As String
    ItemName = m_sName
End Property
Public Property Get ItemValue() As Variant
    ItemValue = m_svalue
End Property
Public Property Let ItemValue(ByVal sV As Variant)
    m_svalue = sV
    If (m_bLoaded) Then
        txtValue.Text = m_svalue
    End If
End Property
Public Property Let ItemValueType(iType As Integer)
    m_iValueType = iType
    If (m_bLoaded) Then
        optValueType(m_iValueType).Value = True
    End If
End Property

Public Property Get ItemValueType() As Integer
    ItemValueType = m_iValueType
End Property
Public Property Get ItemType() As Integer
    ItemType = m_iType
End Property
Public Property Let ItemType(ByVal iType As Integer)
    m_iType = iType
    If (m_bLoaded) Then
        optType(iType).Value = True
    End If
End Property
Public Property Get Cancelled() As Boolean
    Cancelled = m_bCancel
End Property
Public Property Let Parent(ByVal sParent As String)
    m_sParent = sParent
    If (m_bLoaded) Then
        lblParent.Caption = m_sParent
    End If
End Property
Public Property Get Parent() As String
    Parent = m_sParent
End Property
Public Property Let ItemName(ByVal sItemName As String)
    m_sName = sItemName
    If (m_bLoaded) Then
        txtName.Text = m_sName
        txtName.Tag = m_sName
    End If
End Property

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
Dim i As Long
    If (optType(1).Value) Then
        If (optValueType(1).Value) Then
            If Not (IsNumeric(txtValue.Text)) Then
                MsgBox "The value '" & txtValue.Text & "' could not be
                 interpreted as a number.", vbInformation
                txtValue.SetFocus
                Exit Sub
            ElseIf Len(Trim$(txtValue.Text)) < 1 Then
                MsgBox "Please enter a value.", vbInformation
                txtValue.SetFocus
                Exit Sub
            End If
        ElseIf (optValueType(2).Value) Then
            ' Process the string...
            If Not (pbParseByteArray()) Then
                MsgBox "Could not interpret your entry as a binary entry." &
                 vbCrLf & vbCrLf & "Please enter the value as 2 digit
                 hexadecimal values separated by spaces.", vbInformation
                txtValue.SetFocus
                Exit Sub
            End If
        End If
    End If
    m_sName = Trim$(txtName)
    If (Len(m_sName) < 1) Then
        MsgBox "Please enter a name.", vbInformation
        txtName.SetFocus
        Exit Sub
    End If
    If Not (optValueType(2).Value) Then
        m_svalue = txtValue
    End If
    m_iType = optType(1).Value * -1
    m_iValueType = -1
    For i = 0 To 2
        If (optValueType(i).Value) Then
            m_iValueType = i
            Exit For
        End If
    Next i
    If (m_iValueType = -1) Then
        MsgBox "Please enter a value type.", vbExclamation
    End If
    
    m_bCancel = False
    Unload Me
End Sub
Private Function UnHexByte(ByVal sHex As String) As Byte
Dim iChar1 As Byte
Dim ichar2 As Byte
    iChar1 = Asc(Left$(sHex, 1))
    ichar2 = Asc(Mid$(sHex, 2, 1))
    UnHexByte = UnHex4BitsASCII(iChar1) * &H10 + UnHex4BitsASCII(ichar2)
End Function
Private Function UnHex4BitsASCII(ByVal iASCII As Byte) As Byte
    If (iASCII > Asc("A")) Then
        UnHex4BitsASCII = iASCII - Asc("A") + 10
    Else
        UnHex4BitsASCII = iASCII - Asc("0")
    End If
End Function

Private Function pbParseByteArray()
Dim sBytes As String
Dim bOut() As Byte
Dim sChar1 As String
Dim schar2 As String
Dim i As Long
Dim lBytes As Long

    sBytes = UCase$(txtValue)
    For i = 1 To Len(sBytes) Step 3
        If (Mid$(sBytes, i + 2, 1) <> " ") Then
            txtValue.SelStart = i + 2
            txtValue.SelLength = 1
            pbParseByteArray = False
            Exit Function
        End If
        sChar1 = Mid$(sBytes, i, 1)
        schar2 = Mid$(sBytes, i + 1, 1)
        If InStr("ABCDEF0123456789", sChar1) <> 0 Then
            If InStr("ABCDEF0123456789", schar2) <> 0 Then
                lBytes = lBytes + 1
                ReDim Preserve bOut(0 To lBytes - 1) As Byte
                bOut(lBytes - 1) = UnHexByte(sChar1 & schar2)
            Else
                txtValue.SelStart = i + 2
                txtValue.SelLength = 1
                pbParseByteArray = False
                Exit Function
            End If
        Else
            txtValue.SelStart = i
            txtValue.SelLength = 1
            pbParseByteArray = False
            Exit Function
        End If
    Next i
    
    m_svalue = bOut()
    pbParseByteArray = True
    
End Function

Private Sub Form_Load()
    lblParent.Caption = m_sParent
    txtValue.Text = m_svalue
    m_bLoaded = True
    ItemName = m_sName
    m_bCancel = True
    If (m_eMode = eUpdate) Then
        If (m_iType = 0) Then
            optType(0).Value = True
            optType(1).Enabled = False
            txtName.Locked = False
        Else
            optType(1).Value = True
            optType(0).Enabled = False
            txtName.Locked = True
        End If
        optValueType(m_iValueType).Value = True
        fraNew.Caption = "Modify"
        Me.Caption = "Modify Registry Item"
    End If
    optType_Click 1
End Sub

Private Sub optType_Click(Index As Integer)
Dim i As Long
    If (optType(1).Value) Then
        txtValue.Locked = False
        txtValue.BackColor = vbWindowBackground
    Else
        txtValue.Text = ""
        txtValue.Locked = True
        txtValue.BackColor = vbButtonFace
    End If
    For i = optValueType.LBound To optValueType.UBound
        optValueType(i).Enabled = optType(1).Value
    Next i
End Sub