PureBasic Forums - English

Code: Select all

EnableExplicit

Procedure.s WordWrap (text$, width.i, mode=-1, delimList$=" "+Chr(9), nl$=#LF$)
    Protected line$, ret$="", LineRet$=""
    Protected.i CountString, i, start, ii, FindString, length
    
    text$ = ReplaceString(text$, #LFCR$, #LF$)
    text$ = ReplaceString(text$, #CRLF$, #LF$)
    text$ = ReplaceString(text$, #CR$, #LF$)
    text$ + #LF$
    
    CountString = CountString(text$, #LF$) 
    
    For i = 1 To CountString
      line$ = StringField(text$, i, #LF$)
      start = Len(line$)
      length = start
      
      Repeat
        If TextWidth(RTrim(Left(line$, length))) < width 
          Break
        Else
          length - 1 
        EndIf
      Until 0 > length
      
      While start > length : FindString = 0
        For ii = length To 0 Step - 1
          If mode=-1 And CountString(Left(line$,ii), " ") > 1
            FindString + FindString(delimList$, Mid(RTrim(line$),ii,1))
            If FindString<>2
              Continue
            EndIf
          Else
            FindString = FindString(delimList$, Mid(line$,ii,1))
          EndIf
          
          If FindString
            start = ii
            Break
          EndIf
        Next
        
        If Not FindString
          start = length
        EndIf
        
        LineRet$ + Left(line$, start) + nl$
        line$ = LTrim(Mid(line$, start+1))
        start = Len(line$)
        length = start
        
        Repeat
          If TextWidth(RTrim(Left(line$, length))) < width 
            Break
          Else
            length - 1 
          EndIf
        Until 0 > length
      Wend
      
      ret$ +  LineRet$ + line$ + nl$
      LineRet$=""
    Next
    
    ProcedureReturn ret$ ; ReplaceString(ret$, " ", "*")
  EndProcedure
  
LoadFont(0, "Courier", 14)

Procedure ShowWindow (title$, text$, softWrapWidth.i, hardWrapWidth.i=-1, delimList$=" "+Chr(9), nl$=#LF$, liStart$="")
  Protected text1$, left
  If OpenWindow(0, 0, 0, 450, 650, title$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
    MessageRequester("Fatal error", "Program terminated.")
    End
  EndIf
  
  TextGadget(0, 10, 10, 210, 330, "")
  If StartDrawing(WindowOutput(0))
    DrawingFont(FontID(0))
    left = 6 ; indent in editor gadget
    text1$ = WordWrap(text$, softWrapWidth-left*2, 0, delimList$, nl$)
    StopDrawing()
  EndIf
  SetGadgetText(0, ReplaceString(text1$, " ", "*"))
  SetGadgetColor(0, #PB_Gadget_BackColor, $CCBFB4)
  SetGadgetFont(0,FontID(0) )
  
  
  TextGadget(5, 230, 10, 210, 330, "")
  If StartDrawing(WindowOutput(0))
    DrawingFont(FontID(0))
    left = 2 ; indent in text gadget
    text1$ = WordWrap(text$, softWrapWidth-left*2, -1, delimList$, nl$)
    StopDrawing()
  EndIf
  SetGadgetText(5, ReplaceString(text1$, " ", "*"))
  SetGadgetColor(5, #PB_Gadget_BackColor, $CCBFB4)
  SetGadgetFont(5,FontID(0) )
  
  EditorGadget(10, 10, 350, softWrapWidth, 200, #PB_Editor_WordWrap) 
  SetGadgetText(10, text$)
  SetGadgetFont(10,FontID(0) )
  
  TextGadget(15, 230, 350, softWrapWidth, 200,"") 
  SetGadgetText(15, text$)
  SetGadgetFont(15,FontID(0) )
  SetGadgetColor(15, #PB_Gadget_BackColor, $FFFFFF)
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
  CloseWindow(0)
EndProcedure


Define line$, text$

line$ = "Vertical & Horizontal" + #LF$ + "   Centered   Text in   " + #LF$ + "Multiline StringGadget"

ShowWindow("Word wrap demo", line$, 104)

Code: Select all

Procedure GetTextWidth(Text.s, FontID = 0)
  Static helpImage
  Protected result
  
  If Not helpImage
    helpImage = CreateImage(#PB_Any, 32, 32)
  EndIf
  
  If StartDrawing(ImageOutput(helpImage))
    If FontID
      DrawingFont(FontID)
    EndIf
    result = TextWidth(Text)
    StopDrawing()
  EndIf
  ProcedureReturn result
EndProcedure

Debug GetTextWidth("Hello World")
Debug GetTextWidth("This is my right way")