Word List

Category: Utilities

Date: 03-28-2012

Return to Index


 
'Primary Code:
'This code simply parses a test string from a lists of delimiters.
'The extracted words are put in an array, sorted, and duplications
'removed.
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg, hBox1, hBox2 As DWord
Global Words() As String
 
Function PBMain() As Long
   Local style&
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop Or %WS_Border
 
   Dialog New Pixels, 0, "Word List",300,300,500,600, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   Control Add TextBox, hDlg, 200,"a b c d c b a ", 50,50,200,500, Style&
   Control Handle hDlg, 200 To hBox1
   SendMessage hBox1, %EM_SETLIMITTEXT, 1000000, 0     '1M
 
   Control Add TextBox, hDlg, 300,"",                270,50,200,500, Style&
   Control Handle hDlg, 300 To hBox2
   SendMessage hBox2, %EM_SETLIMITTEXT, 1000000, 0     '1M
 
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local delimiter, temp As String, i,j,iMax As Long
   Select Case CB.Msg
      Case %WM_Command
         Select Case CB.Ctl
            Case 100
               MousePTR 11
               delimiter = Chr$(0 To 64, 91 To 96, 123 To 127)
               Control Get Text hDlg, 200 To temp
               temp = LCase$(Trim$(temp, Any delimiter))
               ReDim Words(ParseCount(temp, Any delimiter)-1) As String
               Parse temp, Words(), Any delimiter
               Array Sort Words()
               RemoveDupes
               Control Set Text hDlg, 300, Join$(Words(),$CrLf)
               MousePTR 0
         End Select
   End Select
End Function
 
Sub RemoveDupes          '1 array sorted
   Local i, iPos As Long
   For i = UBound(Words) To LBound(Words)+1 Step -1   'zero based array
      If Words(i) = Words(i-1) Then Array Delete Words(i) : Incr iPos
   Next i
   If Words(0)="Then Array Delete Words(0) : ReDim Preserve Words(UBound(Words)-1)
   ReDim Preserve Words(UBound(Words)-iPos)
End Sub
 
'gbs_00575
'Date: 03-10-2012


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