frm_gendata.frm

vb apriori algorithm

VERSION 5.00
Begin VB.Form Frm_gendata 
   Caption         =   "Form1"
   ClientHeight    =   7470
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9720
   LinkTopic       =   "Form1"
   ScaleHeight     =   7470
   ScaleWidth      =   9720
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton writedb100000250 
      Caption         =   "writedb100000_250"
      Height          =   255
      Left            =   120
      TabIndex        =   20
      Top             =   720
      Width           =   1695
   End
   Begin VB.CommandButton Cmd1000to10002 
      Caption         =   "Cmd1000to10002"
      Height          =   255
      Left            =   4800
      TabIndex        =   19
      Top             =   240
      Width           =   1575
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   6840
      TabIndex        =   18
      Text            =   "Combo1"
      Top             =   4080
      Width           =   2055
   End
   Begin VB.CommandButton GenL2ByH2 
      Caption         =   "GenL2ByH2"
      Height          =   495
      Left            =   7200
      TabIndex        =   17
      Top             =   360
      Width           =   1815
   End
   Begin VB.CommandButton TestH2 
      Caption         =   "TestH2"
      Height          =   495
      Left            =   3840
      TabIndex        =   16
      Top             =   4920
      Width           =   1215
   End
   Begin VB.Frame Frame6 
      Caption         =   "Frame6"
      Height          =   1335
      Left            =   2040
      TabIndex        =   15
      Top             =   5640
      Width           =   4335
   End
   Begin VB.Frame Frame5 
      Caption         =   "Frame5"
      Height          =   1815
      Left            =   120
      TabIndex        =   14
      Top             =   5040
      Width           =   1455
   End
   Begin VB.Frame Frame4 
      Caption         =   "Frame4"
      Height          =   1695
      Left            =   7200
      TabIndex        =   13
      Top             =   5160
      Width           =   1095
   End
   Begin VB.Frame Frame3 
      Caption         =   "Frame3"
      Height          =   3495
      Left            =   6720
      TabIndex        =   12
      Top             =   0
      Width           =   2655
      Begin VB.CommandButton Command1 
         Caption         =   "Command1"
         Height          =   495
         Left            =   720
         TabIndex        =   21
         Top             =   1920
         Width           =   1695
      End
   End
   Begin VB.CommandButton AddRndItem 
      Caption         =   "AddRndItem"
      Height          =   495
      Left            =   4680
      TabIndex        =   11
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton TestStrDecold 
      Caption         =   "TestStrDecold"
      Height          =   495
      Left            =   3240
      TabIndex        =   10
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton testStrDecompose 
      Caption         =   "testStrDecompose"
      Height          =   495
      Left            =   1560
      TabIndex        =   9
      Top             =   1920
      Width           =   1575
   End
   Begin VB.Frame Frame2 
      Caption         =   "Test"
      Height          =   1815
      Left            =   0
      TabIndex        =   7
      Top             =   1680
      Width           =   6495
      Begin VB.CommandButton TestDBVisitTime 
         Caption         =   "testdbvisittime"
         Height          =   495
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   1335
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Generate DB"
      Height          =   1575
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   6495
      Begin VB.CommandButton writedb10000 
         Caption         =   "writedb10000"
         Height          =   255
         Left            =   3240
         TabIndex        =   6
         Top             =   240
         Width           =   1455
      End
      Begin VB.CommandButton writedb1000 
         Caption         =   "writedb1000"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Width           =   1455
      End
      Begin VB.CommandButton writeDB100000 
         Caption         =   "writedb100000"
         Height          =   255
         Left            =   1680
         TabIndex        =   4
         Top             =   240
         Width           =   1455
      End
   End
   Begin VB.CommandButton Command7 
      Caption         =   "Command7"
      Height          =   495
      Left            =   2040
      TabIndex        =   2
      Top             =   4080
      Width           =   1575
   End
   Begin VB.CommandButton Command6 
      Caption         =   "TestC2inTrans"
      Height          =   495
      Left            =   1680
      TabIndex        =   1
      Top             =   4920
      Width           =   1815
   End
   Begin VB.CommandButton Command3 
      Caption         =   "readdb"
      Height          =   495
      Left            =   3720
      TabIndex        =   0
      Top             =   4080
      Width           =   1455
   End
