Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/parsed/parse.frm

Visual Basic Form | 1995-05-02 | 10.2 KB | 327 lines

VERSION 2.00
Begin Form frmParse
   Caption         =   "Parse Demo Main Menu"
   ClientHeight    =   5685
   ClientLeft      =   75
   ClientTop       =   645
   ClientWidth     =   9450
   Height          =   6375
   Left            =   15
   LinkTopic       =   "Form1"
   ScaleHeight     =   5685
   ScaleWidth      =   9450
   Top             =   15
   Width           =   9570
   Begin SpinButton Spin1
      Delay           =   100
      Enabled         =   0   'False
      Height          =   345
      Left            =   8385
      Top             =   1635
      Width           =   270
   End
   Begin CommandButton cmdMulti
      Caption         =   "&Multiple Char. Delim Test"
      Height          =   360
      Left            =   6135
      TabIndex        =   10
      Top             =   330
      Width           =   2580
   End
   Begin OptionButton optParse
      Caption         =   "Pars&eAndFillArray2%()"
      Height          =   270
      Index           =   1
      Left            =   525
      TabIndex        =   1
      Top             =   915
      Width           =   4965
   End
   Begin OptionButton optParse
      Caption         =   "Pars&eAndFillArray1%()"
      Height          =   270
      Index           =   0
      Left            =   525
      TabIndex        =   0
      Top             =   570
      Value           =   -1  'True
      Width           =   4965
   End
   Begin CommandButton cmdProcess
      Caption         =   "&Process Text"
      Height          =   390
      Left            =   6810
      TabIndex        =   3
      Top             =   2085
      Width           =   1965
   End
   Begin TextBox txtFileContents
      Height          =   3060
      Left            =   270
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Top             =   1995
      Width           =   5910
   End
   Begin CommandButton cmdSelectFile
      Caption         =   "&Select File"
      Height          =   345
      Left            =   345
      TabIndex        =   2
      Top             =   1485
      Width           =   1965
   End
   Begin Shape Shape3
      Height          =   1095
      Left            =   5835
      Shape           =   4  'Rounded Rectangle
      Top             =   165
      Width           =   3405
   End
   Begin Shape Shape2
      Height          =   4230
      Left            =   105
      Shape           =   4  'Rounded Rectangle
      Top             =   1380
      Width           =   9225
   End
   Begin Label lblReDimInt
      BorderStyle     =   1  'Fixed Single
      Caption         =   "10"
      ForeColor       =   &H00C0C0C0&
      Height          =   285
      Left            =   7830
      TabIndex        =   14
      Top             =   1635
      Width           =   420
   End
   Begin Label Label2
      Caption         =   "ReDim Interval:"
      ForeColor       =   &H00C0C0C0&
      Height          =   270
      Left            =   6315
      TabIndex        =   13
      Top             =   1635
      Width           =   1425
   End
   Begin Label lblLineCountAdj
      BorderStyle     =   1  'Fixed Single
      Height          =   795
      Left            =   6495
      TabIndex        =   12
      Top             =   3345
      Width           =   2655
   End
   Begin Label lblLineCount
      BorderStyle     =   1  'Fixed Single
      Height          =   690
      Left            =   6495
      TabIndex        =   11
      Top             =   2595
      Width           =   2655
   End
   Begin Label lblWordCount
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   6495
      TabIndex        =   9
      Top             =   4215
      Width           =   2655
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Select Function To Test:"
      Height          =   270
      Left            =   1590
      TabIndex        =   8
      Top             =   255
      Width           =   2475
   End
   Begin Shape Shape1
      Height          =   1200
      Left            =   420
      Shape           =   4  'Rounded Rectangle
      Top             =   150
      Width           =   5160
   End
   Begin Label lblFileLen
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   360
      TabIndex        =   7
      Top             =   5145
      Width           =   3090
   End
   Begin Label lblInfo
      BorderStyle     =   1  'Fixed Single
      Height          =   750
      Left            =   6495
      TabIndex        =   6
      Top             =   4605
      Width           =   2655
   End
   Begin Label lblFileName
      BorderStyle     =   1  'Fixed Single
      Height          =   300
      Left            =   2610
      TabIndex        =   5
      Top             =   1530
      Width           =   3435
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin Menu mnuInfo
      Caption         =   "&Info!"
   End
Option Explicit
Sub cmdMulti_Click ()
   Screen.MousePointer = HOURGLASS
   Load frmMultiDelim
   If optParse(0).Value = True Then
      frmMultiDelim!lblCurRoutine = "ParseAndFillArray1%()"
   Else
      frmMultiDelim!lblCurRoutine = "ParseAndFillArray2%()"
   End If
   frmMultiDelim.Show NORMAL
   Me.WindowState = MINIMIZED
