registry.frm

不错的一个VB菜单设计 界面和功能都不错

VERSION 5.00
Object = "{75D4F148-8785-11D3-93AD-0000832EF44D}#3.1#0"; "FAST2003.ocx"
Begin VB.Form frmRegistry 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Registry demo"
   ClientHeight    =   3105
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5655
   Icon            =   "Registry.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   5655
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtSection 
      Height          =   285
      Left            =   540
      TabIndex        =   10
      Text            =   ".Default\Software\FASTWin\Registry demo"
      Top             =   150
      Width           =   4980
   End
   Begin VB.TextBox txtValue 
      Height          =   285
      Index           =   0
      Left            =   3180
      TabIndex        =   9
      Text            =   "Demo text"
      Top             =   570
      Width           =   2355
   End
   Begin VB.TextBox txtValue 
      Height          =   285
      Index           =   1
      Left            =   3180
      TabIndex        =   8
      Text            =   "FASTWin"
      Top             =   930
      Width           =   2355
   End
   Begin VB.TextBox txtValue 
      Height          =   285
      Index           =   2
      Left            =   3180
      TabIndex        =   7
      Text            =   "12345"
      Top             =   1290
      Width           =   2355
   End
   Begin VB.TextBox txtName 
      Height          =   285
      Index           =   0
      Left            =   1575
      TabIndex        =   6
      Text            =   "String value"
      Top             =   570
      Width           =   1470
   End
   Begin VB.TextBox txtName 
      Height          =   285
      Index           =   1
      Left            =   1575
      TabIndex        =   5
      Text            =   "Binary value"
      Top             =   930
      Width           =   1470
   End
   Begin VB.TextBox txtName 
      Height          =   285
      Index           =   2
      Left            =   1575
      TabIndex        =   4
      Text            =   "Numeric value"
      Top             =   1290
      Width           =   1470
   End
   Begin VB.CommandButton cmdCreate 
      Caption         =   "Create section and keys"
      Height          =   375
      Left            =   3510
      TabIndex        =   3
      Top             =   1785
      Width           =   1875
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "Delete section"
      Height          =   375
      Left            =   3525
      TabIndex        =   2
      Top             =   2250
      Width           =   1875
   End
   Begin VB.Frame fraFrame 
      Height          =   1335
      Left            =   60
      TabIndex        =   0
      Top             =   1695
      Width           =   3150
      Begin VB.CheckBox chkType 
         Caption         =   "DWORD"
         Height          =   225
         Index           =   2
         Left            =   2040
         TabIndex        =   17
         Top             =   270
         Width           =   975
      End
      Begin VB.CheckBox chkType 
         Caption         =   "Binary"
         Height          =   225
         Index           =   1
         Left            =   1080
         TabIndex        =   16
         Top             =   270
         Width           =   765
      End
      Begin VB.CheckBox chkType 
         Caption         =   "String"
         Height          =   225
         Index           =   0
         Left            =   150
         TabIndex        =   15
         Top             =   270
         Width           =   765
      End
      Begin VB.CommandButton cmdDeleteValue 
         Caption         =   "Delete key"
         Height          =   375
         Left            =   1530
         TabIndex        =   1
         Top             =   765
         Width           =   1485
      End
   End
   Begin FLWSystem.FWRegistry objRegistry 
      Left            =   5130
      Top             =   2640
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin VB.Label lblLabel 
      AutoSize        =   -1  'True
      Caption         =   "Key"
      Height          =   195
      Index           =   0
      Left            =   165
      TabIndex        =   14
      Top             =   180
      Width           =   270
   End
   Begin VB.Label lblLabel 
      AutoSize        =   -1  'True
      Caption         =   "String data type"
      Height          =   195
      Index           =   1
      Left            =   165
      TabIndex        =   13
      Top             =   600
      Width           =   1110
   End
   Begin VB.Label lblLabel 
      AutoSize        =   -1  'True
      Caption         =   "Binary data type"
      Height          =   195
      Index           =   2
      Left            =   165
      TabIndex        =   12
      Top             =   960
      Width           =   1140
   End
   Begin VB.Label lblLabel 
      AutoSize        =   -1  'True
      Caption         =   "DWORD data type"
      Height          =   195
      Index           =   3
      Left            =   165
      TabIndex        =   11
      Top             =   1320
      Width           =   1350
   End
End
Attribute VB_Name = "frmRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdCreate_Click()
  Dim aBytes() As Byte
  Dim lngInd   As Long
  Dim intInd   As Integer
  
  Call objRegistry.CreateKey(FLWSystem.flwRegUsers, txtSection)
  
  If objRegistry.SetKeyStr(FLWSystem.flwRegUsers, txtSection, txtName(0), txtValue(0)) <> FLWSystem.flwSuccess Then
    Call MsgBox("Error creating the value " & txtValue(0), vbCritical)
  Else
    intInd = intInd + 1
  End If
    
  ' convert a string into a byte array
  ReDim aBytes(1 To Len(txtValue(1).Text)) As Byte
  For lngInd = 1 To Len(txtValue(1).Text)
    aBytes(lngInd) = Asc(VBA.Mid$(txtValue(1).Text, lngInd, 1))
  Next
 
  If objRegistry.SetKeyBinary(FLWSystem.flwRegUsers, txtSection, txtName(1), aBytes) <> FLWSystem.flwSuccess Then
    Call MsgBox("Error creating the value " & txtValue(1), vbCritical)
  Else
    intInd = intInd + 1
  End If
    
  If objRegistry.SetKeyDWord(FLWSystem.flwRegUsers, txtSection, txtName(2), Val(txtValue(2))) <> FLWSystem.flwSuccess Then
    Call MsgBox("Error creating the value " & txtValue(2), vbCritical)
  Else
    intInd = intInd + 1
  End If
  
  If intInd = 3 Then
    Call MsgBox("Keys succesfully created", vbInformation)
  End If
End Sub

Private Sub cmdDelete_Click()
  If objRegistry.DeleteKey(FLWSystem.flwRegUsers, txtSection) <> FLWSystem.flwSuccess Then
    Call MsgBox("Error deleting the key " & txtSection, vbCritical)
  Else
    Call MsgBox("Key succesfully deleted", vbInformation)
  End If
End Sub

Private Sub cmdDeleteValue_Click()
  Dim lngInd As Long
  Dim blnOk  As Boolean
  
  blnOk = True
  For lngInd = 0 To 2
    If chkType(lngInd).Value Then
      If objRegistry.DeleteKey(FLWSystem.flwRegUsers, txtSection, txtName(lngInd)) <> FLWSystem.flwSuccess Then
        Call MsgBox("Error deleting the value " & txtValue(lngInd), vbCritical)
        blnOk = False
      End If
    End If
  Next
  If blnOk Then
    Call MsgBox("Keys succesfully deleted", vbInformation)
  End If
End Sub