Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm