Features :
Text multiline
Text right
Text center
Text vertical
Text reverse
Text RTL
Text stretching
Automatic and manual box functions
Can create images and sprites from text
All OS
Module
Is enhanced also a part from BucketFill advanced
This little and tricky tool can make many things simpler
Code: Select all
; === Module DrawText_EX ===
DeclareModule DrawText_EX
Declare DrawText_EX(txt_x, txt_y, txt$, f_col=#White, b_col=#Black, flag=0, mode=0, stretch_x=0, stretch_y=0)
; All OS - Author(C) : Werner Albus - www.nachtoptik.de - www.quick-aes-256.de - Free for using and enhancing
; Flags : Text center=1 - Text right=2 - Text vertical=3
; Modes : Revers text mode=1 - RTL text mode=2 - Give only back the needed width mode=3 , height mode=4
; Mono line output give back the xx output coordinate - Multi line output give back the yy output coordinate
; For stretched text on a textured background often DrawingMode (#PB_2DDrawing_Transparent) is needed
; Create a image from the output, for post processing or using as image, give back a image (ID) - Padding -1 is automatic padding
Declare DrawTextCreateImage_EX(txt$, f_col=#White, b_col=#Black, flag=0, mode=0, font_ID=0, stretch_x=0, stretch_y=0, padding=0)
Declare PresetLineWidth_EX(max_1_) ; Preset the min output length for easy centric or right align outputs - Deactivate = 0
; Important for permanent changed outputs
Declare DrawText_EX_AutoBox(padding_=-1, ; Automatic padding = -1 - Deactivate = -2
box_color_=0,
offset_x_=0,
offset_y_=0,
offset_xx_=0,
offset_yy_=0)
Declare DrawText_EX_Box(activate_=1, box_color_1_=0, offset_x_1=0, offset_y_1_=0, width_=0, height_=0) ; Activate = 1 - Deactivate = 0
EndDeclareModule
Module DrawText_EX
EnableExplicit
Global max_1, padding=-2, box_color, offset_x, offset_y, offset_xx, offset_yy
Global activate, box_color_1, offset_x_1, offset_y_1, width, height, from_image, image_color
Procedure DrawText_EX(txt_x, txt_y, txt$, f_col=#White, b_col=#Black, flag=0, mode=0, stretch_x=0, stretch_y=0)
If txt$="" : ProcedureReturn -1 : EndIf
Protected i1=TextHeight(Space(1))+stretch_y, i2, i3, i4, i5, i6, i7, padding_1
Protected result, max, max_len, max_2, max_3, txt_x_0=txt_x, txt_y_0=txt_y, amount_lines
Protected txt1$, chr$, ln$, ln1$
Protected Dim f1$(0), Dim f2$(0)
txt1$=ReplaceString(ReplaceString(ReplaceString(txt$, #CRLF$, #LF$), #CR$, #LF$), #LFCR$, #LF$)
i7=Len(txt1$)
If flag<>3 And FindString(txt1$, #LF$)
amount_lines=CountString(txt$, #LF$)+1
txt_y-i1
For result=1 To i7
ln$=StringField(txt1$, result, #LF$)
i4=Len(ln$)
If i4
max_2=TextWidth(ln$)+stretch_x*i4
If max_2>max_3
max_3=max_2
ln1$=ln$
i2+i1
max=TextWidth(ln$)+i4
max_len=i4
EndIf
EndIf
Next
If max_1>0
max=max_1
EndIf
If flag=1 ; Centered
txt_x+max_len*(stretch_x>>1)-max_len>>1
ElseIf flag=2 ; Right
txt_x+max_len*(stretch_x)-max_len
EndIf
EndIf
If mode=3 And flag<>3
If i2
If Not stretch_x
ProcedureReturn TextWidth(ln1$)+2
Else
i6=Len(ln1$)
For i4=1 To i6
i5+TextWidth(Mid(ln1$, i4, 1))
Next
ProcedureReturn i5+stretch_x*i6+stretch_x/12
EndIf
Else
If Not stretch_x
ProcedureReturn TextWidth(txt1$)+2
Else
For i4=1 To i7
i5+TextWidth(Mid(txt1$, i4, 1))
Next
ProcedureReturn i5+stretch_x*Len(txt1$)+stretch_x/12
EndIf
EndIf
EndIf
If mode=4 And flag<>3
If i2
ProcedureReturn amount_lines*(i1+1)-stretch_y
Else
ProcedureReturn i1+1-stretch_y
EndIf
EndIf
Macro first_char_width
i5=0
For i4=1 To i7
i6=TextWidth(Mid(txt1$, i4, 1))
If i6>i5
i5=i6
EndIf
Next
EndMacro
If padding=-1
padding_1=TextWidth(Space(3))
Else
padding_1=padding
EndIf
If mode=3 And flag=3
first_char_width
ProcedureReturn i5
EndIf
If mode=4 And flag=3
ProcedureReturn i1*i7-stretch_y
EndIf
If activate=1
Box(txt_x_0+offset_x_1,
txt_y_0+offset_y_1,
width,
height,
box_color_1)
EndIf
If Not from_image
If padding<>-2
If i2
Box(txt_x_0-padding_1+offset_x,
txt_y_0-padding_1+offset_y,
max+max_len*(stretch_x)-stretch_x-max_len+padding_1<<1+offset_xx,
amount_lines*i1-stretch_y+padding_1<<1+offset_yy,
box_color)
Else
If flag<>3
Box(txt_x_0-padding_1+offset_x,
txt_y_0-padding_1+offset_y,
TextWidth(txt1$)+stretch_x*(i7-1)+padding_1<<1+offset_xx,
i1+padding_1<<1+offset_yy,
box_color)
Else ; Vertical box
first_char_width
Box(txt_x_0-padding_1+offset_x>>1,
txt_y_0-padding_1+offset_y,
i5+padding_1<<1+offset_xx,
i1*i7+padding_1<<1+offset_yy,
box_color)
EndIf
EndIf
EndIf
Else
DrawingMode(#PB_2DDrawing_Transparent)
EndIf
Macro spread_x(txt_x, txt_y, ln)
i6=0
i4=Len(ln)
For i5=1 To Len(ln)
ln1$=Mid(ln, i5, 1)
If flag=1 And i2
DrawText(txt_x+i6-i4*stretch_x>>1, txt_y, ln1$, f_col, b_col)
ElseIf flag=2 And i2
DrawText(txt_x+i6-i4*stretch_x, txt_y, ln1$, f_col, b_col)
Else
DrawText(txt_x+i6, txt_y, ln1$, f_col, b_col)
EndIf
i6+TextWidth(ln1$)+stretch_x
Next
EndMacro
Macro rtl(txt)
i5=0
i3=Len(txt)
For i4=1 To i3
If Mid(txt, i4, 1)=" "
i6+1
EndIf
ln1$=StringField(txt, i4, " ")
If ln1$<>""
ReDim f1$(i5)
ReDim f2$(i5)
f1$(i5)=ln1$
f2$(i5)=ReverseString(ln1$)
i5+1
EndIf
Next
txt=ReverseString(txt)
For i4=0 To i5-1
txt=ReplaceString(txt, f2$(i4), f1$(i4))
Next
i3=0 : i5=0 : i6=0
EndMacro
Macro txt_out
If mode=1
ln$=ReverseString(ln$)
ElseIf mode=2
rtl(ln$)
EndIf
If flag=2 ; Right
If stretch_x
spread_x(txt_x+max-TextWidth(ln$), txt_y+i2, ln$)
Else
DrawText(txt_x+max-TextWidth(ln$), txt_y+i2, ln$, f_col, b_col)
EndIf
ElseIf flag=1 ; Centered
If stretch_x
spread_x(txt_x+max>>1-TextWidth(ln$)>>1, txt_y+i2, ln$)
Else
DrawText(txt_x+max>>1-TextWidth(ln$)>>1, txt_y+i2, ln$, f_col, b_col) : EndIf
Else ; Left
If stretch_x
spread_x(txt_x, txt_y+i2, ln$)
Else
DrawText(txt_x, txt_y+i2, ln$, f_col, b_col)
EndIf
EndIf
EndMacro
If flag=3 And mode=1
rtl(txt1$)
EndIf
If flag=3 ; Vertical
txt1$=ReplaceString(txt1$, #LF$, " ")
If mode
txt1$=ReverseString(txt1$)
EndIf
For result=1 To i7
chr$=Mid(txt1$, result, 1)
first_char_width
DrawText(i5>>1+txt_x-TextWidth(chr$)>>1, txt_y+i3, chr$, f_col, b_col)
i3+i1
Next
ProcedureReturn txt_y+i3
Else ; Horizontal
If i2
i2=0 : ln$=""
For result=1 To i7
chr$=Mid(txt1$, result, 1)
If chr$=#LF$
i2+i1
txt_out
ln$=""
Else
ln$+chr$
EndIf
Next
i2+i1
txt_out
ProcedureReturn txt_y+i2+i1
Else ; One line
If mode=1
txt$=ReverseString(txt$)
ElseIf mode=2
rtl(txt$)
EndIf
If stretch_x
spread_x(txt_x, txt_y, txt$)
Else
DrawText(txt_x, txt_y, txt$, f_col, b_col)
EndIf
EndIf
EndIf
If i6
ProcedureReturn txt_x+i6
Else
ProcedureReturn txt_x+TextWidth(txt$)
EndIf
EndProcedure
Procedure DrawTextCreateImage_EX(txt$, f_col=#White, b_col=#Black, flag=0, mode=0, font_ID=0, stretch_x=0, stretch_y=0, padding=0)
If txt$="" : ProcedureReturn -2 : EndIf
Protected image_ID=CreateImage(#PB_Any, 1, 1)
If Not image_ID : ProcedureReturn -3 : EndIf
If Not StartDrawing(ImageOutput(image_ID)) ; Get the needed width and length for the output
FreeImage(image_ID)
ProcedureReturn -4
EndIf
If IsFont(font_ID) : DrawingFont(FontID(font_ID)) : EndIf
If padding=-1
padding=TextWidth(Space(3))
EndIf
If max_1>0
Protected output_width=max_1 ; Get the needed width
Else
output_width=DrawText_EX(0, 0, txt$, 0, 0, flag, 3, stretch_x, stretch_y)-stretch_x ; Get the needed width
EndIf
Protected output_height=DrawText_EX(0, 0, txt$, 0, 0, flag, 4, stretch_x, stretch_y)-stretch_y ; Get the needed height
StopDrawing()
If mode=3
ProcedureReturn output_width+padding
EndIf
If mode=4
ProcedureReturn output_height+padding
EndIf
If Not ResizeImage(image_ID, output_width+padding<<1, output_height+padding<<1)
FreeImage(image_ID)
ProcedureReturn -5
EndIf
If Not StartDrawing(ImageOutput(image_ID)) ; Draw the text in the image
FreeImage(image_ID)
ProcedureReturn -6
EndIf
Box(0, 0, output_width+padding<<1, output_height+padding<<1, b_col)
If IsFont(font_ID) : DrawingFont(FontID(font_ID)) : EndIf
Protected old_activate=activate
activate=0
from_image=1
image_color=b_col
DrawText_EX(padding, padding, txt$, f_col, 0, flag, mode, stretch_x, stretch_y)
activate=old_activate
from_image=0
StopDrawing()
ProcedureReturn image_ID
EndProcedure
Procedure PresetLineWidth_EX(max_1_)
max_1=max_1_
EndProcedure
Procedure DrawText_EX_AutoBox(padding_=-1,
box_color_=0,
offset_x_=0,
offset_y_=0,
offset_xx_=0,
offset_yy_=0)
padding=padding_
box_color=box_color_
offset_x=offset_x_
offset_y=offset_y_
offset_xx=offset_xx_
offset_yy=offset_yy_
EndProcedure
Procedure DrawText_EX_Box(activate_=1, box_color_1_=0, offset_x_1_=0, offset_y_1_=0, width_=0, height_=0)
activate=activate_
box_color_1=box_color_1_
offset_x_1=offset_x_1_
offset_y_1=offset_y_1_
width=width_
height=height_
EndProcedure
EndModule
UseModule DrawText_EX
CompilerIf #PB_Compiler_IsMainFile ; Use module DrawText_EX
CompilerIf #PB_Compiler_OS=#PB_OS_MacOS : result=14 : win_h=780 : CompilerElse : result=11 : win_h=700 : CompilerEndIf
font_ID=LoadFont(#PB_Any, "Arial", result)
window_ID=OpenWindow(#PB_Any, 0, 0, 1220, win_h, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(window_ID, $FF00)
CompilerIf #PB_Compiler_Version<560 ; Without canvas container function
canvas_ID=CanvasGadget(#PB_Any, 5, 5 , WindowWidth(window_ID)-10, WindowHeight(window_ID)-10)
CompilerElse
canvas_ID=CanvasGadget(#PB_Any, 5, 5 , WindowWidth(window_ID)-10, WindowHeight(window_ID)-10, #PB_Canvas_Container)
CompilerEndIf
txt$="This is DrawText_EX"+#LF$+#LF$+"Maked from the Author of BucketFill advanced"+#LF$+#LF$+
"Author : Werner Albus"+#LF$+"www.nachtoptik.de - www.quick-aes-256.de"+#LF$+#LF$+"Have Fun"
txt1$="Hey, cool, with vertical Text"
StartDrawing(CanvasOutput(canvas_ID)) : DrawingFont(FontID(font_ID))
DrawText_EX(30, 10, txt1$, #Red, #White, 3, 0)
DrawText_EX(70, 10, txt1$, #Black, #White, 3, 2)
DrawText_EX(110, 10, txt1$, #Black, #White, 3, 1)
result=DrawText_EX(150, 10, txt$, #Black, #White)
result=DrawText_EX(150, result+40, txt$, #Black, #White, 2)
DrawText_EX(150, result+40, txt$, #Black, #White, 1)
result=DrawText_EX(490, 10, txt$, #Black, #White, 0, 1)
result=DrawText_EX(490, result+40, txt$, #Black, #White, 2, 1)
DrawText_EX(490, result+40, txt$, #Black, #White, 1, 1)
result=DrawText_EX(830, 10, txt$, #Black, #White, 0, 2)
result=DrawText_EX(830, result+40, txt$, #Black, #White, 2, 2)
DrawText_EX(830, result+40, txt$, #Black, #White, 1, 2)
DrawText_EX(1170, 10, "Stretching available", #Red, #White, 3, 0, 0, 8)
StopDrawing()
; PresetLineWidth_EX(300) ; This preset the min output length, try simple how it works
DrawText_EX_AutoBox(-1, $FF)
CompilerIf #PB_Compiler_OS=#PB_OS_MacOS
DrawText_EX_Box(1, $FF00, -15, -15, 414, 110)
CompilerElse
DrawText_EX_Box(1, $FF00, -15, -15, 420, 101)
CompilerEndIf
txt2$="A very nice Tool"+#LF$+"DrawText_EX"+#LF$+"Simple a little more"
For i=0 To 15 Step 2
StartDrawing(CanvasOutput(canvas_ID))
DrawingFont(FontID(font_ID))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText_EX(400, win_h-135, txt2$, #Black, #White, 1, 0, i, 10)
StopDrawing()
While WindowEvent() : Wend
Delay(120)
Next i
txt2$="This is a output as image"+#LF$+"For nice resizing"+#LF$+"Using as sprite"+#LF$+
"Or many other things"+#LF$+"BucketFill advanced handle images"+#LF$+
"as sprites with phantastic abilities"+#LF$+"This tool is a part from BF"
image_ID=DrawTextCreateImage_EX(txt2$, #White, #Blue, 1, 0, font_ID, 2, 2, -1)
CompilerIf #PB_Compiler_Version<560 ; Without canvas container function
If IsImage(image_ID)
StartDrawing(CanvasOutput(canvas_ID))
DrawImage(ImageID(image_ID), 30, win_h-180)
ResizeImage(image_ID, 200, 95)
DrawImage(ImageID(image_ID), 910, win_h-150)
StopDrawing()
EndIf
CompilerElse
If IsImage(image_ID)
ImageGadget(#PB_Any, 30, win_h-180, 0, 0, ImageID(image_ID), #PB_Image_Raised)
ResizeImage(image_ID, 200, 95)
ImageGadget(#PB_Any, 910, win_h-150, 0, 0, ImageID(image_ID), #PB_Image_Raised)
EndIf
CompilerEndIf
While WaitWindowEvent()<>#PB_Event_CloseWindow : Wend
CompilerEndIf
