Equate Check II

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As DWord, WordList() As String
 
Function PBMain() As Long
   Local style&
   ReDim WordList(1000) As String
   style& = %WS_TabStop Or %WS_Border Or  %ES_Left Or %ES_AutoHScroll _
      Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn
   Dialog New Pixels, 0, "Test Code",300,300,250,350, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 10,10,100,20
   Control Add TextBox, hDlg, 200, AddText, 10,30,230,300, Style&
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 Then
      Local temp$, unique$, i, iWordCount As Long
      Control Get Text hDlg, 200 To temp$
      iWordCount = GetWords(temp$)
      For i = 0 To UBound(WordList)
         If Tally(temp$, WordList(i)) < 2 Then unique$ = unique$ + " " + WordList(i)
      Next i
      ? unique$
   End If
End Function
 
Function GetWords(ByVal txt As String) As Long
   Local ci, wCount, iPos, wordFlag As Long, Letter As Byte Ptr, sWord As String
   Letter = StrPTR(txt)                 'set byte pointer to beginning of string
   For ci = 1 To Len(txt)               'loop through whole string
      Select Case @Letter               'first consider approved letters, apostrophs and digits
         Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, 37, 39, 95, 96, 180, 146, 48 To 57
            '           If wordFlag = 0 And @Letter <> 39 Then  'word should not start with '
            If wordFlag = 0 AND @Letter = 37 Then  'word should not start with '
               wordFlag = 1 : iPos = ci  'set a flag and store position
            End If
         Case Else                      'we hit something else, like space, dot, etc..
            If wordFlag = 1 Then        'if flag was set, a word is ready
               Incr wCount              'increase counter
               wordFlag = 0             'reset flag
               iPos = ci - iPos         'calculate word's length
               sWord = Peek$(Letter - iPos, iPos)  'extract word - do what you like with it
               WordList(wCount) = sWord
            End If
      End Select
      Incr Letter
   Next
   If wordFlag = 1 Then  'in case a word goes all the way to the end..
      Incr wCount        'increase counter
      iPos = ci - iPos     'calculate word's length
      sWord = Peek$(Letter - iPos, iPos)  'extract word - do what you like with it
   End If
   Function = wCount       'return wordcount
End Function
 
Function AddText() As String
   Local temp$
   temp$ = "#Compile EXE"
   temp$ = temp$ + $CrLf + "#Dim All"
   temp$ = temp$ + $CrLf + "%ID_Flag = 500"
   temp$ = temp$ + $CrLf + "%ID_Marker = 600"
   temp$ = temp$ + $CrLf + "%ID_Btn = 700"
   temp$ = temp$ + $CrLf + "Function PBMain() As Long"
   temp$ = temp$ + $CrLf + "   Local i,j As Long
   temp$ = temp$ + $CrLf + "   i = %ID_Flag
   temp$ = temp$ + $CrLf + "   j = %ID_Marker
   temp$ = temp$ + $CrLf + "End Function"
   Function = temp$
End Function
 
'gbs_00537
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm