Random Text Generator

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, qFreq, qStart, qStop As Quad
 
Enum Equates Singular
   IDC_CreateChars  = 500
   IDC_CreateDataWords
   IDC_CreateFileWords
   IDC_Sort
   IDC_Results
End Enum
 
 
Function PBMain() As Long
   Local style&
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop _
   Or %WS_VScroll Or %ES_AutoHScroll Or %WS_HScroll Or %ES_AutoVScroll
   Randomize Timer
   Dialog New Pixels, 0, "Random Text Generator",300,300,400,600, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_CreateChars,"Chars", 10,10,70,20
   Control Add Button, hDlg, %IDC_CreateFileWords,"File Words", 90,10,70,20
   Control Add Button, hDlg, %IDC_CreateDataWords,"Data Words", 170,10,70,20
   Control Add Button, hDlg, %IDC_Sort,"Sort", 250,10,50,20
   Control Add TextBox, hDlg, %IDC_Results,"",10,35,180,160, style&, %WS_Ex_ClientEdge
   QueryPerformanceFrequency qFreq
   Dialog Show Modal hDlg Call DlgProc
End Function
 
 
CallBack Function DlgProc() As Long
   Local w,h As Long, temp$
   Static Words() As String
   Select Case Cb.Msg
      Case %WM_Size
         Dialog Get Client hDlg To w,h
         Control Set Size hDlg, %IDC_Results, w-20,h-40
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_CreateDataWords
               QueryPerformanceCounter   qStart
               temp$ = "$#%-.:_0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
               RandomTextGenerator 1, "", temp$, Words(), 1, 5, 25, 10000   'Dupes-MinW-MaxW-MaxLines
               Control Set Text hDlg, %IDC_Results, Join$(Words(),$CrLf)
               QueryPerformanceCounter   qStop
               ? Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
            Case %IDC_CreateFileWords
               QueryPerformanceCounter   qStart
               temp$ = "$#%-.:_0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
               RandomTextGenerator 2, "wordlist.txt", temp$, Words(), 1, 5, 25, 10000   'Dupes-MinW-MaxW-MaxLines
               Control Set Text hDlg, %IDC_Results, Join$(Words(),$CrLf)
               QueryPerformanceCounter   qStop
               ? Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
            Case %IDC_CreateChars
               QueryPerformanceCounter   qStart
               temp$ = "$#%-.:_0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
               RandomTextGenerator 3, "", temp$, Words(), 1, 5, 25, 10000   'Dupes-MinW-MaxW-MaxLines
               Control Set Text hDlg, %IDC_Results, Join$(Words(),$CrLf)
               QueryPerformanceCounter   qStop
               ? Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
            Case %IDC_Sort
               Array Sort Words()
               Control Set Text hDlg, %IDC_Results, Join$(Words(),$CrLf)
         End Select
   End Select
End Function
 
Sub RandomTextGenerator(sType As Long, FileName As String, OkChars As String, Lines() As String,_
                        Dupes As Long, MinWidth As Long, MaxWidth As Long, MaxLines As Long)
   Local i,j,Chars,CharPos,WordPos,PosA,PosB As Long
 
   'create DataWordList()
   If sType = 1 Then
      "boy","girl","sister","brother","mom","dad","aunt","uncle"
      "the","a","an","the","or","then","of","for"
      "time","past","future","order","alternate","possible"
      Dim DataWordList(DataCount) As String
      For i = 0 To DataCount-1
         DataWordList(i) = Read$(i)
      Next i
   End If
 
   'create FileWordList()
   If sType = 2 Then
      Open FileName For Input As #1
      FileScan #1, Records To i             'get count of lines of text in the file
      Dim FileWordList(i-1) As String       'Dim 0 to count-1
      Line Input #1, FileWordList() To i    'Get entire array in one gulp, count& gives # lines read
      Close #1
   End If
 
   'create random lines from specified source Data statements, File, or random characters
   ReDim Lines(MaxLines)
   For i = 0 To UBound(Lines$)
      Chars = Rnd(MinWidth, MaxWidth)
      For j = 1 To Chars
         Select Case sType
            Case 1
               WordPos = Rnd(1, UBound(DataWordList))
               Lines(i) = Lines(i) + DataWordList(WordPos) + $Spc 'words
            Case 2
               WordPos = Rnd(1, UBound(FileWordList))
               Lines(i) = Lines(i) + FileWordList(WordPos) + $Spc 'words
            Case 3
               CharPos = Rnd(1, Len(OkChars))
               Lines(i) = Lines(i) + Mid$(OkChars,CharPos,1) 'characters
         End Select
      Next i
   Next i
 
   'create some randomly placed duplicates
   If Dupes Then
      For i = 0 To UBound(Lines)/5       'approximate 1/5 = 20% duplicates
         PosA = Rnd(1,UBound(Lines))
         PosB = Rnd(1,UBound(Lines))
         Lines(PosA) = Lines(PosB)
      Next i
   End If
End Sub
   
'gbs_01364
'Date: 05-11-2013

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