End
Attribute VB_Name = "Frm_gendata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 Dim head As node
 Dim pointer As node
 Dim newnode As node
 Dim n As node
 Dim counts As Long
 Dim temp As node
Private Sub createlist_Click()
 Dim n As node
 Dim i As Long
 counts = 0
 Set head = New node  '可选的。通常在声明时使用 New，以便可以隐式创建对象。如果 New 与 Set 一起使用，
                      '则将创建该类的一个新实例。如果 objectvar 包含了一个对象引用，则在赋新值时释放
                      '该引用
                   
 head.x = 8
 Set head.nextnode = Nothing
 counts = counts + 1
 head.count = counts
 Set pointer = head
For i = 1 To 15
  Set newnode = New node
   newnode.x = i
   counts = counts + 1
   newnode.count = counts
   Set newnode.nextnode = Nothing
   Set pointer.nextnode = newnode
   Set pointer = newnode
Next i
Set pointer.nextnode = head
 Set pointer = head
  Do
        Print pointer.x
        Set pointer = pointer.nextnode
        If ObjPtr(pointer) = ObjPtr(head) Then                 'objptr返回对象的地址
             Exit Sub                                          'strptr返回变长字符串的字符串数据地址
        End If                                                 'varptr返回变量的地址
        DoEvents                                               '用与获取变量地址，是函数。
 Loop While Not pointer Is Nothing
End Sub

Private Sub delete_Click()
  Dim a As Long
  Dim b As Long
  a = CLng(InputBox("输入要删除的一个数据", "输入数据"))
  b = CLng(InputBox("输入该数据的位置", "位置"))
   Set pointer = head
  If b = 1 Then
     Do
      Set pointer = pointer.nextnode
       If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
             Set pointer.nextnode = head.nextnode
             Set head = Nothing
             Set head = pointer.nextnode
            Exit Do
       End If
      DoEvents
     Loop While Not pointer Is Nothing
     counts = 1
    Set pointer = head
    pointer.count = counts
    Do
        counts = counts + 1
        Set pointer = pointer.nextnode
        pointer.count = counts
      If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
             Exit Do
      End If
      DoEvents
     Loop While Not pointer Is Nothing
Else
      While pointer.count <> b
          Set n = New node
           Set n = pointer
           Set pointer = pointer.nextnode
          DoEvents
      Wend
      Set n.nextnode = pointer.nextnode
      Set pointer = Nothing
      Set pointer = n
   End If
     counts = 0
   Set pointer = head
      counts = counts + 1
      pointer.count = counts
    Do
    counts = counts + 1
    Set pointer = pointer.nextnode
    pointer.count = counts
      If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
             Exit Do
      End If
      DoEvents
     Loop While Not pointer Is Nothing
End Sub

Private Sub insert_Click()
  Dim a As Long
  Dim b As Long
  a = CLng(InputBox("输入要插入的一个数据", "输入数据"))
  b = CLng(InputBox("输入该数据的位置", "位置"))
  Set pointer = head
  If b = 1 Then
  head.x = a
  Else
  While pointer.count <> b
  Set pointer = pointer.nextnode
    DoEvents
  Wend
  pointer.x = a
  End If
End Sub

Private Sub insert2_Click()
  Dim a As Long
  Dim b As Long
  a = CLng(InputBox("输入要删除的一个数据", "输入数据"))
  b = CLng(InputBox("输入该数据的位置", "位置"))
  Set pointer = head
  If b = 1 Then
   Set n = New node
   n.x = a
   Set n.nextnode = Nothing
   Do
    Set pointer = pointer.nextnode
    If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
         Set pointer.nextnode = n
         Set n.nextnode = head
         Set head = n
         Exit Do
    End If
    Loop While Not pointer Is Nothing
    Set pointer = head
    counts = 1
    pointer.count = 1
    Do
     counts = counts + 1
     Set pointer = pointer.nextnode
     pointer.count = counts
     If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
             Exit Do
     End If
     Loop While Not pointer Is Nothing
   Else
   Set n = New node
       n.x = a
     Set n.nextnode = Nothing
    While pointer.count <> b
       Set temp = New node
       Set temp = pointer
       Set pointer = pointer.nextnode
       DoEvents
     Wend
     Set n.nextnode = pointer
     Set temp.nextnode = n
     Set pointer = n
     Set pointer = head
     counts = 1