Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/text_utl/parsed/parse.frm

Visual Basic Form | 1994-10-04 | 10.7 KB | 323 lines

VERSION 2.00
Begin Form frmParse
   Caption         =   "Parse Demo - Parse and Process Text"
   ClientHeight    =   5685
   ClientLeft      =   75
   ClientTop       =   675
   ClientWidth     =   9450
   Height          =   6405
   Icon            =   PARSE.FRX:0000
   Left            =   0
   LinkTopic       =   "Form1"
   ScaleHeight     =   540
   ScaleWidth      =   540
   Top             =   30
   Width           =   9600
   Begin CommandButton cmdReturn
      Caption         =   "&Return To Main Menu"
      Height          =   435
      Left            =   6240
      TabIndex        =   15
      Top             =   420
      Width           =   2715
   End
   Begin CommandButton cmdChange
      Caption         =   "&Change"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   315
      Left            =   4440
      TabIndex        =   14
      Top             =   660
      Width           =   915
   End
   Begin VScrollBar VScroll1
      Height          =   315
      Left            =   8880
      Max             =   32000
      Min             =   1
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   1620
      Value           =   1000
      Width           =   255
   End
   Begin CommandButton cmdProcess
      Caption         =   "&Process Text"
      Height          =   390
      Left            =   6810
      TabIndex        =   1
      Top             =   2100
      Width           =   1965
   End
   Begin TextBox txtFileContents
      Height          =   3060
      Left            =   270
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   1995
      Width           =   5910
   End
   Begin CommandButton cmdSelectFile
      Caption         =   "&Select File"
      Height          =   345
      Left            =   360
      TabIndex        =   0
      Top             =   1500
      Width           =   1650
   End
   Begin Label lblCurFunc
      Caption         =   "lblCurFunc"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   840
      TabIndex        =   13
      Top             =   660
      Width           =   3375
   End
   Begin Shape Shape2
      Height          =   4230
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   1320
      Width           =   9225
   End
   Begin Label lblReDimInt
      BorderStyle     =   1  'Fixed Single
      Caption         =   "10"
      ForeColor       =   &H00C0C0C0&
      Height          =   285
      Left            =   8130
      TabIndex        =   11
      Top             =   1635
      Width           =   600
   End
   Begin Label Label2
      Caption         =   "ReDim Interval:"
      ForeColor       =   &H00C0C0C0&
      Height          =   270
      Left            =   6720
      TabIndex        =   10
      Top             =   1635
      Width           =   1425
   End
   Begin Label lblLineCountAdj
      BorderStyle     =   1  'Fixed Single
      Height          =   795
      Left            =   6495
      TabIndex        =   9
      Top             =   3345
      Width           =   2655
   End
   Begin Label lblLineCount
      BorderStyle     =   1  'Fixed Single
      Height          =   690
      Left            =   6495
      TabIndex        =   8
      Top             =   2595
      Width           =   2655
   End
   Begin Label lblWordCount
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   6495
      TabIndex        =   7
      Top             =   4215
      Width           =   2655
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Currently Selected Function"
      Height          =   315
      Left            =   1740
      TabIndex        =   6
      Top             =   180
      Width           =   2475
   End
   Begin Shape Shape1
      Height          =   1215
      Left            =   420
      Shape           =   4  'Rounded Rectangle
      Top             =   60
      Width           =   5160
   End
   Begin Label lblFileLen
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   360
      TabIndex        =   5
      Top             =   5145
      Width           =   3090
   End
   Begin Label lblInfo
      BorderStyle     =   1  'Fixed Single
      Height          =   750
      Left            =   6495
      TabIndex        =   4
      Top             =   4605
      Width           =   2655
   End
   Begin Label lblFileName
      BorderStyle     =   1  'Fixed Single
      Height          =   300
      Left            =   2160
      TabIndex        =   3
      Top             =   1560
      Width           =   4335
   End
   Begin Menu mnuExit
      Caption         =   "E&xit!"
   End
Option Explicit
Sub cmdChange_Click ()
    Me.WindowState = MINIMIZED
    Screen.MousePointer = HOURGLASS
    SetfrmSelect (lblCurFunc), FLG_PROCPARSE
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 on frmSelect.
   Screen.MousePointer = HOURGLASS
   'call appropriate proc.
   If lblCurFunc = "ParseAndFillArray1%()" 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
      Screen.MousePointer = DEFAULT
      MsgBox "ParseAndFillArray1% calls Completed.", MB_ICONINFORMATION
   ElseIf lblCurFunc = "ParseAndFillArray2%()" Then
      '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
      Screen.MousePointer = DEFAULT
      MsgBox "ParseAndFillArray2%  calls Completed.", MB_ICONINFORMATION
   Else 'lblCurFunc = "Pars&eAndFill&ListBox%()"
      CurTime! = Timer
      LineCount% = ParseAndFillListBox%((txtFileContents), crlf$, frmListBox!List1)

      'build a new string with crlf's replaced by spaces
      'LineCountAdj% passed byref. and filled with adjusted value for # lines
      NewString$ = ProcessList$(frmListBox!List1, Chr$(32), LineCountAdj%)

      frmListBox!List1.Clear
      'get word count by passing processed string with all spaces
      WordCount% = ParseAndFillListBox%(NewString$, SpaceChar$, frmListBox!List1)
      NewTime! = Timer
      Screen.MousePointer = DEFAULT
      MsgBox "ParseAndFillListBox% calls Completed.", MB_ICONINFORMATION
      'clear list again since it may be used later here or in frmMultiDelim
      frmListBox!List1.Clear
   End If
   '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 cmdReturn_Click ()
    Me.WindowState = MINIMIZED
    frmMain.Show
    frmMain.WindowState = NORMAL
End Sub
Sub cmdSelectFile_Click ()
   Screen.MousePointer = HOURGLASS
   frmSelFile.Show MODAL
End Sub
Sub Form_Activate ()
   Screen.MousePointer = DEFAULT
    'set controls related to array resizing for
    'ParseAndFillArray2%()
    If lblCurFunc = "ParseAndFillArray2%()" Then
        Label2.ForeColor = BLACK
        lblReDimInt.ForeColor = BLACK
        VScroll1.Enabled = True
    Else
        Label2.ForeColor = LIGHT_GRAY
        lblReDimInt.ForeColor = LIGHT_GRAY
        VScroll1.Enabled = False
    End If

End Sub
Sub mnuExit_Click ()
    EndProg
End Sub
Sub VScroll1_Change ()
    Static OldVScrollValue%
    Static vsChangeCt%
    vsChangeCt% = vsChangeCt% + 1
    'change the redim label based on the change in the scrollbar
    'value from the last scrollbar change event
    If VScroll1.Value > OldVScrollValue% And vsChangeCt% > 1 Then
    'set 1 less
        If CInt(lblReDimInt) > 5 Then
            lblReDimInt = CStr(CInt(lblReDimInt) - 1)
        End If
    Else  'VScroll1.Value < OldVScrollValue% Then
    'increase by 1
        If CInt(lblReDimInt) < 200 Then
            lblReDimInt = CStr(CInt(lblReDimInt) + 1)
        End If
    End If
    'save scroll value in static var for next VScroll1_Change
    OldVScrollValue% = VScroll1.Value
End Sub