End Sub
Sub cmdProcess_Click ()
   Dim LineCount%, LineCountAdj%, WordCount%
   Dim ret%, SetReDim%
   Dim NewString$
   Dim crlf$, SpaceChar$
   Dim DynArray$()
   Dim CurTime!, NewTime!, TotalTime!
   'set delimiters
   crlf$ = Chr$(13) & Chr$(10)
   SpaceChar$ = Chr$(32)
   'clear previous displayed info
   lblLineCount = ""
   lblLineCountAdj = ""
   lblWordCount = ""
   lblInfo = ""
   'allow these labels to clear
   DoEvents
   'NOTE: In a previous program
   'I also tested QuickPak Professional parse routines
   'and VideoSoft VSAWK (VSVBX). If
   'you come up with a faster routine, just add it to
   'this project and create another optParse radio button
   'for it.
   Screen.MousePointer = HOURGLASS
   'call appropriate proc.
   If optParse(0).Value = True Then
   'use ParseAndFillArray1% function
      CurTime! = Timer
      LineCount% = ParseAndFillArray1%((txtFileContents), crlf$, DynArray$())
      'build a new string with crlf's replaced by Chr$(32) 's
      'LineCountAdj% passed byref. and filled with adjusted value for # lines
      NewString$ = ProcessArray$(DynArray$(), Chr$(32), LineCountAdj%)
      'erase array storage
      Erase DynArray$
      'get word count by passing processed string with all spaces
      WordCount% = ParseAndFillArray1%(NewString$, SpaceChar$, DynArray$())
      NewTime! = Timer
      MsgBox "ParseAndFillArray1%() Completed.", MB_ICONINFORMATION
   Else  'If optParse(1).Value = True
      'get ReDim setting from user
      'assign the Redim setting
      SetReDim% = ret%
      CurTime! = Timer
      LineCount% = ParseAndFillArray2%((txtFileContents), crlf$, DynArray$(), CInt(lblReDimInt))
      'build a new string with crlf's replaced by Chr$(32) 's
      'LineCountAdj% passed byref. and filled with adjusted value for # lines
      NewString$ = ProcessArray$(DynArray$(), Chr$(32), LineCountAdj%)
      'erase array storage
      Erase DynArray$
      'get word count by passing processed string with all spaces
      WordCount% = ParseAndFillArray2%(NewString$, SpaceChar$, DynArray$(), 10)
      NewTime! = Timer
      MsgBox "ParseAndFillArray2%() Completed.", MB_ICONINFORMATION
   End If
   Screen.MousePointer = DEFAULT
   'display the info
   'line count
   lblLineCount = "Number of Lines (including extra CRLF pairs): " & CStr(LineCount%)
   'adjusted line count
   lblLineCountAdj = "Adjusted Number of Lines (Extra CRLF pairs were removed): " & CStr(LineCountAdj%)
   'word count
   lblWordCount = "Number of Words: " & CStr(WordCount%)
   'total time elapsed
   TotalTime! = NewTime! - CurTime!
   If TotalTime! >= .05 Then
      lblInfo = "Total execution time to fill array with words: " & Format$(TotalTime!, "###.###") & " s."
   Else
      lblInfo = "Total execution time to fill array with words: < 50 ms"
   End If
End Sub
Sub cmdSelectFile_Click ()
   Screen.MousePointer = HOURGLASS
   frmSelFile.Show MODAL
End Sub
Sub Form_Activate ()
   Screen.MousePointer = DEFAULT
End Sub
Sub Form_Unload (Cancel As Integer)
   EndProg
End Sub
Sub mnuFileExit_Click ()
   EndProg
End Sub
Sub mnuInfo_Click ()
   Dim Msg$
   Msg$ = "For information on this project, press the Select File button and load the PARSEME.TXT readme file for the project."
   MsgBox Msg$, MB_ICONINFORMATION
End Sub
Sub optParse_Click (index As Integer)
   'disable spin control and
   'gray out controls for redim setting if
   '#2 routine chosen
   If index = 1 Then
      If optParse(index).Value = True Then
         Spin1.Enabled = True
         Label2.ForeColor = &H80000008
         lblReDimInt.ForeColor = &H80000008
      Else
         Spin1.Enabled = False
         Label2.ForeColor = &HC0C0C0
         lblReDimInt.ForeColor = &HC0C0C0
      End If
   Else
      If optParse(index).Value = True Then
         Spin1.Enabled = False
         Label2.ForeColor = &HC0C0C0
         lblReDimInt.ForeColor = &HC0C0C0
      Else
         Spin1.Enabled = True
         Label2.ForeColor = &H80000008
         lblReDimInt.ForeColor = &H80000008
      End If
   End If
End Sub
Sub Spin1_SpinDown ()
   Dim CurInt%
   'decrement ReDim int. by 5 if 10 or greater
   CurInt% = CInt(lblReDimInt)
   If CurInt% > 5 Then
      CurInt% = CurInt% - 5
   End If
   lblReDimInt = CInt(CurInt%)
End Sub
Sub Spin1_SpinUp ()
   Dim CurInt%
   'increment ReDim int. by 5 (max. 200)
   CurInt% = CInt(lblReDimInt)
   If CurInt% < 200 Then
      CurInt% = CurInt% + 5
   End If
   lblReDimInt = CInt(CurInt%)
End Sub