DrawTextBox and DrawVectorTextBox

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

DrawTextBox and DrawVectorTextBox

Post by mk-soft »

Now update my DrawTextBox to DrawVectorTextBox :wink:

DrawTextBox.pbi

Code: Select all

;-TOP

; -----------------------------------------------------------------------------------

; Kommentar     : DrawTextBox
; Author        : mk-soft
; Second Author :
; Orginal       : DrawTextBox.pbi
; Version       : 1.06r2
; Erstellt      : 20.04.2014
; Geändert      : 03.06.2019

; -----------------------------------------------------------------------------------

EnableExplicit

; -----------------------------------------------------------------------------------

EnumerationBinary TextBox
  #TEXT_Right
  #TEXT_HCenter
  #TEXT_VCenter
  #TEXT_Bottom
EndEnumeration

; -----------------------------------------------------------------------------------

Procedure DrawTextBox(x, y, dx, dy, text.s, flags = 0)
  
  Protected is_right, is_hcenter, is_vcenter, is_bottom
  Protected text_width, text_height
  Protected text_x, text_y, break_y
  Protected text2.s, rows, row, row_text.s, row_text1.s, out_text.s, start, count
  
  ; Flags
  is_right = flags & #TEXT_Right
  is_hcenter = flags & #TEXT_HCenter
  is_vcenter = flags & #TEXT_VCenter
  is_bottom = flags & #TEXT_Bottom
  
  ; Übersetze Zeilenumbrüche
  text = ReplaceString(text, #LFCR$, #LF$)
  text = ReplaceString(text, #CRLF$, #LF$)
  text = ReplaceString(text, #CR$, #LF$)
  
  ; Erforderliche Zeilenumbrüche setzen
  rows = CountString(text, #LF$)
  For row = 1 To rows + 1
    text2 = StringField(text, row, #LF$)
    If text2 = ""
      out_text + #LF$
      Continue
    EndIf
    start = 1
    count = CountString(text2, " ") + 1
    Repeat
      row_text = StringField(text2, start, " ") + " "
      Repeat
        start + 1
        row_text1 = StringField(text2, start, " ")
        If TextWidth(row_text + row_text1) < dx - 12
          row_text + row_text1 + " "
        Else
          Break
        EndIf
      Until start > count
      out_text + RTrim(row_text) + #LF$
    Until start > count
  Next
  
  ; Berechne Y-Position
  text_height = TextHeight("X")
  rows = CountString(out_text, #LF$)
  If is_vcenter
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1)) - 2
    CompilerElse
      text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1))
    CompilerEndIf
  ElseIf is_bottom
    text_y = dy - (text_height * rows) - 2
  Else
    text_y = 2
  EndIf
  
  ; Korrigiere Y-Position
  While text_y < 2
    text_y = 2;+ text_height
  Wend
  
  break_y = dy - text_height / 2
  
  ; Text ausgeben
  For row = 1 To rows
    row_text = StringField(out_text, row, #LF$)
    If is_hcenter
      text_x = dx / 2 - TextWidth(row_text) / 2
    ElseIf is_right
      text_x = dx - TextWidth(row_text) - 4
    Else
      text_x = 4
    EndIf
    DrawText(x + text_x, y + text_y, row_text)
    text_y + text_height
    If text_y > break_y
      Break
    EndIf
  Next
  
  ProcedureReturn rows
  
EndProcedure

; -------------------------------------------------------------------------------------

Procedure.s WrapText(Width, Text.s, FontID = 0)
  Protected text2.s, rows, row, row_text.s, row_text1.s, out_text.s, start, count
  Static image
  
  If Not image
    image = CreateImage(#PB_Any, 16, 16)
  EndIf
  
  ; Übersetze Zeilenumbrüche
  text = ReplaceString(text, #LFCR$, #LF$)
  text = ReplaceString(text, #CRLF$, #LF$)
  text = ReplaceString(text, #CR$, #LF$)
  
  If StartDrawing(ImageOutput(image))
    If FontID
      DrawingFont(FontID)
    EndIf
    ; Erforderliche Zeilenumbrüche setzen
    rows = CountString(text, #LF$)
    For row = 1 To rows + 1
      text2 = StringField(text, row, #LF$)
      If text2 = ""
        out_text + #LF$
        Continue
      EndIf
      start = 1
      count = CountString(text2, " ") + 1
      Repeat
        row_text = StringField(text2, start, " ") + " "
        Repeat
          start + 1
          row_text1 = StringField(text2, start, " ")
          If TextWidth(row_text + row_text1) < Width - 12
            row_text + row_text1 + " "
          Else
            Break
          EndIf
        Until start > count
        out_text + RTrim(row_text) + #LF$
      Until start > count
    Next
    out_text = RTrim(out_text, #LF$)
    StopDrawing()
  EndIf
  
  ProcedureReturn out_text
  
EndProcedure

; *************************************************************************************

;-Example

CompilerIf #PB_Compiler_IsMainFile

  ;- Konstanten
  Enumeration ; Window ID
    #Window
  EndEnumeration
  
  Enumeration ; Menu ID
    #Menu
  EndEnumeration
  
  Enumeration ; MenuItem ID
    #Menu_Exit
  EndEnumeration
  
  Enumeration ; Statusbar ID
    #Statusbar
  EndEnumeration
  
  Enumeration ; Gadget ID
    #Canvas
  EndEnumeration
  
  ; *************************************************************************************
  
  Procedure.s GetDataSectionText(Addr)
    Protected result.s, temp.s
    While PeekC(Addr)
      temp = PeekS(Addr)
      Addr + StringByteLength(temp) + SizeOf(Character)
      result + temp
    Wend
    ProcedureReturn result
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure Draw(output, text.s)
    
    Define hfont = LoadFont(0, "Arial", 12);, #PB_Font_Bold)
    
    If  StartDrawing(output)
      DrawingFont(hfont)
      DrawingMode(#PB_2DDrawing_Transparent)
      
      Box(10, 10, 400, 200, $FF901E)
      DrawTextBox(10, 10, 400, 200, text)
      
      Box(10, 220, 400, 200,$E16941)
      DrawTextBox(10, 220, 400, 200, text, #TEXT_VCenter)
      
      Box(10, 430, 400, 200,$FF0000)
      DrawTextBox(10, 430, 400, 200, text, #TEXT_Bottom)
      
      Box(420, 10, 200, 200, $0045FF)
      DrawTextBox(420, 10, 200, 200, text, #TEXT_HCenter)
      
      Box(420, 220, 200, 200, $00008B)
      DrawTextBox(420, 220, 200, 200, text, #TEXT_HCenter | #TEXT_VCenter)
      
      Box(420, 430, 200, 200, $20A5DA)
      DrawTextBox(420, 430, 200, 200, text, #TEXT_HCenter | #TEXT_Bottom)
      
      Box(630, 10, 400, 200, $238E6B)
      DrawTextBox(630, 10, 400, 200, text, #TEXT_Right)
      
      Box(630, 220, 400, 200, $006400)
      DrawTextBox(630, 220, 400, 200, text, #TEXT_Right | #TEXT_VCenter)
      
      Box(630, 430, 400, 200, $32CD32)
      DrawTextBox(630, 430, 400, 200, text, #TEXT_Right | #TEXT_Bottom)
      
      StopDrawing()
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ;- Globale Variablen
  Global exit = 0
  
  ;- Fenster
  Define style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 1200, 800, "DrawTextBox", style)
    ; Menu
    If CreateMenu(#Menu, WindowID(#Window))
      MenuTitle("&File")
        MenuItem(#Menu_Exit, "&Exit")
    EndIf
    ; Statusbar
    CreateStatusBar(#Statusbar, WindowID(#Window))
    AddStatusBarField(#PB_Ignore)
    StatusBarText(#Statusbar, 0, "Example DrawTextbox")
    
    ; Gadgets
    CanvasGadget(#Canvas, 0, 0, WindowWidth(#Window), WindowHeight(#Window) - MenuHeight() - StatusBarHeight(#Statusbar))
    
    Define t1.s = GetDataSectionText(?Text1)
    
    Draw(CanvasOutput(#Canvas), t1)
    
    ; MessageRequester("WrapText",  WrapText(250, t1))
    
    ;-- Hauptschleife
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Menu                       ; ein Menü wurde ausgewählt
          Select EventMenu()
            Case #Menu_Exit
              Exit = 1
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
            Case #PB_Menu_Quit
              Exit = 1
            CompilerEndIf
          EndSelect
        Case #PB_Event_CloseWindow                ; das Schließgadget vom Fenster wurde gedrückt
          Exit = 1
        
      EndSelect
      
    Until Exit
  EndIf
  
  DataSection
    Text1:
    Data.s "PureBasic is a native 32-bit and 64-bit programming language based on established BASIC rules." 
    Data.s "The key features of PureBasic are portability (Windows, Linux And MacOS X are currently supported)," 
    Data.s "the production of very fast And highly optimized executables And, of course, the very simple BASIC syntax."
    Data.i 0
    Text2:
    Data.s "PureBasic has been created For the beginner And expert alike."
    Data.s "We have put a lot of effort into its realization To produce a fast, reliable system friendly language."
    Data.s "In spite of its beginner-friendly syntax, the possibilities are endless With PureBasic's advanced "
    Data.s "features such As pointers, structures, procedures, dynamically linked lists And much more."
    Data.s "Experienced coders will have no problem gaining access To any of the legal OS structures"
    Data.s "Or API objects And PureBasic even allows inline ASM."
    Data.i 0
  EndDataSection
 
CompilerEndIf
DrawVectorTextBox.pbi

Code: Select all

;-TOP

; -----------------------------------------------------------------------------------

; Kommentar     : DrawVectorTextBox
; Author        : mk-soft
; Second Author :
; Orginal       : DrawVectorTextBox.pbi
; Version       : v1.01.2
; Erstellt      : 16.05.2020
; Geändert      : 

; -----------------------------------------------------------------------------------

EnableExplicit

; -----------------------------------------------------------------------------------

EnumerationBinary TextVectorBox
  #TEXT_Right
  #TEXT_HCenter
  #TEXT_VCenter
  #TEXT_Bottom
EndEnumeration

; -----------------------------------------------------------------------------------

Procedure DrawVectorTextBox(x, y, dx, dy, text.s, flags = 0)
  
  Protected is_right, is_hcenter, is_vcenter, is_bottom
  Protected text_width.d, text_height.d, text_line.d
  Protected text_x.d, text_y.d, break_y.d
  Protected text2.s, rows, row, row_text.s, row_text1.s, out_text.s, start, count
  
  ; Flags
  is_right = flags & #TEXT_Right
  is_hcenter = flags & #TEXT_HCenter
  is_vcenter = flags & #TEXT_VCenter
  is_bottom = flags & #TEXT_Bottom
  
  ; Übersetze Zeilenumbrüche
  text = ReplaceString(text, #LFCR$, #LF$)
  text = ReplaceString(text, #CRLF$, #LF$)
  text = ReplaceString(text, #CR$, #LF$)
  
  ; Erforderliche Zeilenumbrüche setzen
  rows = CountString(text, #LF$)
  For row = 1 To rows + 1
    text2 = StringField(text, row, #LF$)
    If text2 = ""
      out_text + #LF$
      Continue
    EndIf
    start = 1
    count = CountString(text2, " ") + 1
    Repeat
      row_text = StringField(text2, start, " ") + " "
      Repeat
        start + 1
        row_text1 = StringField(text2, start, " ")
        If VectorTextWidth(row_text + row_text1) < dx - 12
          row_text + row_text1 + " "
        Else
          Break
        EndIf
      Until start > count
      out_text + RTrim(row_text) + #LF$
    Until start > count
  Next
  
  ; Berechne Y-Position
  text_height = VectorTextHeight("X") * 1.1
  text_line = text_height / 4
  rows = CountString(out_text, #LF$)
  If is_vcenter
    text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1))
  ElseIf is_bottom
    text_y = dy - (text_height * rows) - text_line
  Else
    text_y = text_line
  EndIf
  
  ; Korrigiere Y-Position
  While text_y < text_line
    text_y = text_line
  Wend
  
  break_y = dy - text_height
  
  ; Text ausgeben
  For row = 1 To rows
    row_text = StringField(out_text, row, #LF$)
    If is_hcenter
      text_x = dx / 2 - VectorTextWidth(row_text) / 2
    ElseIf is_right
      text_x = dx - VectorTextWidth(row_text) - 4
    Else
      text_x = 4
    EndIf
    MovePathCursor(x + text_x, y + text_y)
    DrawVectorText(row_text)
    text_y + text_height
    If text_y > break_y
      Break
    EndIf
  Next
  
  ProcedureReturn rows
  
EndProcedure

; *************************************************************************************

;-Example

CompilerIf #PB_Compiler_IsMainFile

  ;- Konstanten
  Enumeration ; Window ID
    #Window
  EndEnumeration
  
  Enumeration ; Menu ID
    #Menu
  EndEnumeration
  
  Enumeration ; MenuItem ID
    #Menu_Exit
  EndEnumeration
  
  Enumeration ; Statusbar ID
    #Statusbar
  EndEnumeration
  
  Enumeration ; Gadget ID
    #Canvas
  EndEnumeration
  
  ; *************************************************************************************
  
  Procedure.s GetDataSectionText(Addr)
    Protected result.s, temp.s
    While PeekC(Addr)
      temp = PeekS(Addr)
      Addr + StringByteLength(temp) + SizeOf(Character)
      result + temp
    Wend
    ProcedureReturn result
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure VectorBox(x, y, Width, height, Color)
    SaveVectorState()
    AddPathBox(x, y, Width, height)
    VectorSourceColor(Color | $FF000000)
    FillPath()
    RestoreVectorState()
  EndProcedure
  
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ResetCoordinatesDPI()
    ResetCoordinates()
    ScaleCoordinates(DesktopScaledX(1.0), DesktopScaledY(1.0))
  EndProcedure
  
  Procedure ScaleCoordinatesDPI(ScaledX.d, ScaledY.d)
    ScaleCoordinates(ScaledX * DesktopScaledX(1.0), ScaledY * DesktopScaledY(1.0))
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure Draw(output, text.s)
    
    Define hfont = LoadFont(0, "Arial", 12);, #PB_Font_Bold)
    
    If  StartVectorDrawing(output)
      
      ResetCoordinatesDPI()
      
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_Windows
          VectorFont(hfont, 13)
        CompilerCase #PB_OS_MacOS
          VectorFont(hfont, 16)
        CompilerCase #PB_OS_Linux
          VectorFont(hfont, 12)
      CompilerEndSelect
      
      VectorSourceColor(RGBA(0, 0, 0, 192))
      
      VectorBox(10, 10, 400, 200, $FF901E)
      DrawVectorTextBox(10, 10, 400, 200, text)
      
      VectorBox(10, 220, 400, 200,$E16941)
      DrawVectorTextBox(10, 220, 400, 200, text, #TEXT_VCenter)
      
      VectorBox(10, 430, 400, 200,$FF0000)
      DrawVectorTextBox(10, 430, 400, 200, text, #TEXT_Bottom)
      
      VectorBox(420, 10, 200, 200, $0045FF)
      DrawVectorTextBox(420, 10, 200, 200, text, #TEXT_HCenter)
      
      VectorBox(420, 220, 200, 200, $00008B)
      DrawVectorTextBox(420, 220, 200, 200, text, #TEXT_HCenter | #TEXT_VCenter)
      
      VectorBox(420, 430, 200, 200, $20A5DA)
      DrawVectorTextBox(420, 430, 200, 200, text, #TEXT_HCenter | #TEXT_Bottom)
      
      VectorBox(630, 10, 400, 200, $238E6B)
      DrawVectorTextBox(630, 10, 400, 200, text, #TEXT_Right)
      
      VectorBox(630, 220, 400, 200, $006400)
      DrawVectorTextBox(630, 220, 400, 200, text, #TEXT_Right | #TEXT_VCenter)
      
      VectorBox(630, 430, 400, 200, $32CD32)
      DrawVectorTextBox(630, 430, 400, 200, text, #TEXT_Right | #TEXT_Bottom)
      
      StopVectorDrawing()
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ;- Globale Variablen
  Global exit = 0
  
  ;- Fenster
  Define style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 1200, 800, "DrawVectorTextBox", style)
    ; Menu
    If CreateMenu(#Menu, WindowID(#Window))
      MenuTitle("&File")
        MenuItem(#Menu_Exit, "&Exit")
    EndIf
    ; Statusbar
    CreateStatusBar(#Statusbar, WindowID(#Window))
    AddStatusBarField(#PB_Ignore)
    StatusBarText(#Statusbar, 0, "Example DrawVectorTextBox")
    
    ; Gadgets
    CanvasGadget(#Canvas, 0, 0, WindowWidth(#Window), WindowHeight(#Window) - MenuHeight() - StatusBarHeight(#Statusbar))
    
    Define t1.s = GetDataSectionText(?Text1)
    
    Draw(CanvasVectorOutput(#Canvas), t1)
    
    ;-- Hauptschleife
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Menu                       ; ein Menü wurde ausgewählt
          Select EventMenu()
            Case #Menu_Exit
              Exit = 1
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
            Case #PB_Menu_Quit
              Exit = 1
            CompilerEndIf
          EndSelect
        Case #PB_Event_CloseWindow                ; das Schließgadget vom Fenster wurde gedrückt
          Exit = 1
        
      EndSelect
      
    Until Exit
  EndIf
  
  DataSection
    Text1:
    Data.s "PureBasic is a native 32-bit and 64-bit programming language based on established BASIC rules." 
    Data.s "The key features of PureBasic are portability (Windows, Linux And MacOS X are currently supported)," 
    Data.s "the production of very fast And highly optimized executables And, of course, the very simple BASIC syntax."
    Data.i 0
    Text2:
    Data.s "PureBasic has been created For the beginner And expert alike."
    Data.s "We have put a lot of effort into its realization To produce a fast, reliable system friendly language."
    Data.s "In spite of its beginner-friendly syntax, the possibilities are endless With PureBasic's advanced "
    Data.s "features such As pointers, structures, procedures, dynamically linked lists And much more."
    Data.s "Experienced coders will have no problem gaining access To any of the legal OS structures"
    Data.s "Or API objects And PureBasic even allows inline ASM."
    Data.i 0
  EndDataSection
 
CompilerEndIf
Last edited by mk-soft on Sat May 16, 2020 4:12 pm, edited 3 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: DrawTextBox and DrawVectorTextBox

Post by mk-soft »

Update DrawVectorTextBox v1.01.2
- Bugfix Y-Position all OS
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: DrawTextBox und DrawVectorTextBox

Post by Saki »

Very nice
Can you change the output to DPI aware and scaling >100% ?

And maybe frames and transparency would be very nice 8)
地球上の平和
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: DrawTextBox and DrawVectorTextBox

Post by mk-soft »

The TextBox outputs only the text. With which color and transparency you determine before.

With Vector graphics the adjustment to DPI is very simple.
For this one takes ScaleCoordinates.

Code: Select all

If  StartVectorDrawing(output)
      
      dpiX.d = DesktopScaledX(1.0)
      dpiY.d = DesktopScaledY(1.0)
      
      ScaleCoordinates(dpiX, dpiY)
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: DrawTextBox und DrawVectorTextBox

Post by Saki »

Hi
Thanks for the info
地球上の平和
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: DrawTextBox and DrawVectorTextBox

Post by mk-soft »

i have update the examples with two DPI vector functions ...

Code: Select all

  ; -------------------------------------------------------------------------------------
  
  Procedure ResetCoordinatesDPI()
    ResetCoordinates()
    ScaleCoordinates(DesktopScaledX(1.0), DesktopScaledY(1.0))
  EndProcedure
  
  Procedure ScaleCoordinatesDPI(ScaledX.d, ScaledY.d)
    ScaleCoordinates(ScaledX * DesktopScaledX(1.0), ScaledY * DesktopScaledY(1.0))
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: DrawTextBox and DrawVectorTextBox

Post by Kwai chang caine »

Very useful
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply