Programming Tool Box/SIMS_2.iso/vb_code1/fp_demo/gifpdemo.frm

Text File | 1994-01-18 | 11KB | 397 lines

VERSION 2.00
Begin Form frmMain
   Caption         =   "Gregg Irwin's Demo #1 of Software Source's ""FieldPack"""
   ClientHeight    =   5100
   ClientLeft      =   1350
   ClientTop       =   2280
   ClientWidth     =   7935
   Height          =   5790
   Left            =   1290
   LinkTopic       =   "Form1"
   ScaleHeight     =   340
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   529
   Top             =   1650
   Width           =   8055
   Begin CommandButton cmdBoth
      Caption         =   "&Both Path and Filename..."
      Height          =   375
      Left            =   5040
      TabIndex        =   15
      Top             =   930
      Width           =   2565
   End
   Begin Frame fmeDelimitedStringFunctions
      Caption         =   "Manipulate a Delimited String "
      Height          =   2925
      Left            =   2760
      TabIndex        =   6
      Top             =   2070
      Width           =   4935
      Begin CommandButton cmdClearList
         Caption         =   "Cl&ear List"
         Height          =   375
         Left            =   120
         TabIndex        =   0
         Top             =   2340
         Width           =   1560
      End
      Begin CommandButton cmdLoadList
         Caption         =   "&Load List"
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   1860
         Width           =   1560
      End
      Begin ListBox lstItems
         Height          =   1005
         Left            =   1950
         TabIndex        =   14
         Top             =   1800
         Width           =   2865
      End
      Begin TextBox txtTestString
         Height          =   555
         Left            =   1950
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   11
         Text            =   "Sam, Don, Tony, Gregg"
         Top             =   570
         Width           =   2865
      End
      Begin TextBox txtDelimiter
         Height          =   345
         Left            =   2880
         MultiLine       =   -1  'True
         TabIndex        =   10
         Text            =   ","
         Top             =   1260
         Width           =   585
      End
      Begin CommandButton cmdWordCount
         Caption         =   "&Word Count"
         Height          =   375
         Left            =   120
         TabIndex        =   9
         Top             =   300
         Width           =   1560
      End
      Begin CommandButton cmdParseString
         Caption         =   "Pa&rse String"
         Height          =   375
         Left            =   120
         TabIndex        =   8
         Top             =   780
         Width           =   1560
      End
      Begin CommandButton cmdSplitString
         Caption         =   "&Split String"
         Height          =   375
         Left            =   120
         TabIndex        =   7
         Top             =   1260
         Width           =   1560
      End
      Begin Label lblTestString
         Caption         =   "Test &String:"
         Height          =   255
         Left            =   1950
         TabIndex        =   13
         Top             =   330
         Width           =   2835
      End
      Begin Label lblDelimiter
         Caption         =   "&Delimiter:"
         Height          =   225
         Left            =   1950
         TabIndex        =   12
         Top             =   1320
         Width           =   915
      End
   End
   Begin Frame fmePathAndFileOps
      Caption         =   "Manipulate a Filespec "
      Height          =   1845
      Left            =   4890
      TabIndex        =   2
      Top             =   90
      Width           =   2805
      Begin CommandButton cmdFilePath
         Caption         =   "File &Path..."
         Height          =   375
         Left            =   150
         TabIndex        =   5
         Top             =   360
         Width           =   1245
      End
      Begin CommandButton cmdFilename
         Caption         =   "File &Name..."
         Height          =   375
         Left            =   1470
         TabIndex        =   4
         Top             =   360
         Width           =   1245
      End
      Begin CommandButton cmdCollapsePath
         Caption         =   "&Collapse Path"
         Height          =   375
         Left            =   150
         TabIndex        =   3
         Top             =   1320
         Width           =   2565
      End
   End
   Begin CommonDialog cmdlgMain
      Left            =   0
      Top             =   0
   End
   Begin Menu mnuMain
      Caption         =   "&File"
      Index           =   0
      Begin Menu mnuFile
         Caption         =   "E&xit"
         Index           =   1
      End
   End
   Begin Menu mnuMain
      Caption         =   "&Help"
      Index           =   1
      Begin Menu mnuHelp
         Caption         =   "&About..."
         Index           =   0
      End
   End
End
Option Explicit
DefInt A-Z

Sub cmdBoth_Click ()
    Dim FileSpec$
    Dim Filename$
    Dim Path$
    Dim ParseRtn%

    FileSpec$ = FileOpenDialog()
    If Len(FileSpec$) Then
        ParseRtn% = fpParsePathAndFilename(FileSpec$, Path$, Filename$)
        Cls
        Print "FileSpec: " & FileSpec$
        Print "Path: " & Path$
        Print "Filename: " & Filename$
    End If

End Sub

Sub cmdClearList_Click ()

    lstItems.Clear

End Sub

Sub cmdCollapsePath_Click ()
'------------------------------------------------
'-- The Test Path names and lengths here were
'   taken from "The Windows Interface: An
'   Application Design Guide" pg. 143
'------------------------------------------------
    Dim CollapsedPath$
    Dim i%
    Dim MaxChars%
    ReDim TestPath$(2)

    TestPath$(0) = "C:\Alpha\Beta\GammaAndDelta"
    TestPath$(1) = "C:\Alpha\Beta\Gamma\Delta"
    TestPath$(2) = "C:\Alpha\Beta\Gamm\Delta"

    Cls
    For i% = 0 To UBound(TestPath$)
        Print TestPath$(i%)
        For MaxChars% = 16 To 19
            CollapsedPath$ = fpCollapsePath$(TestPath$(i%), MaxChars%)
            Print CollapsedPath$
        Next MaxChars%
        Print
    Next i%

