Programming Tool Box/SIMS_2.iso/code/various/strngd/form1.frm

Visual Basic Form | 1994-07-29 | 19.1 KB | 525 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Sample Application To Demonstrate STRING.DLL Version 1.2b"
   ClientHeight    =   7035
   ClientLeft      =   1245
   ClientTop       =   1710
   ClientWidth     =   8160
   Height          =   7725
   Left            =   1185
   LinkTopic       =   "Form1"
   ScaleHeight     =   7035
   ScaleWidth      =   8160
   Top             =   1080
   Width           =   8280
   Begin CommandButton Command8
      Caption         =   "CountWords"
      Height          =   480
      Left            =   1980
      TabIndex        =   19
      Top             =   3240
      Width           =   1755
   End
   Begin CommandButton Command7
      Caption         =   "FindFOS"
      Height          =   480
      Left            =   120
      TabIndex        =   18
      Top             =   3240
      Width           =   1755
   End
   Begin CommandButton Command6
      Caption         =   "FindNOO"
      Height          =   480
      Left            =   120
      TabIndex        =   17
      Top             =   2655
      Width           =   1755
   End
   Begin SSFrame Frame3D1
      Caption         =   "LexSortStr Demo"
      Font3D          =   3  'Inset w/light shading
      Height          =   2835
      Left            =   105
      TabIndex        =   10
      Top             =   3870
      Width           =   7920
      Begin TextBox textnum
         Height          =   300
         Left            =   2655
         TabIndex        =   15
         Text            =   "10"
         Top             =   1965
         Width           =   405
      End
      Begin SSCheck casesens
         Caption         =   "Case sensitive"
         Font3D          =   0  'None
         Height          =   285
         Left            =   2640
         TabIndex        =   14
         Top             =   1560
         Width           =   1935
      End
      Begin CommandButton Command3
         BackColor       =   &H00000000&
         Caption         =   "Sort the lefthand list into right"
         Height          =   510
         Left            =   2595
         TabIndex        =   13
         Top             =   900
         Width           =   2745
      End
      Begin ListBox List2
         Height          =   2370
         Left            =   5400
         TabIndex        =   12
         Top             =   315
         Width           =   2445
      End
      Begin ListBox List1
         Height          =   2370
         Left            =   75
         TabIndex        =   11
         Top             =   315
         Width           =   2445
      End
      Begin Label Label4
         BackStyle       =   0  'Transparent
         Caption         =   "# of characters to sort by"
         Height          =   240
         Left            =   3105
         TabIndex        =   16
         Top             =   2025
         Width           =   2205
      End
   End
   Begin CommandButton Command5
      Caption         =   "LexSortStr"
      Height          =   480
      Left            =   120
      TabIndex        =   8
      Top             =   2070
      Width           =   1755
   End
   Begin CommandButton Command4
      Caption         =   "FindFirstNIS"
      Height          =   480
      Left            =   120
      TabIndex        =   7
      Top             =   1515
      Width           =   1755
   End
   Begin CommandButton Command2
      Caption         =   "FindRightChar"
      Height          =   480
      Left            =   120
      TabIndex        =   3
      Top             =   960
      Width           =   1755
   End
   Begin TextBox Text2
      Height          =   975
      Left            =   1965
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   1815
      Width           =   6090
   End
   Begin TextBox Text1
      Height          =   1125
      Left            =   1965
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   "This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; This is a test string; Th"
      Top             =   390
      Width           =   6090
   End
   Begin CommandButton Command1
      Caption         =   "ReverseStr"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   405
      Width           =   1755
   End
   Begin Label Label3
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "
1994 by INside; P.O. Box 965; 3000 Bern 9; Switzerland"
      Height          =   195
      Left            =   1920
      TabIndex        =   9
      Top             =   6780
      Width           =   4935
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Left            =   4140
      TabIndex        =   6
      Top             =   90
      Width           =   720
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Output text window:"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Index           =   1
      Left            =   1950
      TabIndex        =   5
      Top             =   1575
      Width           =   1965
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Source text window:"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Index           =   0
      Left            =   1965
      TabIndex        =   4
      Top             =   90
      Width           =   2040
   End
   Begin Menu dat
      Caption         =   "&File"
      Begin Menu datei
         Caption         =   "&Exit"
         Index           =   0
      End
   End
   Begin Menu in
      Caption         =   "&?"
      Begin Menu info
         Caption         =   "&Info"
         Index           =   0
      End
   End
