home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / arrays / aaarry / demo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-12-19  |  14.5 KB  |  354 lines
  1. VERSION 2.00
  2. Begin Form frmTest 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   6825
  6.    ClientLeft      =   2775
  7.    ClientTop       =   2700
  8.    ClientWidth     =   6450
  9.    Height          =   7515
  10.    Left            =   2715
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   6825
  13.    ScaleWidth      =   6450
  14.    Top             =   2070
  15.    Width           =   6570
  16.    Begin ListBox List1 
  17.       Height          =   4125
  18.       Left            =   240
  19.       TabIndex        =   0
  20.       Top             =   1440
  21.       Width           =   5895
  22.    End
  23.    Begin Shape shapePercentComplete 
  24.       BackColor       =   &H0000FFFF&
  25.       BorderWidth     =   2
  26.       FillColor       =   &H00FF0000&
  27.       FillStyle       =   7  'Diagonal Cross
  28.       Height          =   255
  29.       Left            =   0
  30.       Top             =   6600
  31.       Width           =   4095
  32.    End
  33.    Begin Shape shapeBackGround 
  34.       BorderWidth     =   2
  35.       Height          =   255
  36.       Left            =   0
  37.       Top             =   6600
  38.       Width           =   6495
  39.    End
  40.    Begin Menu mnuFile 
  41.       Caption         =   "&File"
  42.       Begin Menu mnuFileExit 
  43.          Caption         =   "E&xit"
  44.       End
  45.    End
  46.    Begin Menu mnuStr 
  47.       Caption         =   "&String"
  48.       Begin Menu mnuStrNew 
  49.          Caption         =   "&New"
  50.       End
  51.       Begin Menu mnuStrOpen 
  52.          Caption         =   "&Open"
  53.       End
  54.       Begin Menu mnuStrAdd 
  55.          Caption         =   "&Add"
  56.       End
  57.       Begin Menu mnuStrClose 
  58.          Caption         =   "&Close"
  59.       End
  60.       Begin Menu mnuStrAbort 
  61.          Caption         =   "A&bort"
  62.       End
  63.    End
  64.    Begin Menu mnuDemo 
  65.       Caption         =   "&!Demo"
  66.    End
  67. Option Explicit
  68. 'Open
  69. Declare Function AryOpen Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal userTypeDefinition_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  70. Declare Function AryOpenInteger Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  71. Declare Function AryOpenLong Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  72. Declare Function AryOpenSingle Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  73. Declare Function AryOpenDouble Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  74. Declare Function AryOpenCurrency Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  75. Declare Function AryOpenString Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  76. 'Close
  77. Declare Function AryClose Lib "AA-Array.dll" (ByVal ary_h As Integer) As Integer
  78. Declare Sub AryAbort Lib "AA-Array.dll" (ByVal ary_h As Integer)
  79. 'Bounds
  80. Declare Sub ArySetBounds Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal minElement As Long, ByVal maxElement As Long)
  81. Declare Sub AryGetBounds Lib "AA-Array.dll" (ByVal ary_h As Integer, minElement As Long, maxElement As Long)
  82. Declare Function AryCheckIndex Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long) As Integer
  83. 'Set Elements
  84. Declare Sub ArySetElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As Any)
  85. Declare Sub ArySetInteger Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Integer)
  86. Declare Sub ArySetLong Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Long)
  87. Declare Sub ArySetSingle Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Single)
  88. Declare Sub ArySetDouble Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Double)
  89. Declare Sub ArySetCurrency Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Currency)
  90. Declare Sub ArySetString Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As String)
  91. 'Get Elements
  92. Declare Sub AryGetElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As Any)
  93. Declare Sub AryGetInteger Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Integer)
  94. Declare Sub AryGetLong Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Long)
  95. Declare Sub AryGetSingle Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Single)
  96. Declare Sub AryGetDouble Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Double)
  97. Declare Sub AryGetCurrency Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Currency)
  98. Declare Sub AryGetString Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As String)
  99. 'Deletes
  100. Declare Sub AryDeleteElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long)
  101. Declare Sub AryDeleteAll Lib "AA-Array.dll" (ByVal ary_h As Integer)
  102. 'Information
  103. Declare Function AryIsEmptyElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long) As Integer
  104. Declare Function AryGetStatus Lib "AA-Array.dll" (ByVal ary_h As Integer) As Integer
  105. Declare Function AryVersion Lib "AA-Array.dll" (ByVal info_i As Integer) As String
  106. 'Match (registered version only)
  107. Declare Function AryMatchEntry Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Any, index_l As Long) As Integer
  108. Declare Function AryMatchInteger Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Integer, index_l As Long) As Integer
  109. Declare Function AryMatchLong Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Long, index_l As Long) As Integer
  110. Declare Function AryMatchSingle Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Single, index_l As Long) As Integer
  111. Declare Function AryMatchDouble Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Double, index_l As Long) As Integer
  112. Declare Function AryMatchCurrency Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Currency, index_l As Long) As Integer
  113. Declare Function AryMatchString Lib "AA-Array.dll" (ByVal ary_h As Integer, value As String, index_l As Long) As Integer
  114. Const AryUseExisting = 0
  115. Const AryCreateNew = 1
  116. Const AryReadOnly = 2
  117. Const AryReadWrite = 0
  118. Const AryNonPersistent = 4
  119. Const AryPersistent = 0
  120. 'Integer/Long Array
  121. Dim mnuIntFileName_str As String
  122. Dim mnuIntArray_h As Integer
  123. Const mnuIntArrayLb = 1
  124. Const mnuIntArrayUb = 10
  125. ' String Array
  126. Dim mnuStrFileName_str As String
  127. Dim mnuStrArray_h As Integer
  128. Const mnuStrArrayLb = 1
  129. Const mnuStrArrayUb = 10
  130. ' Fixed String Array
  131. Dim mnuFixedStrFileName_str As String
  132. Dim mnuFixedStrArray_h As Integer
  133. Const mnuFixedStrArrayLb = 1
  134. Const mnuFixedStrArrayUb = 10
  135. Dim hinstAAArrayDLL As Integer
  136. Dim previousPercentage_i As Integer
  137. Sub Form_Load ()
  138.    'Indicate that there is no file open
  139.    mnuIntArray_h = -1
  140.    mnuStrArray_h = -1
  141.    mnuFixedStrArray_h = -1
  142.    Me.Print AryVersion(0)
  143.    pBarPlaceAtBottom Me
  144.    previousPercentage_i = 0
  145.    pBarSet Me, 50
  146. End Sub
  147. Sub mnuDemo_Click ()
  148.          
  149.    list1.Clear
  150.    'Create extended string array
  151.    pAddItem1 list1, "Creating Extended Array"
  152.    Dim strAry_h As Integer
  153.    strAry_h = AryOpenString("c:\tstStr.ary", AryCreateNew + AryPersistent, "")
  154.    If strAry_h < 0 Then
  155.       pAddItem1 list1, "Cannot create extended array."
  156.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  157.       Exit Sub
  158.    End If
  159.    'Set the array's lower and upper bounds
  160.    Const firstElement = 1234567890
  161.    pAddItem1 list1, "Setting Bounds to: " & Str$(firstElement) & Str$(firstElement + 100)
  162.    ArySetBounds strAry_h, firstElement, firstElement + 100
  163.    'Set every other element to something big
  164.    pAddItem1 list1, "Setting Every Other Element"
  165.    Dim dummyString As String
  166.    dummyString = Space(1311)
  167.    Dim i As Long
  168.    For i = firstElement To firstElement + 100 Step 2
  169.       ArySetString strAry_h, i, Str$(i) & dummyString
  170.    Next i
  171.    pAddItem1 list1, "Closing Extended Array"
  172.    Dim retval As Integer
  173.    retval = AryClose(strAry_h)
  174.    If retval < 0 Then
  175.       pAddItem1 list1, "Cannot write extended array to disk."
  176.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  177.       Exit Sub
  178.    End If
  179.    'Open extended string array
  180.    pAddItem1 list1, "Reopening Extended Array"
  181.    strAry_h = AryOpenString("c:\tstStr.ary", AryUseExisting + AryPersistent, "")
  182.    If strAry_h < 0 Then
  183.       pAddItem1 list1, "Cannot open extended array."
  184.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  185.       Exit Sub
  186.    End If
  187.    'Get the array's lower and upper bounds
  188.    Dim lowerBound As Long
  189.    Dim upperBound As Long
  190.    AryGetBounds strAry_h, lowerBound, upperBound
  191.    pAddItem1 list1, "Retrieved Bounds: " & Str$(lowerBound) & Str$(upperBound)
  192.    'Get every element
  193.    pAddItem1 list1, "Retrieved Element Values (i=value)"
  194.    Dim retString As String
  195.    retString = Space(1311)
  196.    For i = lowerBound To upperBound
  197.       AryGetString strAry_h, i, retString
  198.       list1.AddItem Str$(i) & "='" & Trim$(retString) & "'"
  199.    Next i
  200.    pAddItem1 list1, "Closing Extended Array"
  201.    retval = AryClose(strAry_h)
  202.    If retval < 0 Then
  203.       pAddItem1 list1, "Cannot write extended array to disk."
  204.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  205.       Exit Sub
  206.    End If
  207. End Sub
  208. Sub mnuFileExit_Click ()
  209.    End
  210. End Sub
  211. Sub mnuStrAbort_Click ()
  212. '= Abort an extended array.
  213.    list1.Clear
  214.    If mnuStrArray_h >= 0 Then
  215.       AryAbort mnuStrArray_h
  216.       
  217.       mnuStrArray_h = -1
  218.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Aborted"
  219.    Else
  220.       
  221.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Not Opended"
  222.    End If
  223. End Sub
  224. Sub mnuStrAdd_Click ()
  225. '= Add something to each element of the extended array.
  226.    ' Make sure array is already opended
  227.    If mnuStrArray_h < 0 Then
  228.       pAddItem1 list1, "Extended array not opended"
  229.       Exit Sub
  230.    End If
  231.    ' Get array bounds
  232.    Dim lb As Long, ub As Long
  233.    AryGetBounds mnuStrArray_h, lb, ub
  234.    ' Do the add to each element
  235.    Dim t As String
  236.    Dim i As Long
  237.    For i = lb To ub
  238.       'Get the element
  239.       AryGetString mnuStrArray_h, i, t
  240.       ' Add a bit
  241.       t = Str$(Val(t) + 1)
  242.       'Set the new value of the element
  243.       ArySetString mnuStrArray_h, i, t
  244.    Next i
  245.    list1.Refresh
  246.    pAddItem1 list1, "Added a bit to all elements"
  247. End Sub
  248. Sub mnuStrClose_Click ()
  249. '= Close an extended array.
  250.    list1.Clear
  251.    ' Close previously opended file.
  252.    pCloseArray mnuStrArray_h
  253.    pAddItem1 list1, "File: " & mnuStrFileName_str & " Closed"
  254. End Sub
  255. Sub mnuStrNew_Click ()
  256. '= Create new extended array. Zero's all elements
  257.    Dim retval As Integer
  258.    list1.Clear
  259.    ' Close previously opended file.
  260.    pCloseArray mnuStrArray_h
  261.    ' Create new extended array of type testIntLong
  262.    Do
  263.       mnuStrFileName_str = InputBox$("Enter array name", "New", mnuStrFileName_str)
  264.       If mnuStrFileName_str = "" Then Exit Sub
  265.       mnuStrArray_h = AryOpenString(mnuStrFileName_str, AryCreateNew + AryPersistent, "")
  266.       pAddItem1 list1, "AryOpenString: " & Str$(mnuStrArray_h)
  267.    Loop While mnuStrArray_h < 0
  268.    pAddItem1 list1, "File: " & mnuStrFileName_str & " Created"
  269.    list1.Refresh
  270.    ' Set array bounds
  271.    ArySetBounds mnuStrArray_h, mnuStrArrayLb, mnuStrArrayUb
  272.    pAddItem1 list1, "Bounds set to:" & Str$(mnuStrArrayLb) & Str$(mnuStrArrayUb)
  273.    list1.Refresh
  274.    ' Zero all elements of array
  275.    Dim t As String
  276.    Dim i As Long
  277.    For i = mnuStrArrayLb To mnuStrArrayUb
  278.       t = Str$(i)
  279.       ArySetString mnuStrArray_h, i, t
  280.    Next i
  281.    pAddItem1 list1, "Zeroed all elements"
  282.    list1.Refresh
  283.    ' Close extended array
  284.    pCloseArray mnuStrArray_h
  285.    pAddItem1 list1, "Extended array closed."
  286.    list1.Refresh
  287. End Sub
  288. Sub mnuStrOpen_Click ()
  289. '= Opens an extended array. Prints all elements on form. Leaves it open.
  290.    list1.Clear
  291.    ' Ensure array is open
  292.    If mnuStrArray_h < 0 Then   'Array not open
  293.       '
  294.       ' Open extended array of type testIntLong
  295.       '
  296.       Do
  297.          mnuStrFileName_str = InputBox$("Enter array name", "Open", mnuStrFileName_str)
  298.          If mnuStrFileName_str = "" Then Exit Sub
  299.          mnuStrArray_h = AryOpenString(mnuStrFileName_str, AryUseExisting + AryPersistent, "")
  300.          pAddItem1 list1, "AryOpenString" & Str$(mnuStrArray_h)
  301.       Loop While mnuStrArray_h < 0
  302.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Opened"
  303.       list1.Refresh
  304.    End If
  305.    ' Show array bounds
  306.    Dim lb As Long, ub As Long
  307.    AryGetBounds mnuStrArray_h, lb, ub
  308.    pAddItem1 list1, "Bounds: " & Str$(lb) & Str$(ub)
  309.    list1.Refresh
  310.    ' Display all elements of array
  311.    Dim t As String
  312.    pAddItem1 list1, "Element=t.str"
  313.    Dim i As Long
  314.    For i = lb To ub
  315.       AryGetString mnuStrArray_h, i, t
  316.       pAddItem1 list1, Str$(i) & "=" & t
  317.    Next i
  318.    list1.Refresh
  319. End Sub
  320. Sub pAddItem1 (c As Control, s As String)
  321.    c.AddItem s
  322.    c.Refresh
  323. End Sub
  324. Sub pBarPlaceAtBottom (f As Form)
  325.    f.shapeBackGround.Left = 0
  326.    f.shapeBackGround.Width = f.Width
  327.    f.shapeBackGround.Top = f.ScaleHeight - f.shapeBackGround.Height
  328.    f.shapePercentComplete.Left = f.shapeBackGround.Left
  329.    f.shapePercentComplete.Width = f.shapeBackGround.Width
  330.    f.shapePercentComplete.Top = f.shapeBackGround.Top
  331. End Sub
  332. Sub pBarSet (f As Form, percentage_i As Integer)
  333.    If Abs(percentage_i - previousPercentage_i) < 5 Then Exit Sub
  334.    previousPercentage_i = percentage_i
  335.    f.shapePercentComplete.Width = f.shapeBackGround.Width * (percentage_i / 100#)
  336.    f.shapePercentComplete.Refresh
  337. End Sub
  338. Sub pCloseArray (ary_h As Integer)
  339.    If ary_h >= 0 Then
  340.       Dim retval As Integer
  341.       retval = AryClose(ary_h)
  342.       ary_h = -1
  343.       If retval < 0 Then
  344.          pAddItem1 list1, "Error closing previously opened arrry. Error Code:" & Str$(retval)
  345.       End If
  346.    End If
  347. End Sub
  348. Sub pGetBounds (l As Variant, u As Variant)
  349.    If IsEmpty(l) Then l = 0&
  350.    If IsEmpty(u) Then u = 100&
  351.    l = InputBox$("Lower", "Bound", Str$(l))
  352.    u = InputBox$("Upper", "Bound", Str$(u))
  353. End Sub
  354.