Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

gbWordWrap

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • gbWordWrap


    Here's my latest app, gbWordWrap.

    Download the source code, EXE and images here.
    Discussion is here.
    There's no online Help for this one - should be self-explanatory.


    This is more of a test bed for trying out code related to word wrapping than it is an app you'll use over and over again.

    There are 3 main features the code supports:
    1. Prepare text for paragraph wrapping (pointer approach to editing the number of $CRLF delimiters)
    2. WordWrap (that Pierre and I worked on – takes a string with $CRLF and returns a string with only $CR)
    3. Locate delimiter positions for quickly locating text of lines (something based on recent comments by Eros)
    The speed of those 3, acting on a 10MB text file is about 0.3s. I'll be working to reach a goal of 0.15s.

    The code has these features to help with testing …
    • Use +/- to change font size
    • Dropdown combobox to select font
    • Toggle bold
    • Toggle between line and paragraph wrapping
    • Select a text file whose content will be displayed in the ListView
    • Toggle between 10MB of test data or the user-selected file
    • Timing for each of the 1-2-3 items above, plus total time, plus line count of the wrapped text (statusbar)
    • Restore text to the top line from the last session
    • Re-wrap after resizing the dialog (not during a resize)
    • Save settings between sessions, including dialog size/location

    What it DOES NOT have yet is a good way to keep the correct text at the top of the ListView when font properties, or Listview size, is changed. But it should be a good test bed for me to try out an approach or two that I have in mind for that.

    Source Code (uses Jose's includes):

    Code:
    #Compile Exe "gbwordwrap.exe"
    #Dim All
    
    #Debug Error On
    #Debug Display On
    
    %Unicode=1
    $Ver = "1.1"
    #Include "Win32Api.inc"
    
    #Resource Icon, logo, "wrap.ico"
    #Resource Icon, xFontPlus, "plus.ico"
    #Resource Icon, xFontMinus, "minus.ico"
    
    
    Global hDlg,hFont,ghHook,hListView As Dword, BookText As String, CRArray() As Long
    Global FontName, CurrentFileName As WStringZ * %Max_Path
    Global LineCount, ParagraphWrap, UseTextFile, TopLine, LimitBlankLines As Long
    Global FontSize, FontBold, BuildArray, TopChar, FontDelta As Long
    Global qFreq, qStart, qStop As Quad
    
    Enum Equates Singular
       IDC_Graphic = 500
       IDC_ListView
       IDC_ComboBox
       IDC_StatusBar
       IDC_File
       IDC_ParagraphWrap
       IDC_UseTextFile
       IDC_FontPlus
       IDC_FontMinus
       IDC_FontBold
       IDC_Label
       IDC_LimitBlankLines
    End Enum
    
    Function PBMain() As Long
       Dialog Default Font "Tahoma", 12
       Dialog New Pixels, %HWND_Desktop, "gbWordWrap_ListView   v" + $ver, 400, 600, 350,400, %WS_OverlappedWindow To hDlg
       Dialog Set Icon hDlg, "logo"
    
       Control Add Graphic, hDlg, %IDC_Graphic, "", 10, 10, 100,100
       Control Show State hDlg, %IDC_Graphic, %SW_Hide
    
       Control Add Button, hDlg, %IDC_File, "File", 10, 10, 50, 25
       Control Add CheckBox, hDlg, %IDC_UseTextFile, "Use Text File",  10, 45, 150,25
       Control Add CheckBox, hDlg, %IDC_ParagraphWrap, "Paragraph Wrap", 10, 65, 150,25
    
       Control Add Statusbar, hDlg, %IDC_StatusBar, "gbWordWrap", 0, 0, 0, 0
       Statusbar Set Parts hDlg, %IDC_StatusBar, 75,75,75,75,100,75,2500
    
       Control Add ComboBox, hDlg, %IDC_ComboBox, , 180, 10, 150,200, %WS_Border Or %CBS_DropDownList Or %WS_TabStop Or %WS_VScroll, %WS_Ex_ClientEdge
       Control Add CheckBox, hDlg, %IDC_FontBold, "Font Bold",  180, 45, 150,25
       Control Add Label, hDlg, %IDC_Label, "", 300,45,30,25, %WS_Border
       Control Add CheckBox, hDlg, %IDC_LimitBlankLines, "Limit Blanks",  180, 65, 150,25
    
       Control Add ImgButtonX, hDlg, %IDC_FontPlus, "xFontPlus", 350,10,35,35
       Control Add ImgButtonX, hDlg, %IDC_FontMinus, "xFontMinus", 350,50,35,35
    
    '   Control Add ListView, hDlg, %IDC_ListView, "", 0,100,35,35, %LVS_NoColumnHeader Or %WS_Child Or %WS_TabStop Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData Or %LVS_SingleSel Or %WS_Visible, %WS_Ex_ClientEdge
       Control Add ListView, hDlg, %IDC_ListView, "", 0,100,35,35, %WS_Child Or %WS_TabStop Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData Or %LVS_SingleSel Or %WS_Visible, %WS_Ex_ClientEdge
       ListView Insert Column hDlg, %IDC_ListView, 1, "", 3000,0
       Control Handle hDlg, %IDC_ListView To hListView
       SendMessage (hListView, %WM_NOTIFYFORMAT, hDlg, %NF_REQUERY)
    
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    CallBack Function DlgProc() As Long
       Local w,h,iRow As Long, pLVDI As LV_DispInfoW Ptr, temp$$
       Select Case CbMsg
          Case %WM_Help : SaveBookText
    
          Case %WM_InitDialog
             settings_ini "get"
             Control Set Check hDlg, %IDC_UseTextFile, UseTextFile
             Control Set Check hDlg, %IDC_ParagraphWrap, ParagraphWrap
             Control Set Check hDlg, %IDC_FontBold, FontBold
             Control Set Check hDlg, %IDC_LimitBlankLines, LimitBlankLines
             Control Set Text hDlg, %IDC_Label, Str$(FontSize)
             Statusbar Set Text hDlg, %IDC_StatusBar, 7, 0, IIf$(UseTextFile,PathName$(Namex,CurrentFileName),"<Sample Text>")
             EnumerateFonts
             ComboBox Select hDlg, %IDC_ComboBox, 1
             QueryPerformanceFrequency qFreq
             ResizeWindow
             RunTest
             SetTopItem hListView, TopLine
    
          Case %WM_Destroy
             TopLine = ListView_GetTopIndex(hListView)
             settings_ini "save"
    
          Case %WM_Size : ResizeWindow
    
          Case %WM_ExitSizeMove : RunTest   'don't RunTest until user lifts the mouse
    
          Case %WM_Command
             Select Case CbCtl
                Case %IDC_File            : SelectFileToOpen : RunTest
                Case %IDC_ParagraphWrap   : RunTest
                Case %IDC_LimitBlankLines : RunTest
                Case %IDC_UseTextFile     : TopLine = 1 : RunTest   'start at top whenver new text source is selected
                Case %IDC_FontBold        : RunTest
                Case %IDC_FontPlus        : FontSize = FontSize + FontDelta : RunTest
                   Control Set Text hDlg, %IDC_Label, Str$(FontSize)
                Case %IDC_FontMinus       : FontSize = FontSize - FontDelta : FontSize = Max(6,FontSize) : RunTest
                   Control Set Text hDlg, %IDC_Label, Str$(FontSize)
                Case %IDC_ComboBox        : RunTest
             End Select
          Case %WM_Notify
             Select Case Cb.NmId
                Case %IDC_ListView
                   Select Case Cb.NmCode
                      Case %LVN_GetDispInfo                                             'notification to ask for data
                            pLVDI = Cb.LParam                                           'pointer to LVDISPINFO structure for requested subitem
                            iRow = @pLVDI.item.iItem                                    'row being asked for
                            temp$$ = Trim$(Mid$(BookText, CRArray(iRow) To CRArray(iRow+1)), Any $Spc + $CrLf)
                            @pLVDI.item.pszText = StrPtr(temp$$)                        'text sent to ListView
                   End Select
             End Select
       End Select
    End Function
    
    Sub ResizeWindow
       Local w,h As Long
       Dialog Get Client hDlg To w,h
       Control Set Size hDlg, %IDC_ListView, w,h-125
    '   ListView Set Column hDlg, %IDC_ListView, 1, w   'arbitrarily wider than control to avoid the "..." at end of lines
    End Sub
    
    Sub RunTest
       Control Get Check hDlg, %IDC_ParagraphWrap To ParagraphWrap
       Control Get Check hDlg, %IDC_LimitBlankLines To LimitBlankLines
       Control Get Check hDlg, %IDC_UseTextFile To UseTextFile
       Control Get Check hDlg, %IDC_FontBold To FontBold
       Control Get Text hDlg, %IDC_ComboBox To FontName
       Font New FontName, FontSize, FontBold To hFont
       Graphic Set Font hFont
       Control Set Font hDlg, %IDC_ListView, hFont
       BuildBookText    'create sample text or read from file
       PierreWrap
       If LineCount Then ListView_SetItemCountEx(hListView, LineCount, %LVSICF_noInvalidateAll) 'max rows
    End Sub
    
    Function SetTopItem(hLV As Dword, index As Long) As Long
       Local rc As RECT
       SendMessage(hLV, %LVM_GetItemRect, 0, VarPtr(rc))
       SendMessage(hLV, %LVM_Scroll, 0, (index - GetScrollPos(hLV, %SB_Vert)) * (rc.nBottom - rc.nTop))
    End Function
    
    Sub BuildBookText
       If IsFile(CurrentFileName) And UseTextFile Then
          Open CurrentFileName For Binary As #1
          Get$ #1, Lof(1), BookText
          Close #1
       Else
          'build a 5MB string
          BookText    = "Now is the time for Pierre to establish a new kingdom and establish world peace!"
          BookText    = BookText + $CrLf + BookText + $CrLf + $CrLf + $CrLf + $CrLf + $CrLf + BookText + $CrLf + BookText
          BookText    = Repeat$(16000,BookText + $CrLf + $CrLf)
    '      BookText   = "aaa" + $CrLf + "bbb" + $CrLf + $CrLf + $CrLf + "ccc" + $CrLf + "ddd"
    '      BookText   = "aaa" + $CrLf + "bbb" + $CrLf + $CrLf + "ccc" + $CrLf + "ddd"
       End If
    End Sub
    
    Function PierreWrap() As Long
        Local pBook As Byte Pointer, index, w,h, SpaceIndex, LineWidthPixels, TotalTime As Long, pLetterWidth As Long Pointer
       'this function assumes that input lines use $CRLF as delimiters. Every $CR must be followed by a $LF
       'output of the function contains only $CR. It does not contain $CRLF.
    
       'modify booktext in 2 ways. eliminate extra blank lines and replace any $CRLF pairs with a single $CRLF paragraph wrapping
       QueryPerformanceCounter(qStart)
       If LimitBlankLines Then
          'allow no more than 2 $CRLF in a sequence (no more than 1 blank line in a row)
          While InStr(BookText,$CrLf + $CrLf + $CrLf)
             Replace $CrLf + $CrLf + $CrLf With $CrLf + $CrLf In BookText
          Wend
       End If
    
       If ParagraphWrap Then
          'hide $crlf+$crlf, replace all single $CRLF with $SPC, then restore $CRLF+$CRLF
          If 0 Then
             Replace $CrLf + $CrLf With "::;;" In BookText     ' ::;; is an arbitrary string that won't occur naturally in text
             Replace $CrLf With $Spc In BookText
             Replace "::;;" With $CrLf + $CrLf In BookText
    
          Else
             PrepareBookTextForParagraphWrapping     'faster, but fails when there are more than 2 $CRLF in a sequence
          End If
       End If
    
       QueryPerformanceCounter(qStop)
       TotalTime += (qStop-qStart)
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, $Spc + Format$((qStop - qStart) / qFreq,"###.000") & "s"
    
       'set the maximum width, taking PageMargin into account
       QueryPerformanceCounter(qStart)
       Control Get Client hDlg, %IDC_ListView To w,h
       w = w - 20 '- Graphic(Text.Size.x,"M"+$Spc)
    
       'get width of each letter - only have to do this once, but kept here to handle case where font changes before wrapping
       ReDim LetterWidth(255) As Long
       For index = 32 To 255                                                  'Bypass 0 to 31, they have to be zero
          LetterWidth(index) = Graphic(Text.Size.X, Chr$(index))              'Get each letter width in pixels
       Next
    
       'get pointers needed for wordwrapping
       LineCount = 0
       pBook        = StrPtr(BookText)                                        'Pointer to BookText
       pLetterWidth = VarPtr(LetterWidth(0))                                  'Pointer to start of LetterWidth()
    
       'wordwrap.  put $CR in $SPC to create a new line
       For index = 0 To Len(BookText) - 1
          LineWidthPixels = LineWidthPixels + @pLetterWidth[@pBook[index]]    'Add character width to the line width
          If LineWidthPixels > w Then                                         'Line is too long so insert a CR before here.
             LineWidthPixels = 0                                              'Reset line width, so can add as For..Next counts backward to start of this new line
             For SpaceIndex = index To 0 Step - 1                             'Find the previous space if any
                If @pBook[SpaceIndex] = 13 Then Incr LineCount : Exit For     'We don't want to go before the previous CR, so Abort the CR insertion
                If @pBook[SpaceIndex] = 32 Then @pBook[SpaceIndex] = 13 : Incr LineCount : Exit For    'Replace the space with a CR
                LineWidthPixels = LineWidthPixels + @pLetterWidth[@pBook[SpaceIndex]]           'Get the width after the CR
             Next SpaceIndex
          Else
             If @pBook[index] = 13 Then                                                        'Found a CR
                @pBook[index]     = 32                                                          'Replace CR with a space at the end of the line
                @pBook[index + 1] = 13                                                          'Replace the LF with a CR
                Incr index                                                                      'Jump over this new CR
                LineWidthPixels   = 0                                                           'Reset line width
                Incr LineCount
             End If
          End If
       Next
       Incr LineCount
    
       QueryPerformanceCounter(qStop)
       TotalTime += (qStop-qStart)
       Statusbar Set Text hDlg, %IDC_StatusBar, 2, 0, $Spc + Format$((qStop - qStart) / qFreq,"###.000") & "s"
    
       'optionally split BookText into an array and convert $CR to $CRLF
       QueryPerformanceCounter(qStart)
       Local i, iCount As Long
       ReDim CRArray(0 To LineCount)       'extra element used in virtual ListView to simplify getting last line of text
       CRArray(0) = 1                      'to help extract text using base 0
       CRArray(LineCount) = Len(BookText)  'to help extract text using base 0
       pBook = StrPtr(BookText)          '---Save a pointer to BookText
       For index = 1 To Len(BookText)    '---Scan byte by byte
          If @pBook[index-1] = 13 Then   '---Find CR
             Incr iCount                 '---Found so increment counter
             CRArray(iCount) = index     '---Save initial position of the line
          End If
        Next
       QueryPerformanceCounter(qStop)
       TotalTime += (qStop-qStart)
       Statusbar Set Text hDlg, %IDC_StatusBar, 3, 0, $Spc + Format$((qStop - qStart) / qFreq,"###.000") & "s"
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 4, 0, $Spc + Format$(TotalTime / qFreq,"###.000") & "s"
       Statusbar Set Text hDlg, %IDC_StatusBar, 5, 0, $Spc + Format$(LineCount, "##,###,#0 ")
       Statusbar Set Text hDlg, %IDC_StatusBar, 6, 0, $Spc + Format$(Len(BookText$)/1000000," #0.0") + "MB
    End Function
    
    Sub SelectFileToOpen
       Local title$, filter$, startfile$, startfolder$, defaultext$, flags&, filevar$
       filter$ = Chr$("Text Files",0,"*.txt",0)
       startfolder$ = PathName$(Path,CurrentFileName)        'initial folder to be displayed
       startfile$   = PathName$(Namex,CurrentFileName)       'name to be used as initial selection
       defaultext$  = "txt"                                  'default extension to append to selection if user does not enter it
       flags& = %OFN_Explorer Or %OFN_FileMustExist Or %OFN_HideReadOnly
       Display Openfile hDlg, 100, 100, "Select File", startfolder$, filter$, startfile$, defaultext$, flags& To filevar$
       If IsFile(filevar$) Then
          CurrentFileName = filevar$
          Statusbar Set Text hDlg, %IDC_StatusBar, 7, 0, IIf$(UseTextFile,PathName$(Namex,CurrentFileName),"<Sample Text>")
       End If
    End Sub
    
    
    Sub Settings_INI(Task$)
       Local x,y, i As Long
       Local xResult, yResult, temp, INIFileName As WStringZ*%Max_Path
       INIFileName = Exe.Path$ + Exe.Name$ + ".ini"
       If Task$ = "get" Then
          'get dialog top/left from INI file and use to set Dialog location
          Getprivateprofilestring "All", "Left", "300", xResult, %Max_Path, INIFileName
          Getprivateprofilestring "All", "Top", "300", yResult, %Max_Path, INIFileName
          Dialog Set Loc hDlg, Val(xResult), Val(yResult)   'left/top
    
          'get dialog width/height from INI file and use to set Dialog size
          GetPrivateProfileString "All", "Width", "550", xResult, %Max_Path, INIFileName
          GetPrivateProfileString "All", "Height", "550", yResult, %Max_Path, INIFileName
          Dialog Set Size hDlg,Val(xResult), Val(yResult)   'width/height
    
          'get value for string variables
          Getprivateprofilestring "All", "CurrentFileName", Exe.Path$ + "sample.txt", CurrentFileName, %Max_Path, INIFileName
          Getprivateprofilestring "All", "FontName", "Tahoma", FontName, %Max_Path, INIFileName
    
          'get value for numeric variables
          Getprivateprofilestring "All", "UseTextFile", "0",     temp, %Max_Path, INIFileName:  UseTextFile = Val(temp)
          Getprivateprofilestring "All", "ParagraphWrap", "1",   temp, %Max_Path, INIFileName:  ParagraphWrap = Val(temp)
          Getprivateprofilestring "All", "BuildArray", "0",      temp, %Max_Path, INIFileName:  BuildArray = Val(temp)
          Getprivateprofilestring "All", "FontSize", "12",       temp, %Max_Path, INIFileName:  FontSize = Val(temp)
          Getprivateprofilestring "All", "FontBold", "0",        temp, %Max_Path, INIFileName:  FontBold = Val(temp)
          Getprivateprofilestring "All", "FontDelta", "4",       temp, %Max_Path, INIFileName:  FontDelta = Val(temp)
          Getprivateprofilestring "All", "TopLine", "0",         temp, %Max_Path, INIFileName:  TopLine = Val(temp)
          Getprivateprofilestring "All", "LimitBlankLines", "1", temp, %Max_Path, INIFileName:  LimitBlankLines = Val(temp)
       End If
    
       If Task$ = "save" Then
          'save dialog size/location unless minimized or maximized
          If IsFalse(IsIconic(hDlg) Or IsZoomed(hDlg)) Then
             Dialog Get Loc hDlg To x,y
             WritePrivateProfileString "All", "Left", Str$(x), INIFileName
             WritePrivateProfileString "All", "Top", Str$(y), INIFileName
             Dialog Get Size hDlg To x,y
             WritePrivateProfileString "All", "Width", Str$(x), INIFileName
             WritePrivateProfileString "All", "Height", Str$(y), INIFileName
          End If
          'save string variables
          WritePrivateProfileString "All", "CurrentFileName",CurrentFileName, INIFileName
          WritePrivateProfileString "All", "FontName", FontName, INIFileName
    
          'save numeric variables
          WritePrivateProfileString "All", "UseTextFile",     Str$(UseTextFile), INIFileName
          WritePrivateProfileString "All", "ParagraphWrap",   Str$(ParagraphWrap), INIFileName
          WritePrivateProfileString "All", "BuildArray",      Str$(BuildArray), INIFileName
          WritePrivateProfileString "All", "FontSize",        Str$(FontSize), INIFileName
          WritePrivateProfileString "All", "FontBold",        Str$(FontBold), INIFileName
          WritePrivateProfileString "All", "FontDelta",       Str$(FontDelta), INIFileName
          WritePrivateProfileString "All", "TopLine",         Str$(TopLine), INIFileName
          WritePrivateProfileString "All", "LimitBlankLines", Str$(LimitBlankLines), INIFileName
       End If
    End Sub
    
    Sub SelectMainFont
       Local fName As String, fPoints, fStyle, fColor, CharSet, Style As Long, temp$
       Style = %CF_ForceFontExist Or %CF_NoScriptSel Or %CF_NoSimulations Or %CF_ScreenFonts 'Or %CF_FixedPitchOnly 'OR %CF_ScreenFonts Or
       ghHook = SetWindowsHookEx(%WH_CBT, CodePtr(FontDialogProc), GetModuleHandle(""), GetCurrentThreadId)
       Display Font hDlg, 100,100, FontName, FontSize, FontBold, Style To fName, fPoints, fStyle, fColor, CharSet
       UnhookWindowsHookEx ghHook
       If Len(fName) Then
          FontName = fName : FontSize = fPoints : FontBold = fStyle
       End If
    End Sub
    
    Function FontDialogProc(ByVal nCode As Long, ByVal WParam As Long, ByVal LParam As Long) As Long
        Local szTemp As WStringZ * %Max_Path, cw As CBT_CREATEWND Ptr, cst As CREATESTRUCT Ptr, ghHook As Dword
        Function = CallNextHookEx(ByVal ghHook, ByVal nCode, ByVal WParam, ByVal LParam)
        If nCode < 0 Then Exit Function
        If nCode = %HCBT_ACTIVATE Then UnhookWindowsHookEx ghHook
        If nCode = %HCBT_CREATEWND Then
            cw = LParam         ' Get pointer to CBT_CREATEWND struct so we can...    TT: Nick Melnick
            cst = @cw.lpcs      ' get a pointer to the CREATESTRUCT struct
            GetClassName WParam, szTemp, %Max_Path      ' for each window / control as it is created
            If UCase$(szTemp) = "#32770" Then @cst.cy = @cst.cy - 165 : @cst.cx = @cst.cx - 10  ' -190 works too
        End If
    End Function
    
    Sub EnumerateFonts
       Local hDC As Dword, lf As LogFont
       hDC = GetDC(%HWND_Desktop)
       EnumFontFamiliesEx hDC, lf, CodePtr(EnumFontName), 0,0
       ReleaseDC %HWND_Desktop, hDC
    End Sub
    
    Function EnumFontName(lf As LogFont, tm As TextMetric, ByVal FontType As Long, hWnd As Dword) As Long
       If (FontType And %TrueType_FontType) And (Left$(lf.lfFaceName,1)<>"@") Then   'TT fonts not start with "@"
          ComboBox Add hDlg, %IDC_ComboBox, lf.lfFaceName
       End If
       Function = 1
    End Function
    
    Sub PrepareBookTextForParagraphWrapping
       Local pBook As Byte Pointer, i,iCounter As Long
       pBook = StrPtr(BookText)      'pointer to BookText
       For i = 0 To Len(BookText)-1  'walk through all characters
          If @pBook[i]=13 Then
             Incr iCounter : Incr i
             If iCounter > 2 Then @pBook[i]=32   : @pBook[i+1] = 32  'more than 2 $CRLF were found. make extras $spc+$spc
          Else
             If iCounter = 1 Then @pBook[i-1]=32 : @pBook[i-2] = 32  'single $CRLF was found. make it $spc+$spc
             iCounter = 0
          End If
       Next i
    End Sub
    
    Sub SaveBookText
       Open "test.txt" For Output As #1
       Print #1, BookText
       Close #1
    End Sub
    Last edited by Gary Beene; 13 Oct 2017, 10:40 PM. Reason: Fixed error in SelectFileToOpen
Working...
X