Option Explicit
Sub Command1_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE ReverseStr FUNCTION       **
'***********************************************************
'*   Reverses the indicated string                         *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
'variables used to time the function call:
Dim tstart As Long
Dim atRev As Long
'initialize the variables
lpstrDATA = Space$(65000)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
'assign the string to be reversed to the variable:
lpstrDATA = text1.Text
'get the system tick count as a timer mark:
tstart = GetTickCount()
'execute the dll function:
ret = ReverseStr(lpstrDATA)
'get the system tick count as a timer mark:
atRev = GetTickCount()
'assign the resulting string now stored in lpstrDATA to the
'textfield:
text2.Text = Trim$(lpstrDATA)
'please note: all the empty space in a string can easily be eliminated
'by "trimming" the string variable!
MsgBox "It took me " + Trim$(Str$(atRev - tstart)) + " milliseconds to reverse a string 65000 chars length", 64, DLG_CAPTION
If atRev - tstart > 200 Then MsgBox "You must have been reading the about dialog; it normally doesn't take that long! <g> Try it again and it will be *A LOT* faster...", 64, DLG_CAPTION
End Sub
Sub Command2_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE FindRightChar FUNCTION       **
'***********************************************************
'*   Searches the last occurence of iChar within lpstrDATA *
'*   and highlights the character in the text1 textbox     *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
Dim char As String
char = InputBox("Enter character to be found:")
'only one character by be searched!
If Len(char) > 1 Then
  MsgBox "only one character by be searched!", 48, DLG_CAPTION
  Exit Sub
End If
iChar = Asc(char)
'initialize the variables
lpstrDATA = Space$(65000)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
'assign the string being searched to the variable:
lpstrDATA = text1.Text
'execute the dll function:
ret = FindRightChar(lpstrDATA, iChar)
'the return value stores the position of the last occurence
'of iChar within lpstrDATA
'if the return value <= 0 then no occurence
If ret <= 0 Then
  MsgBox "Character not found!", 48, DLG_CAPTION
  text1.SelStart = CLng(ret - 1)
  text1.SelLength = CLng(1)
  text1.SetFocus
End If
End Sub
Sub Command3_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE LexSortStr FUNCTION       **
'***********************************************************
'* sorts a list containing a bunch of strings *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret, a, b, position, exited As Integer
Dim iCase As Integer 'Case sensitivity
Dim iNofC As Integer 'Number of Characters to check
Dim lpstrSTRING1 As String * 1024
Dim lpstrSTRING2 As String * 1024
'initialize the variables
'allocate memory:
lpstrSTRING1 = Space$(1024)
lpstrSTRING1 = Space$(1024)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
'clear the destination listbox:
list2.Clear
'1=case sensitive comparison, 0=non case sensitive
If casesens.Value Then
  iCase = 1
  iCase = 0
End If
'the number of characters to sort by
iNofC = Val(textnum.Text)
'add the first entry so we have something to compare with the first string
' list2.AddItem list1.List(0)
For a = 0 To list1.ListCount - 1
  lpstrSTRING1 = list1.List(a)
  b = -1
    b = b + 1
    lpstrSTRING2 = list2.List(b)
    'execute the dll function:
    ret = LexSortStr(lpstrSTRING1, lpstrSTRING2, iNofC, iCase)
    'the return value shows to following:
    'if ret < 0 : string1 is before string2
    'if ret = 0 : string1 is the same as string2
    'if ret > 0 : string1 is after string2
    If b >= list2.ListCount Then
      list2.AddItem list1.List(a), b
      exited = True
      Exit Do
    End If
  Loop Until ret <= 0
  If exited = False Then
    list2.AddItem list1.List(a), b
  Else
    exited = False
  End If
End Sub
Sub Command4_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE FindFirstNIS FUNCTION       **
'**      FindFirstNIS = FindFirst[N]ot[I]n[S]ubstring
'***********************************************************
'*   Searches the first occurence of a character in lpstrDATA *
'*   not contained in the subset string lpstrMAP           *
'*   and highlights the character in the text1 textbox     *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
Dim subset As String
Dim lpstrSUBSET As String * 256
'initialize the variables
'allocate memory:
lpstrSUBSET = Space$(256)
lpstrDATA = Space$(65000)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
subset = InputBox("Enter character subset:")
lpstrSUBSET = subset
'assign the string being searched to the variable:
lpstrDATA = text1.Text
'execute the dll function:
ret = FindFirstNIS(lpstrDATA, lpstrSUBSET)
'the return value stores the position of the last occurence
'of iChar within lpstrDATA
'if the return value <= 0 then no occurence
If ret <= 0 Then
  MsgBox "Subset not contained within searched DATA!", 48, DLG_CAPTION
  text1.SelStart = CLng(ret)
  text1.SelLength = CLng(1)
  text1.SetFocus
