Programming Tool Box/SIMS_2.iso/vb_code2/string/form1.frm

Text File | 1994-07-15 | 15KB | 488 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Sample Application To Demonstrate STRING.DLL"
   ClientHeight    =   7035
   ClientLeft      =   1245
   ClientTop       =   1710
   ClientWidth     =   8160
   Height          =   7725
   Left            =   1185
   LinkTopic       =   "Form1"
   ScaleHeight     =   7035
   ScaleWidth      =   8160
   Top             =   1080
   Width           =   8280
   Begin SSFrame Frame3D1
      Caption         =   "LexSortStr Demo"
      Font3D          =   3  'Inset w/light shading
      Height          =   3405
      Left            =   120
      TabIndex        =   10
      Top             =   3015
      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             =   6570
      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
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
Else
  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
Else
  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
  Do
    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
Next

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
Else
  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 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

label2.Caption = "length:" + Str$(Len(text1.Text)) + " characters"

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