End Sub

Sub cmdFilename_Click ()
    Dim FileSpec$
    Dim Filename$

    FileSpec$ = FileOpenDialog()
    If Len(FileSpec$) Then
        Filename$ = fpFileFromFileSpec(FileSpec$)
        Cls
        Print "Filespec = " & FileSpec$
        Print "File Name = " & Filename$
    End If

End Sub

Sub cmdFilepath_Click ()
    Dim FileSpec$
    Dim Path$

    FileSpec$ = FileOpenDialog()
    If Len(FileSpec$) Then
        Path$ = fpPathFromFileSpec(FileSpec$)
        Cls
        Print "Filespec = " & FileSpec$
        Print "Path = " & Path$
    End If

End Sub

Sub cmdLoadList_Click ()
    Dim TestString$
    Dim Delimiter$

    TestString$ = txtTestString.Text
    Delimiter$ = txtDelimiter.Text
    Call fpLoadListFromDlmStr(lstItems, TestString$, Delimiter$)

End Sub

Sub cmdParseString_Click ()
    Dim TestString$
    Dim Delimiter$
    Dim NumItemsParsed%
    Dim arrParsedItems$()
    Dim i%
    Dim ErrMsg$

    TestString$ = txtTestString.Text
    Delimiter$ = txtDelimiter.Text
    NumItemsParsed% = fpParseString(TestString$, Delimiter$, arrParsedItems$())
    '-- If NumItemsParsed% is >= 0 then no errors
    '   occurred and we can proceed, otherwise we
    '   need to examine the return value to see
    '   what the error was.
    If NumItemsParsed% >= 0 Then
        Cls
        Print TestString$
        Print NumItemsParsed% & " Items Parsed"
        For i% = 0 To UBound(arrParsedItems)
            Print "Array Element " & i% & " = " & arrParsedItems$(i%)
        Next i%
    Else
        Select Case NumItemsParsed%
            Case FPERR_NULL_STRING
                ErrMsg$ = "Error: The Test String Parameter was Null."
            Case FPERR_NULL_DELIMITER
                ErrMsg$ = "Error: The Delimiter Parameter was Null."
        End Select
        MsgBox ErrMsg$
    End If

End Sub

Sub cmdSplitString_Click ()
    Dim FileSpec$
    Dim TestString$
    Dim Delim$
    Dim NumDelims%
    Dim i%
    Dim SplitPos%
    Dim LeftHalf$, RightHalf$
    Dim ErrMsg$

    TestString$ = txtTestString.Text
    Delim$ = txtDelimiter.Text

    Cls
    Print "TestString = " & TestString$
    Print

    '-- Split at first delimiter
    SplitPos% = fpSplitString%(TestString$, Delim$, FP_DELIM_FIRST, LeftHalf$, RightHalf$)
    '-- Since this is the first time we're using
    '   the parameters we'll check our return code
    '   to see if they're invalid. Obviously it
    '   would be prefereable to check them before
    '   we do anything, but this way we can see if
    '   our return codes are accurate.<g>
    If SplitPos% < 0 Then
        Select Case SplitPos%
            Case FPERR_NULL_STRING
                ErrMsg$ = "Error: The Test String Parameter was Null."
            Case FPERR_NULL_DELIMITER
                ErrMsg$ = "Error: The Delimiter Parameter was Null."
        End Select
        MsgBox ErrMsg$
        '-- No need to go on
        Exit Sub
    End If
    Print "Split at First Delimiter"
    Print "Left Side = " & LeftHalf$
    Print "Right Side = " & RightHalf$
    Print

    '-- Split at last delim
    SplitPos% = fpSplitString%(TestString$, Delim$, FP_DELIM_LAST, LeftHalf$, RightHalf$)
    Print "Split at Last Delimiter"
    Print "Left Side = " & LeftHalf$
    Print "Right Side = " & RightHalf$
    Print

    '-- Split at each delim in string
    NumDelims% = DS_CountDlms(TestString$, Delim$)
    For i% = 1 To NumDelims%
        SplitPos% = fpSplitString%(TestString$, Delim$, i%, LeftHalf$, RightHalf$)
        Print "Split at Delimiter " & i%
        Print "Left Side = " & LeftHalf$
        Print "Right Side = " & RightHalf$
        Print
    Next i%


End Sub

Sub cmdWordCount_Click ()
    Dim TestString$
    Dim Count$
    Dim Msg$
    Dim ErrMsg$
    Dim NumWords&

    TestString$ = txtTestString.Text
    NumWords& = fpWordCount(TestString$)
    If NumWords& <> FPERR_NULL_STRING Then
        Count$ = " contains " & Format$(NumWords&, "#,##0") & " Words"

        Msg$ = "The test string" & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)

        Msg$ = Msg$ & Chr$(34) & TestString$ & Chr$(34) & Chr$(13) & Chr$(10)
        Msg$ = Msg$ & Chr$(13) & Chr$(10)
        Msg$ = Msg$ & Count$
        MsgBox Msg$, 0, "Word Count Test"
    Else
        ErrMsg$ = "Error: The Test String Parameter was Null."
        MsgBox ErrMsg$
    End If

End Sub

Sub Form_Load ()
    Dim fpRtn%

    fpRtn% = FP_Password("Sorry, you'll have to register to get a proper password.")

End Sub

Sub mnuFile_Click (Index As Integer)

    If Index = 1 Then Unload Me

End Sub

Sub mnuHelp_Click (Index As Integer)

    frmAbout.Show MODAL

End Sub