End If
End Sub
Sub Command5_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE LexSortStr FUNCTION       **
'***********************************************************
'* indicates the lexical order of two strings *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
Dim iCase As Integer 'Case sensitivity
Dim iNofC As Integer 'Number of Characters to check
Dim lpstrSTRING1 As String * 1024
Dim lpstrSTRING2 As String * 1024
'initialize the variables
'allocate memory:
lpstrSTRING1 = Space$(1024)
lpstrSTRING1 = Space$(1024)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
lpstrSTRING1 = InputBox("Enter the first string to compare:")
lpstrSTRING2 = InputBox("Enter the second string to compare:")
iCase = 1 '1=case sensitive comparison, 0=non case sensitive
iNofC = 10 'compare the first 10 characters of the string
'execute the dll function:
ret = LexSortStr(lpstrSTRING1, lpstrSTRING2, iNofC, iCase)
'the return value shows to following:
'if ret < 0 : string1 is before string2
'if ret = 0 : string1 is the same as string2
'if ret > 0 : string1 is after string2
Select Case ret
Case Is < 0
  MsgBox "'" + Trim$(lpstrSTRING1) + "' BEFORE '" + Trim$(lpstrSTRING2) + "'", 64, DLG_CAPTION
Case 0
  MsgBox "'" + Trim$(lpstrSTRING1) + "' THE SAME as '" + Trim$(lpstrSTRING2) + "'", 64, DLG_CAPTION
Case Is > 0
  MsgBox "'" + Trim$(lpstrSTRING1) + "' AFTER '" + Trim$(lpstrSTRING2) + "'", 64, DLG_CAPTION
End Select
End Sub
Sub Command6_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE FindNOO FUNCTION       **
'**      FindNOO = Find[N]umber[O]f[O]ccurences
'***********************************************************
'*   Searches the for the number of occurences of a        *
'*   character in lpstrDATA                                *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
Dim cCHARA As String * 1
'initialize the variables
'allocate memory:
lpstrDATA = Space$(65000)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
cCHARA = InputBox("Enter character to count:")
'assign the string being searched to the variable:
lpstrDATA = text1.Text
'execute the dll function:
ret = FindNOO(lpstrDATA, cCHARA)
'the return value stores the number of occurences
'if the return value <= 0 then no occurence
MsgBox cCHARA + " was found " + Str$(ret) + " times", 64, DLG_CAPTION
End Sub
Sub Command7_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE FindFOS FUNCTION       **
'**      FindFOS = Find[F]irst[O]f[S]ubset
'***********************************************************
'*   Searches for the first occurence of any character     *
'*   from lpstrSUBSET in lpstrDATA                         *
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Integer
Dim lpstrSUBSET As String * 256
'because of VB Memory limitations, the subset may
'only be 256 bytes of size
'initialize the variables
'allocate memory:
lpstrDATA = Space$(65000)
lpstrSUBSET = Space$(256)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
lpstrSUBSET = InputBox("Enter subset to search for:")
'assign the string being searched to the variable:
lpstrDATA = text1.Text
'execute the dll function:
ret = FindFOS(lpstrDATA, lpstrSUBSET)
'the return value stores the position of the first occurence
MsgBox "The first character from '" + Trim$(lpstrSUBSET) + "' was found at position " + Str$(ret), 64, DLG_CAPTION
text1.SelStart = CLng(ret - 1)
text1.SelLength = CLng(1)
text1.SetFocus
End Sub
Sub Command8_Click ()
'***********************************************************
'**      SAMPLE CODE FOR THE CountWords FUNCTION       **
'***********************************************************
'***********************************************************
'variable used to store the return value of the function call:
Dim ret As Long
'initialize the variables
'allocate memory:
lpstrDATA = Space$(65000)
'when calling dll's, the memory for strings being passed
'back and forth must be allocated by Visual Basic.
'this is done simply by filling up the variable with blanks!
'assign the string being searched to the variable:
lpstrDATA = text1.Text
'execute the dll function:
ret = CountWords(lpstrDATA)
'the return value stores the position of the first occurence
MsgBox "The number of words counted is:" + Trim$(Str$(ret)), 64, DLG_CAPTION
End Sub
Sub datei_Click (Index As Integer)
Unload form1
End Sub
Sub Form_Load ()
Dim fhnd As Integer
Dim dummy As String
form1.Left = screen.Width / 2 - form1.Width / 2
form1.Top = screen.Height / 2 - form1.Height / 2
list1.AddItem "this demonstrates"
list1.AddItem "thiS demonstrates"
list1.AddItem "the usE of lexical order"
list1.AddItem "the use of lexical order"
list1.AddItem "string sorting with"
list1.AddItem "string Sorting with"
list1.AddItem "the almighty STRING.DLL"
list1.AddItem "case sensitive"
list1.AddItem "or not; your choice!"
End Sub
Sub info_Click (Index As Integer)
Dim res As Integer
Select Case Index
Case 0
  res = STRINGVer(form1.hWnd)
End Select
End Sub
Sub Text1_Change ()
label2.Caption = "length:" + Str$(Len(text1.Text)) + " characters"
End Sub