DrawTextBox

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

DrawTextBox

Beitrag von mk-soft »

Hi,
Diesmal kein Modul... :D

"DrawTextBox.pbi" mit einfachen Textumbruch und Flags für die Ausrichtung des Textes.

Update
Beispiel geändert da DrawText von PB nicht in WindowOutput unter GTK3 mehr funktioniert

Update v1.06
- Fix Variablen
- Fix WrapText

Code: Alles auswählen

;-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  
FF :wink:
Zuletzt geändert von mk-soft am 03.06.2019 20:33, insgesamt 10-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: DrawTextBox

Beitrag von RSBasic »

:allright:

Aber ein Redraw-Event muss noch hinzugefügt werden, da sonst deine Textboxen bei Neuzeichnung des Fensters (Minimierung, Verschiebung außerhalb des Bildschirms oder wenn sich ein anderes Fenster auf dein Fenster überlappt) verschwinden.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: DrawTextBox

Beitrag von mk-soft »

Danke <)

Repaint im Beispiel erweitert...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: DrawTextBox

Beitrag von NicTheQuick »

Interessant, dass das so funktioniert.

Code: Alles auswählen

text.s = #CRLF$ + #CRLF$

; Übersetze Zeilenumbrüche
text = ReplaceString(text, #LFCR$, #LF$) ; text = #CR$ + #LF$ + #LF$
text = ReplaceString(text, #CRLF$, #LF$) ; text = #LF$ + #LF$
text = ReplaceString(text, #CR$, #LF$)   ; unverändert

Debug CountString(text, #LF$)
Ich dachte eben nämlich noch, dass da was schief gehen könnte, wenn zuerst #LFCR$ ersetzt wird und zwei #CRLF$ aufeinander folgen. :D
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: DrawTextBox

Beitrag von mk-soft »

Update v1.03
- Bugfix: Mac TextHeight

Arbeite das erste mal mit Mac OS.

Habe dabei festgestellt das Purebasic bei TextHeight unterschiedlich arbeitet.
Bei Windows liefert TextHeight die Höhe von einer Zeile, auch wenn ein Zeilenumbruch vorhanden ist.
Mac liefert die Höhe mit Zeilenumbruch.

FF :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: DrawTextBox

Beitrag von ts-soft »

:allright:

Ab einer Fontgrösse >= 18 wird es aber irgendwie komisch :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Falko
Admin
Beiträge: 3531
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.0
Kontaktdaten:

Re: DrawTextBox

Beitrag von Falko »

:allright:

Prima Code, danke :)
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
Benutzeravatar
Kiffi
Beiträge: 10621
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Re: DrawTextBox

Beitrag von Kiffi »

sehr schön, Danke! :allright:
mk-soft hat geschrieben:

Code: Alles auswählen

[...]
  Define hfont = LoadFont(0, "Aprial", 12)
[...]
nächsten Monat heißt der Font dann Mairial? ;-)

Grüße ... Kiffi
Hygge
Benutzeravatar
Domino
Beiträge: 22
Registriert: 21.12.2015 21:28
Computerausstattung: Centrino 2x2GHz, GeForce Graka
Linux 3.16

Re: DrawTextBox

Beitrag von Domino »

Interessant. Gesichert und ... DANKE!

Gruß
Domino
Centrino 2x2GHz, GeForce Graka, mehrere Linux Mint u.a. mit Mate, Linux 3.16
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: DrawTextBox

Beitrag von ts-soft »

Kleine Fehlermeldung: Unter Linux mit GTK3 gibt es einen IMA. Aber das ist wahrscheinlich eher ein PB bug.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Antworten