Their's 2 way of display some text :
Direct display of a raw text (not effect allowed)
Or with the box system. Create a box then add it some text, somme effect like shaking wave, blink or color blink can be add with tag in you string like "bla bla bla ${shake} BLAAAAA {\} bla bla".
I don't know if that's realy optimised... But well I think i did my best.
Here a preview :
And the code :
The generator named : "Awesome bitmapFont Generator" (Hell yeah !)
Code: Select all
EnableExplicit
UsePNGImageEncoder()
UseLZMAPacker()
Enumeration
#Str_Char
#Btn_Font
#Btn_Generate
#Btn_Refresh
#Btn_Load
#Txt_Font
#Cnv_Sample
;------------------Setting window----------
#Cmb_Font
#Chk_Bold
#Chk_Italic
#Chk_StrikeOut
#Chk_Shadow
#Btn_Color
#Btn_ShadowColor
#Btn_BackgroundColor
#Str_Alpha
#Str_OffsetX
#Str_OffsetY
#Str_Size
#Str_MargeUp
#Str_MargeDown
#Str_MargeLeft
#Str_MargeRight
#Lst_Size
#Cnv_Preview
EndEnumeration
Enumeration
#Window_Main
#Window_Font
EndEnumeration
Structure Font
Name.s
Size.c
Shadow.a
ShadowX.a
ShadowY.a
Color.i
ShadowColor.i
BackGroundColor.i
FntAlpha.a
ShadowAlpha.a
String.s
Height.c
Width.c
Flag.i
MargeUp.C
MargeDown.c
MargeLeft.c
MargeRight.c
MaxValue.c
EndStructure
Structure Char
X.i
Y.i
Width.i
Height.i
EndStructure
Structure CFP_FONTDATA
Type.b
Symbol.b
Name.s
EndStructure
Structure CFP_USERDATA
himlFontType.i
FontSize.b
hwndParent.i
EndStructure
Declare OpenMainWindow()
Declare OpenFontWindow()
Declare RefreshSample()
Declare GenerateFont()
Declare Loadfnt()
Declare Close()
Declare ChangeSize()
Declare ChangeColor()
Declare Style()
Declare Shadow()
Declare ShadowAlpha()
Declare Offset()
Declare Marging()
Declare RefreshPreview()
Declare Load()
;----------------CFP fonctions declaration---------------------------
Declare CFP_CreateGagdet(Gadget,X,Y,Width,Height,ItemHeight=20,FontSize=11)
Declare.s CFP_GetGadgetText(Gadget,Item)
Declare CFP_FreeGadget(Gadget)
Declare CFP_EnumFonts(Gadget)
Declare CFP_EnumProc(*lpelfe.ENUMLOGFONTEX,*lpntme.NEWTEXTMETRICEX,FontType,lParam)
Declare CFP_WndProc(hWnd,uMsg,wParam,lParam)
Declare CFP_Change()
Global Font.font, FntList.LOGFONT
Global NewList ftd.CFP_FONTDATA()
With Font
\Name = "Arial"
\String = "!"+Chr(34)+"# $%&'()*+,-./0123456789:;<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюяЄІЇЎҐєіїўґÄäÀàÂâÁáÃãÅåÆæÈèÊêÉéÇçĞğÎîÍíİıÑñÖöÒòÔôÓóÕõŒœØøŞşÜüÙùÛûÚúŸÿ¿¡ßŐőŰű"
\Size = 72
\Shadow = 0
\ShadowX = 5
\ShadowY = 5
\ShadowAlpha = 128
\Color = RGBA(255,255,255,255)
\ShadowColor = RGBA(0,0,0,128)
\BackGroundColor = RGB(204,204,204)
\FntAlpha = 255
EndWith
OpenMainWindow()
Repeat : WaitWindowEvent() : ForEver
Procedure OpenMainWindow()
If OpenWindow(#Window_Main,0,0,1200,768,"Awesome bitmapFont Generator",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
StringGadget(#Str_Char,10,10,1100,50,Font\String)
ButtonGadget(#Btn_Refresh,1130,10,60,20,"Refresh")
ButtonGadget(#Btn_Font,10,80,40,20,"Font")
ButtonGadget(#Btn_Load,650,80,60,20,"Load")
TextGadget(#Txt_Font,60,80,500,20,Font\Name+","+Font\Size,#PB_Text_Border)
CanvasGadget(#Cnv_Sample,10,110,1180,628)
ButtonGadget(#Btn_Generate,580,80,60,20,"Save")
BindEvent(#PB_Event_CloseWindow,@Close())
BindGadgetEvent(#Btn_Font,@OpenFontWindow())
BindGadgetEvent(#Btn_Refresh,@RefreshSample())
BindGadgetEvent(#Btn_Generate,@GenerateFont())
BindGadgetEvent(#Btn_Load,@Load())
RefreshSample()
EndIf
EndProcedure
Procedure OpenFontWindow()
Protected FontLoop
If OpenWindow(#Window_Font,0,0,800,400,"Configure font",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
TextGadget(#PB_Any,10,10,100,20,"Font :")
TextGadget(#PB_Any,340,10,100,20,"Style :")
TextGadget(#PB_Any,460,10,100,20,"Size :")
CFP_CreateGagdet(#Cmb_Font,10,40,300,24)
CheckBoxGadget(#Chk_Bold,340,40,80,20,"Bold")
CheckBoxGadget(#Chk_Italic,340,70,80,20,"Italic")
CheckBoxGadget(#Chk_StrikeOut,340,100,80,20,"StrikeOut")
StringGadget(#Str_Size,460,40,150,20,Str(Font\Size),#PB_String_Numeric)
ListViewGadget(#Lst_Size,460,60,150,60)
TextGadget(#PB_Any,10,150,100,20,"Text color")
CheckBoxGadget(#Chk_Shadow,10,170,100,20,"Shadow color")
TextGadget(#PB_Any,200,150,100,20,"Background color")
TextGadget(#PB_Any,630,40,40,20,"Padding")
StringGadget(#Str_MargeUp,700,40,30,20,Str(Font\MargeUp),#PB_String_Numeric)
StringGadget(#Str_MargeLeft,665,65,30,20,Str(Font\MargeLeft),#PB_String_Numeric)
StringGadget(#Str_MargeDown,700,90,30,20,Str(Font\MargeDown),#PB_String_Numeric)
StringGadget(#Str_MargeRight,735,65,30,20,Str(Font\MargeRight),#PB_String_Numeric)
TextGadget(#PB_Any,700,65,30,20,"A",#PB_Text_Border|#PB_Text_Center)
CreateImage(0,30,20)
CreateImage(1,30,20)
CreateImage(2,30,20)
StartDrawing(ImageOutput(0))
Box(0,0,30,20,Font\Color)
StopDrawing()
StartDrawing(ImageOutput(1))
Box(0,0,30,20,Font\ShadowColor)
StopDrawing()
StartDrawing(ImageOutput(2))
Box(0,0,30,20,Font\BackGroundColor)
StopDrawing()
ButtonImageGadget(#Btn_Color,150,150,30,20,ImageID(0))
ButtonImageGadget(#Btn_ShadowColor,150,170,30,20,ImageID(1))
ButtonImageGadget(#Btn_BackgroundColor,300,150,30,20,ImageID(2))
TextGadget(#PB_Any,220,170,40,20,"Alpha :")
StringGadget(#Str_Alpha,300,170,40,20,Str(Font\ShadowAlpha),#PB_String_Numeric)
TextGadget(#PB_Any,370,170,40,20,"OffestX :")
StringGadget(#Str_OffsetX,450,170,40,20,Str(Font\ShadowX),#PB_String_Numeric)
TextGadget(#PB_Any,520,170,40,20,"OffsetY :")
StringGadget(#Str_OffsetY,600,170,40,20,Str(Font\ShadowY),#PB_String_Numeric)
CanvasGadget(#Cnv_Preview,10,200,780,180)
For FontLoop = 0 To 14
AddGadgetItem(#Lst_Size,-1,Str(32+FontLoop*8))
Next FontLoop
If Font\Shadow
SetGadgetState(#Chk_Shadow,#PB_Checkbox_Checked)
EndIf
BindGadgetEvent(#Chk_Bold,@Style())
BindGadgetEvent(#Chk_Italic,@Style())
BindGadgetEvent(#Chk_StrikeOut,@Style())
BindGadgetEvent(#Chk_Shadow,@Shadow())
BindGadgetEvent(#Lst_Size,@ChangeSize(),#PB_EventType_LeftClick)
BindGadgetEvent(#Str_Size,@ChangeSize(),#PB_EventType_Change)
BindGadgetEvent(#Btn_Color,@ChangeColor())
BindGadgetEvent(#Btn_ShadowColor,@ChangeColor())
BindGadgetEvent(#Btn_BackgroundColor,@ChangeColor())
BindGadgetEvent(#Str_Alpha,@ShadowAlpha(),#PB_EventType_Change)
BindGadgetEvent(#Str_OffsetX,@Offset(),#PB_EventType_Change)
BindGadgetEvent(#Str_OffsetY,@Offset(),#PB_EventType_Change)
BindGadgetEvent(#Str_MargeDown,@Marging(),#PB_EventType_Change)
BindGadgetEvent(#Str_MargeLeft,@Marging(),#PB_EventType_Change)
BindGadgetEvent(#Str_MargeRight,@Marging(),#PB_EventType_Change)
BindGadgetEvent(#Str_MargeUp,@Marging(),#PB_EventType_Change)
RefreshPreview()
EndIf
EndProcedure
Procedure Load()
Protected File$, *Buffer
File$ = OpenFileRequester("Load file",GetCurrentDirectory(),"Font file(*.afg) | *.afg",0)
If File$
OpenPack(0,File$,#PB_PackerPlugin_Lzma )
ExaminePack(0)
NextPackEntry(0)
*Buffer = AllocateMemory(PackEntrySize(0))
UncompressPackMemory(0,*Buffer,MemorySize(*Buffer),PackEntryName(0))
ClosePack(0)
CatchJSON(0,*Buffer,MemorySize(*Buffer))
ExtractJSONStructure(JSONValue(0),@Font,Font)
FreeMemory(*Buffer)
RefreshSample()
EndIf
EndProcedure
Procedure GenerateFont()
Font\String = GetGadgetText(#Str_Char)
Protected X = Font\Width * 14, Y = Font\Height * Round((Len(Font\String)/14),#PB_Round_Up)
Protected Img, LoopX, LoopY,OffsetX,OffsetY, JsonData, *Buffer,JsonSize,Temp$
Protected NewMap Charset.char()
X + 14 * (Font\MargeLeft+Font\MargeRight)
Y + Round((Len(Font\String)/14),#PB_Round_Up) * (Font\MargeUp+Font\MargeDown)
img = CreateImage(#PB_Any,X,Y,32,#PB_Image_Transparent)
If img
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
DrawingFont(FontID(0))
For Loopy = 0 To Y/Font\Height-1
For LoopX = 0 To 14
If Font\Shadow
DrawText(LoopX * Font\Width + Font\ShadowX + (LoopX+1)* Font\MargeLeft + LoopX * Font\MargeRight , LoopY * Font\Height + Font\ShadowY + (LoopY+1) * Font\MargeUp + LoopY * Font\MargeDown, Mid(Font\String,(LoopX+1)+LoopY * 14,1),Font\ShadowColor)
OffsetX = Font\ShadowX
OffsetY = Font\ShadowY
Else
OffsetX = 0 : OffsetY = 0
EndIf
DrawText(LoopX * Font\Width + (LoopX+1)* Font\MargeLeft + LoopX * Font\MargeRight, LoopY * Font\Height + (LoopY+1) * Font\MargeUp + LoopY * Font\MargeDown, Mid(Font\String,(LoopX+1)+LoopY * 14,1),Font\Color)
If Not Mid(Font\String,(LoopX+1)+LoopY * 14,1) = ""
Temp$ = Mid(Font\String,(LoopX+1)+LoopY * 14,1)
If PeekC(@Temp$) > Font\MaxValue
Font\MaxValue = PeekC(@Temp$)
EndIf
Charset(Mid(Font\String,(LoopX+1)+LoopY * 14,1))\X = LoopX * Font\Width + (LoopX+1)* Font\MargeLeft + LoopX * Font\MargeRight
Charset()\Y = LoopY * Font\Height + (LoopY+1) * Font\MargeUp + LoopY * Font\MargeDown
Charset()\Height = TextHeight(Mid(Font\String,(LoopX+1)+LoopY * 14,1))+OffsetX + (LoopX+1)* Font\MargeLeft + LoopX * Font\MargeRight
Charset()\Width = TextWidth(Mid(Font\String,(LoopX+1)+LoopY * 14,1))+OffsetY + (LoopY+1) * Font\MargeUp + LoopY * Font\MargeDown
EndIf
Next LoopX
Next LoopY
StopDrawing()
CreateJSON(0)
InsertJSONStructure(JSONValue(0),@Font,Font)
JsonData = AddJSONMember(JSONValue(0),"Chardata")
InsertJSONMap(JsonData,Charset())
*Buffer = AllocateMemory(ExportJSONSize(0))
ExportJSON(0,*Buffer,MemorySize(*Buffer))
CreatePack(0,Font\Name+".afg",#PB_PackerPlugin_Lzma)
AddPackMemory(0,*Buffer,MemorySize(*Buffer),Font\Name+".json")
FreeMemory(*Buffer)
*Buffer = EncodeImage(img,#PB_ImagePlugin_PNG)
AddPackMemory(0,*Buffer,MemorySize(*Buffer),Font\Name+".png")
FreeMemory(*Buffer)
ClosePack(0)
FreeImage(img)
FreeJSON(0)
MessageRequester("Awesome bitmapFont Generator","Font succefully generated")
ProcedureReturn #True
EndIf
MessageRequester("Awesome bitmapFont Generator","An error has ocurred...")
EndProcedure
Procedure RefreshSample()
Protected LoopX,LoopY, x, y, str$ = GetGadgetText(#Str_Char)
Loadfnt()
StartDrawing(CanvasOutput(#Cnv_Sample))
Box(0,0,1180,628,Font\BackGroundColor)
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
Font\Height = TextHeight("A")
Font\Width = TextWidth("A")+30
x = 1180/Font\Width +1
y = 628 / Font\Height
For LoopY = 0 To y
For LoopX = 0 To x
If Font\Shadow
DrawText(LoopX * Font\Width + Font\ShadowX,LoopY * Font\Height + Font\ShadowY,Mid(str$,LoopX + LoopY * x+1,1),Font\ShadowColor)
EndIf
DrawText(LoopX * Font\Width,LoopY * Font\Height,Mid(str$,LoopX + LoopY * x+1,1),Font\Color)
Next LoopX
Next LoopY
StopDrawing()
EndProcedure
Procedure ChangeSize()
If EventGadget() = #Lst_Size
SetGadgetText(#Str_Size,GetGadgetText(#Lst_Size))
EndIf
font\Size = Val(GetGadgetText(#Str_Size))
Loadfnt()
RefreshPreview()
EndProcedure
Procedure Loadfnt()
LoadFont(0,Font\Name,font\Size,Font\Flag)
EndProcedure
Procedure Marging()
Select EventGadget()
Case #Str_MargeDown
Font\MargeDown = Val(GetGadgetText(#Str_MargeDown))
Case #Str_MargeLeft
Font\MargeLeft = Val(GetGadgetText(#Str_MargeLeft))
Case #Str_MargeRight
Font\MargeRight = Val(GetGadgetText(#Str_MargeRight))
Case #Str_MargeUp
Font\MargeUp = Val(GetGadgetText(#Str_MargeUp))
EndSelect
EndProcedure
Procedure ChangeColor()
Protected Color
If EventGadget() = #Btn_Color
Color = ColorRequester(font\Color)
If Not Color = -1
Font\Color = RGBA(Red(Color),Green(Color),Blue(Color),255)
StartDrawing(ImageOutput(0))
Box(0,0,30,20,Color)
StopDrawing()
EndIf
ElseIf EventGadget() = #Btn_ShadowColor
Color = ColorRequester(font\ShadowColor)
If Not Color = -1
Font\ShadowColor = RGBA(Red(Color),Green(Color),Blue(Color),Val(GetGadgetText(#Str_Alpha)))
StartDrawing(ImageOutput(1))
Box(0,0,30,20,Color)
StopDrawing()
EndIf
Else
Color = ColorRequester(Font\BackGroundColor)
If Not Color = -1
Font\BackGroundColor = Color
StartDrawing(ImageOutput(2))
Box(0,0,30,20,Color)
StopDrawing()
EndIf
EndIf
If Not Color = -1
RefreshPreview()
EndIf
EndProcedure
Procedure Style()
font\Flag = 0
If GetGadgetState(#Chk_Bold) = #PB_Checkbox_Checked
Font\Flag | #PB_Font_Bold
EndIf
If GetGadgetState(#Chk_Italic) = #PB_Checkbox_Checked
Font\Flag | #PB_Font_Italic
EndIf
If GetGadgetState(#Chk_StrikeOut) = #PB_Checkbox_Checked
Font\Flag | #PB_Font_StrikeOut
EndIf
Loadfnt()
RefreshPreview()
EndProcedure
Procedure Offset()
Font\ShadowX = Val(GetGadgetText(EventGadget()))
RefreshPreview()
EndProcedure
Procedure ShadowAlpha()
Font\ShadowAlpha = Val(GetGadgetText(#Str_Alpha))
Font\ShadowColor = RGBA(Red(Font\ShadowColor),Green(Font\ShadowColor),Blue(Font\ShadowColor),Font\ShadowAlpha)
RefreshPreview()
EndProcedure
Procedure Shadow()
If GetGadgetState(#Chk_Shadow) = #PB_Checkbox_Checked
Font\Shadow = 1
Else
Font\Shadow = 0
EndIf
RefreshPreview()
EndProcedure
Procedure RefreshPreview()
StartDrawing(CanvasOutput(#Cnv_Preview))
Box(0,0,780,180,Font\BackGroundColor)
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
DrawingFont(FontID(0))
If Font\Shadow
DrawText(10+Font\ShadowX,10+Font\ShadowY,"The quick brown fox jumped over the lazy dog.",Font\ShadowColor)
EndIf
DrawText(10,10,"The quick brown fox jumped over the lazy dog.",Font\Color)
StopDrawing()
EndProcedure
Procedure Close()
If GetActiveWindow() = #Window_Main
End
Else
CFP_FreeGadget(101)
CloseWindow(#Window_Font)
FreeImage(0)
FreeImage(1)
FreeImage(2)
SetGadgetText(#Txt_Font,Font\Name+","+Font\Size)
RefreshSample()
EndIf
EndProcedure
;===============================================================
;Display font with style & icon ================================
; Title: Font Preview ComboBox =================================
; Author: Fluid Byte ===========================================
; Platform: Windows ============================================
; Created: Jan 27, 2009 ========================================
; Updated: May 29, 2017 ========================================
; E-Mail: fluidbyte@web.de =====================================
;http://forums.purebasic.com/english/viewtopic.php?f=12&t=36198=
;===============================================================
Procedure CFP_Change()
Font\Name = CFP_GetGadgetText(#Cmb_Font,GetGadgetState(#Cmb_Font))
Loadfnt()
RefreshPreview()
EndProcedure
Procedure CFP_CreateGagdet(Gadget,X,Y,Width,Height,ItemHeight=20,FontSize=11)
Protected himlFontType, hwndParent, *cfpu.CFP_USERDATA
himlFontType = ImageList_Create_(16,12,#ILC_MASK,0,0)
ImageList_AddMasked_(himlFontType,CatchImage(0,?FontType),#Yellow)
hwndParent = GadgetID(ContainerGadget(#PB_Any,X,Y,Width,Height))
ComboBoxGadget(Gadget,0,0,Width,Height,#CBS_OWNERDRAWFIXED)
SendMessage_(GadgetID(Gadget),#CB_SETITEMHEIGHT,0,ItemHeight)
CloseGadgetList()
*cfpu = AllocateMemory(SizeOf(CFP_USERDATA))
*cfpu\himlFontType = himlFontType
*cfpu\FontSize = FontSize
*cfpu\hwndParent = hwndParent
SetWindowLongPtr_(GadgetID(Gadget),#GWLP_USERDATA,*cfpu)
SetWindowLongPtr_(hwndParent,#GWL_WNDPROC,@CFP_WndProc())
CFP_EnumFonts(Gadget)
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure.s CFP_GetGadgetText(Gadget,Item)
If IsGadget(Gadget)
Protected *cfpf.CFP_FONTDATA
*cfpf = GetGadgetItemData(Gadget,Item)
ProcedureReturn *cfpf\Name
EndIf
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure CFP_FreeGadget(Gadget)
If IsGadget(Gadget)
Protected *cfpu.CFP_USERDATA, Result
*cfpu = GetWindowLongPtr_(GadgetID(Gadget),#GWLP_USERDATA)
If *cfpu
Result = ImageList_Destroy_(*cfpu\himlFontType)
If Result : Result = FreeMemory(*cfpu) : EndIf
EndIf
EndIf
ProcedureReturn Result
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure CFP_WndProc(hWnd,uMsg,wParam,lParam)
Select uMsg
Case #WM_COMMAND
Select (wParam >> 16) & $ffff
Case #CBN_SELCHANGE
CFP_Change()
EndSelect
Case #WM_DRAWITEM
Protected *lpdis.DRAWITEMSTRUCT = lParam
; --- Draw item focus rectangle or normal state
If *lpdis\itemState & #ODS_SELECTED
Protected hbrFocus = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
FillRect_(*lpdis\hDC,*lpdis\rcItem,hbrFocus)
DeleteObject_(hbrFocus)
DrawFocusRect_(*lpdis\hDC,*lpdis\rcItem)
SetTextColor_(*lpdis\hDC,GetSysColor_(#COLOR_HIGHLIGHTTEXT))
Else
Protected hbrFace = CreateSolidBrush_(GetSysColor_(#COLOR_WINDOW))
FillRect_(*lpdis\hDC,*lpdis\rcItem,hbrFace)
DeleteObject_(hbrFace)
SetTextColor_(*lpdis\hDC,GetSysColor_(#COLOR_WINDOWTEXT))
EndIf
Protected *ftd.CFP_FONTDATA = GetGadgetItemData(wParam,*lpdis\itemID)
Protected *cfpu.CFP_USERDATA = GetWindowLongPtr_(*lpdis\hwndItem,#GWLP_USERDATA)
; --- Draw Font Icons
If *ftd\Type > -1
ImageList_Draw_(*cfpu\himlFontType,*ftd\Type,*lpdis\hDC,2,*lpdis\rcItem\top + 3,#ILD_TRANSPARENT)
EndIf
; --- Create Preview Font
Protected lplf.LOGFONT, hfntPreview
lplf\lfHeight = -MulDiv_(*cfpu\FontSize,GetDeviceCaps_(*lpdis\hDC,#LOGPIXELSY),72)
If *ftd\Symbol : lplf\lfCharSet = #SYMBOL_CHARSET : EndIf
PokeS(@lplf\lfFaceName,*ftd\name)
hfntPreview = CreateFontIndirect_(lplf)
; --- Draw Preview Text
SetBkMode_(*lpdis\hDC,#TRANSPARENT)
If *ftd\Symbol ; If it's a smybol font like Webdings
Protected fsz.SIZE
; Write the fonts name
*lpdis\rcItem\left + 20
SelectObject_(*lpdis\hDC,GetStockObject_(#DEFAULT_GUI_FONT))
GetTextExtentPoint32_(*lpdis\hDC,*ftd\Name,Len(*ftd\Name),fsz)
DrawText_(*lpdis\hDC,*ftd\Name,-1,*lpdis\rcItem,#DT_SINGLELINE | #DT_VCENTER)
; Display demo charachters next to the name
*lpdis\rcItem\left + fsz\cx + 3
SelectObject_(*lpdis\hDC,hfntPreview)
DrawText_(*lpdis\hDC,"ABC123",6,*lpdis\rcItem,#DT_SINGLELINE | #DT_VCENTER)
Else
*lpdis\rcItem\left + 20
SelectObject_(*lpdis\hDC,hfntPreview)
DrawText_(*lpdis\hDC,*ftd\Name,-1,*lpdis\rcItem,#DT_SINGLELINE | #DT_VCENTER)
EndIf
DeleteObject_(hfntPreview)
ProcedureReturn #True
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure CFP_EnumFonts(Gadget)
Protected lplf.LOGFONT, hdc, Index, start
lplf\lfCharset = #DEFAULT_CHARSET
hdc = GetDC_(0)
EnumFontFamiliesEx_(hdc,lplf,@CFP_EnumProc(),hdc,0)
ReleaseDC_(0,hdc)
SortStructuredList(ftd(),#PB_Sort_Ascending,OffsetOf(CFP_FONTDATA\Name),#PB_String)
ForEach ftd()
AddGadgetItem(Gadget,-1,ftd()\Name)
If ftd()\Name = Font\Name
start = Index
EndIf
SetGadgetItemData(Gadget,Index,ftd())
Index + 1
Next
SetGadgetState(Gadget,start)
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure CFP_EnumProc(*lpelfe.ENUMLOGFONTEX,*lpntme.NEWTEXTMETRICEX,FontType,lParam)
Protected CHRSET = *lpelfe\elfLogFont\lfCharSet & 255
; WESTERN FONTS / SYSTEM FONTS / SYMBOL FONTS
If Not Left(PeekS(@*lpelfe\elfLogFont\lfFaceName),1) = "@"
If CHRSET = #ANSI_CHARSET Or CHRSET = #OEM_CHARSET Or CHRSET = #SYMBOL_CHARSET
AddElement(ftd())
Select FontType
Case #TRUETYPE_FONTTYPE : ftd()\Type = 0
Case #DEVICE_FONTTYPE : ftd()\Type = 1
Case #RASTER_FONTTYPE : ftd()\Type = 2
Default : ftd()\Type = -1
EndSelect
If CHRSET = #SYMBOL_CHARSET : ftd()\Symbol = 1 : EndIf
; Using 'lfFaceName' of the LOGFONT structure gives unique fontnames and avoids dublicates.
; When using 'elfFullName' of the ENUMLOGFONTEX structure you still can get dublicates even
; though you limit the character set like above. Also you don't need to cycle through the
; whole LinkedList everytime to find out if a fontname already exists.
;
; The created fontlist SHOULD be identical to the one in MS Wordpad + bitmap fonts (Courier, etc.)
ftd()\Name = PeekS(@*lpelfe\elfLogFont\lfFaceName)
EndIf
EndIf
ProcedureReturn #True
EndProcedure
DataSection
FontType:
Data.l $01964D42,$00000000,$00760000,$00280000,$00300000,$000C0000,$00010000,$00000004,$01200000,$00000000
Data.l $00000000,$00000000,$00000000,$00000000,$00000000,$80000080,$80000000,$00800080,$00800000,$80800080
Data.l $80800000,$C0C00080,$000000C0,$FF0000FF,$FF000000,$00FF00FF,$00FF0000,$FFFF00FF,$FFFF0000,$BBBB00FF
Data.l $5555BBBB,$BBBBBB55,$BB7B77B8,$B9BBBBBB,$97B97B99,$BBBBBBBB,$55BBBBBB,$BBBBBBBB,$8B868870,$99BBBBBB
Data.l $79999799,$BBBBBBBB,$55BBBBBB,$B8BBBBBB,$68B8BB00,$99BBBBBB,$B799797B,$BBBBBB9B,$55666666,$B8BBBBBB
Data.l $76BBBB00,$99BBBB8B,$7B99B77B,$BBBBBBBB,$55BB66BB,$B8BBBBBB,$86BBBB00,$99BBBB6B,$9B79BB7B,$BBBBBBBB
Data.l $55BB65BB,$B8BB5BBB,$B6BB8B00,$79BBBB68,$97B9BB9B,$BBBBBBBB,$55BB65BB,$BBBB5BBB,$B6BB7B00,$B9BBBB68
Data.l $99B7BB97,$BBBBBBBB,$555B65BB,$BBBB5BB5,$B7BB0B70,$B7BBBB66,$99BBBB99,$B6BBBB7B,$555565BB,$BBBB5B55
Data.l $B7BB08B0,$BBBBBB68,$79BB9B79,$B6BBBB9B,$6BBB66BB,$BBBBBBBB,$B7BB00B8,$BBBBBB68,$79BB99B7,$B6BBBB97
Data.l $6BB6666B,$BBBBBBBB,$867880BB,$BBBBBB6B,$9799B9BB,$B6BBBB79,$6B666666,$BBBBBBBB,$6887BBBB,$BBBBBBBB
Data.l $BBBBBBBB
Data.b $BB,$BB
EndDataSection
Code: Select all
DeclareModule PureBF
Declare LoadBitmapFont(File$) ;Return the generated number on success, 0 otherwise.
Declare CatchBitmapFont(*MemoryAddress,Size) ;Return the generated number on success, 0 otherwise. (Need to write file in temp directory... Not sure this is the best way, probably not a secure to use fonction)
Declare DisplayText(*Font,X,Y,Text$,Zoom.f,Opacity,Color=#PB_Default) ;Fast display a raw text, no tag can or effect can be use. #CR$ or #CRLF$ character can be use for carriage return.
Declare GetTextWidth(*Font,Text$,Zoom.f) ;Return the width of a text displayed with DisplayText() function.
Declare GetTextHeight(*Font,Text$,Zoom.f) ;Return the height of a text displayed with DisplayText() function.
Declare CreateTextBox(X,Y,Width,Height,Flag=0) ;Create a new empty text box. Return the generated number. Flag use PB's text constante (#PB_Text_Center | #PB_Text_Right)
Declare FreeTextBox(*TextBox) ;Delete a text box and all the text contained.
Declare DisplayTextBox(*TextBox) ;Display the text box and process the effect is needed.
Declare AddTextBoxString(*TextBox,*Font,String$,Zoom.f,Opacity,Color=#PB_Default) ;Add a string to the TextBox, String will be add after the previous one.
Declare AddTextBoxStringN(*TextBox,*Font,String$,Zoom.f,Opacity,Color=#PB_Default) ;Add a string to the TextBox followed by a carriage return charactere.
Declare SetShakeAttribut(Speed.f,Target.f) ;Set the shake effect speed and target. (Target is the delta in pixel letters will move, Speed in pixel).
Declare SetWaveAttribut(Speed.f,Target.f) ;Set the Wave effect speed and target. (Target is the delta in pixel letters will move, Speed in pixel).
Declare SetBlinkSpeed(Speed) ;Blink effect will switch status every #Speed frames.
Declare SetBlinkColor(Color)
Declare SetRainbowAttribut(Speed.f,RStep.f) ;Set the Rainbow effect speed and color gap between each letters.
Declare.f GetShakeSpeed()
Declare.f GetWaveSpeed()
Declare.f GetShakeTarget()
Declare.f GetWaveTarget()
Declare GetBlinkSpeed()
Declare GetBlinkColor()
Declare.f GetRainbowSpeed()
Declare.f GetRainbowStep()
Declare.f GetTextBoxX(*TextBox)
Declare.f GetTextBoxY(*TextBox)
Declare MoveTextBox(*TextBox,X,Y,Mode = #PB_Absolute)
EndDeclareModule
Module PureBF
#PBF_Compatibility = 0 ; 0 Mean faster render time but Unicode only and require low memory acces. /!\ Requesting to display a charactere unavaliable in the font can result in a crash /!\
; 1 Mean slower render time but compatible with every text mode and SpiderBasic
; Compatibility set to 1 can have faster render time with short text especialy on hardware with slow memory acces
;--------- Declaration-------------------------------------------------
EnableExplicit
UsePNGImageDecoder()
UseLZMAPacker()
;{ Structures
Structure Font
Name.s
Size.c
Shadow.a
ShadowX.a
ShadowY.a
Color.i
ShadowColor.i
BackGroundColor.i
FntAlpha.a
ShadowAlpha.a
String.s
Height.c
Width.c
Flag.i
MargeUp.C
MargeDown.c
MargeLeft.c
MargeRight.c
MaxValue.c
EndStructure
Structure Char
X.i
Y.i
Width.i
Height.i
EndStructure
Structure BitmapFont
Sprite.i
FontInto.Font
CompilerIf #PBF_Compatibility = 0
Array CharInfo.Char(1)
CompilerElse
Map MapInfo.Char()
CompilerEndIf
EndStructure
Structure Shake
Enable.a
Speed.f
Target.c
Delta.f
EndStructure
Structure Wave
Enable.a
Speed.f
Target.c
Delta.f
EndStructure
Structure Blink
Enable.a
Speed.i
Count.i
Color.i
State.a
EndStructure
Structure Rainbow
Enable.a
Speed.f
RainbowStep.f
Delta.f
EndStructure
Structure TextList
Line.c
Text.s
X.i
Y.i
Color.i
Opacity.a
Zoom.f
ClipHeight.i
*Font.BitmapFont
Shake.Shake
Wave.Wave
Blink.Blink
Rainbow.Rainbow
EndStructure
Structure TextBox
X.f
Y.f
CursorX.i
CursorY.i
CurentLine.c
Width.i
Height.i
Flag.a
List Text.TextList()
EndStructure
;} End structures
; Variables
Global ShakeSpeed.f=2, WaveSpeed.f=0.15, ShakeTarget.f=2, WaveTarget.f=5, BlinkSpeed = 30, BlinkColor, RainbowSpeed.f = 0.04, RainbowStep.f = 0.1
Global NewList TextBoxList.TextBox()
;{Procedures
Declare AddTextToBox(*TextBox,*Font,Text$,Shake,Wave,Blink,ColorBlink,Rainbow,Zoom.f,Opacity,Color)
Declare AligneText(*TextBox)
Declare AddLineToBox(*TextBox)
Declare SetShake(*TextBox)
Declare SetWave(*TextBox)
Declare SetBlink(*TextBox)
Declare SetColorBlink(*TextBox)
Declare SetRainbow(*TextBox)
Declare MakeShake(*TextBox)
Declare MakeWave(*TextBox,Delta)
Declare MakeBlink(*textBox)
Declare MakeRainbow(*TextBox,Delta)
; }
;---------End Declaration-----------------------------------------------
;---------Public Procedures---------------------------------------------
Procedure LoadBitmapFont(File$) ;LoadBitmapFont function for PureBasic only
Protected *PackBuffer, *Return.BitmapFont,Loop, LoopMax, Temp$
CompilerIf #PBF_Compatibility = 0
Protected NewMap MapInfo.Char()
CompilerEndIf
If OpenPack(0,File$,#PB_PackerPlugin_Lzma)
ExaminePack(0)
NextPackEntry(0)
*PackBuffer = AllocateMemory(PackEntrySize(0))
UncompressPackMemory(0,*PackBuffer,MemorySize(*PackBuffer),PackEntryName(0))
*Return = AllocateMemory(SizeOf(BitmapFont))
InitializeStructure(*Return,BitmapFont)
CatchJSON(0,*PackBuffer,MemorySize(*PackBuffer))
ExtractJSONStructure(JSONValue(0),*Return\FontInto,Font)
ExamineJSONMembers(JSONValue(0))
While NextJSONMember(JSONValue(0))
If JSONMemberKey(JSONValue(0)) = "Chardata"
CompilerIf #PBF_Compatibility = 0
ExtractJSONMap(JSONMemberValue(JSONValue(0)),MapInfo())
CompilerElse
ExtractJSONMap(JSONMemberValue(JSONValue(0)),*Return\MapInfo())
CompilerEndIf
EndIf
Wend
FreeMemory(*PackBuffer)
NextPackEntry(0)
*PackBuffer = AllocateMemory(PackEntrySize(0))
UncompressPackMemory(0,*PackBuffer,MemorySize(*PackBuffer))
*Return\Sprite = CatchSprite(#PB_Any,*PackBuffer,#PB_Sprite_AlphaBlending)
FreeMemory(*PackBuffer)
ClosePack(0)
*Return\FontInto\Width / 2
CompilerIf #PBF_Compatibility = 0
ReDim *Return\CharInfo(*Return\FontInto\MaxValue)
LoopMax = Len(*Return\FontInto\String)
For Loop = 1 To LoopMax
Temp$ = Mid(*Return\FontInto\String,Loop,1)
If FindMapElement(MapInfo(),Temp$)
CopyStructure(@MapInfo(),@*Return\CharInfo(PeekC(@Temp$)),Char)
EndIf
Next Loop
FreeMap(MapInfo())
CompilerEndIf
ProcedureReturn *Return
EndIf
ProcedureReturn #False
EndProcedure
Procedure CatchBitmapFont(*Memory,Size)
Protected *Return.Font
If CreateFile(0,GetTemporaryDirectory()+"PureBFTemp")
WriteData(0,*Memory,Size)
CloseFile(0)
*Return = LoadBitmapFont(GetTemporaryDirectory()+"PureBFTemp")
If *Return
DeleteFile(GetTemporaryDirectory()+"PureBFTemp")
ProcedureReturn *Return
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure DisplayText(*Font.BitmapFont,X,Y,Text$,Zoom.f,Opacity,Color=#PB_Default)
Protected loop,loopmax = Len(text$),DeltaX
CompilerIf #PBF_Compatibility = 0
Protected Index
loopmax - 1
For loop = 0 To loopmax
Index = PeekC(@Text$+(loop)*2)
If Index = #LF
DeltaX = 0 : Y + *Font\FontInto\Height * Zoom
Else
ClipSprite(*Font\Sprite,*Font\CharInfo(Index)\X,*Font\CharInfo(Index)\Y,*Font\CharInfo(Index)\Width,*Font\CharInfo(Index)\Height)
ZoomSprite(*Font\Sprite,*Font\CharInfo(Index)\Width*Zoom,*Font\CharInfo(Index)\Height * Zoom)
DisplayTransparentSprite(*Font\Sprite,X+DeltaX,Y,Opacity,Color)
DeltaX+*Font\CharInfo(Index)\Width * Zoom
EndIf
CompilerElse
Protected Char$
For loop = 1 To loopmax
Char$ = Mid(Text$,loop,1)
If Char$ = #LF$
DeltaX = 0 : Y + *Font\FontInto\Height * Zoom
Else
If FindMapElement(*Font\MapInfo(),Char$)
ClipSprite(*Font\Sprite,*Font\MapInfo()\X,*Font\MapInfo()\Y,*Font\MapInfo()\Width,*Font\MapInfo()\Height)
ZoomSprite(*Font\Sprite,*Font\MapInfo()\Width*Zoom,*Font\MapInfo()\Height * Zoom)
DisplayTransparentSprite(*Font\Sprite,X+DeltaX,Y,Opacity,Color)
DeltaX+*Font\MapInfo()\Width * Zoom
EndIf
EndIf
CompilerEndIf
Next loop
EndProcedure
Procedure CreateTextBox(X,Y,Width,Height,Flag=0)
AddElement(TextBoxList())
Define *TextBox.Textbox = @TextBoxList() ;AllocateStructure(TextBox)
*TextBox\X = X
*TextBox\Y = Y
*TextBox\Width = Width
*TextBox\Height = Height
*TextBox\CurentLine = 1
*TextBox\Flag = Flag
ProcedureReturn *TextBox
EndProcedure
Procedure FreeTextBox(*TextBox)
;FreeStructure(*TextBox)
ChangeCurrentElement(TextBoxList(),*TextBox)
DeleteElement(TextBoxList())
EndProcedure
Procedure DisplayTextBox(*TextBox.TextBox)
Protected loop, loopmax, DeltaX, DeltaY, Color, Blink
ForEach *TextBox\Text()
If *TextBox\Text()\Blink\Enable
Blink = MakeBlink(*TextBox)
If Blink = -2
Continue
Else
Color = Blink
EndIf
Else
Color = *TextBox\Text()\Color
EndIf
loopmax = Len(*TextBox\Text()\Text) : DeltaX = 0 : DeltaY = 0
If *TextBox\Text()\Shake\Enable
DeltaX + MakeShake(*TextBox) : DeltaY = DeltaX/2
EndIf
CompilerIf #PBF_Compatibility = 0
Protected Index
loopmax - 1
For loop = 0 To loopmax
If *TextBox\Text()\Wave\Enable
DeltaY = MakeWave(*TextBox,loop)
EndIf
If *TextBox\Text()\Rainbow\Enable
Color = MakeRainbow(*TextBox,loop)
EndIf
Index = PeekC(@*TextBox\Text()\Text + loop * 2)
ClipSprite(*TextBox\Text()\Font\Sprite,*TextBox\Text()\Font\CharInfo(Index)\X,*TextBox\Text()\Font\CharInfo(Index)\Y,*TextBox\Text()\Font\CharInfo(Index)\Width,*TextBox\Text()\ClipHeight)
ZoomSprite(*TextBox\Text()\Font\Sprite,*TextBox\Text()\Font\CharInfo(Index)\Width * *TextBox\Text()\Zoom, *TextBox\Text()\ClipHeight * *TextBox\Text()\Zoom)
DisplayTransparentSprite(*TextBox\Text()\Font\Sprite,*TextBox\X + *TextBox\Text()\X+DeltaX, *TextBox\Y + *TextBox\Text()\Y+DeltaY, *TextBox\Text()\Opacity, Color)
DeltaX+*TextBox\Text()\Font\CharInfo(Index)\Width * *TextBox\Text()\Zoom
CompilerElse
Protected Char$
For loop = 1 To loopmax
If *TextBox\Text()\Wave\Enable
DeltaY = MakeWave(*TextBox,loop)
EndIf
If *TextBox\Text()\Rainbow\Enable
Color = MakeRainbow(*TextBox,loop)
EndIf
Char$ = Mid(*TextBox\Text()\Text,loop,1)
If FindMapElement(*TextBox\Text()\Font\MapInfo(),Char$)
ClipSprite(*TextBox\Text()\Font\Sprite,*TextBox\Text()\Font\MapInfo()\X,*TextBox\Text()\Font\MapInfo()\Y,*TextBox\Text()\Font\MapInfo()\Width,*TextBox\Text()\ClipHeight)
ZoomSprite(*TextBox\Text()\Font\Sprite,*TextBox\Text()\Font\MapInfo()\Width * *TextBox\Text()\Zoom, *TextBox\Text()\ClipHeight * *TextBox\Text()\Zoom)
DisplayTransparentSprite(*TextBox\Text()\Font\Sprite,*TextBox\X + *TextBox\Text()\X+DeltaX, *TextBox\Y + *TextBox\Text()\Y+DeltaY, *TextBox\Text()\Opacity, Color)
DeltaX + *TextBox\Text()\Font\MapInfo()\Width * *TextBox\Text()\Zoom
EndIf
CompilerEndIf
Next
Next
EndProcedure
Procedure AddTextBoxString(*TextBox.TextBox,*Font.BitmapFont,String$,Zoom.f,Opacity,Color=#PB_Default)
Protected Index = 1, Text$, TempText$, SpaceCount, Shake, Wave, Blink,Rainbow, ColorBlink
SpaceCount = CountString(String$," ") + 2
Repeat
TempText$ = StringField(String$,Index," ")
If TempText$ = "{\}"
If Not Text$ = ""
AddTextToBox(*TextBox,*Font,Text$+" ",Shake,Wave,Blink,ColorBlink,Rainbow,Zoom,Opacity,Color)
Text$ = ""
EndIf
If Shake : *TextBox\CursorX + ShakeTarget : EndIf
Shake = 0 : Wave = 0 : Blink = 0 : ColorBlink = 0 : Rainbow = 0
ElseIf Mid(TempText$,1,2) = "${"
If Not Text$ = ""
AddTextToBox(*TextBox,*Font,Text$+" ",Shake,Wave,Blink,ColorBlink,Rainbow,Zoom,Opacity,Color)
Text$ = ""
EndIf
TempText$ = LCase(Mid(TempText$,3,Len(TempText$)-3))
Select TempText$
Case "shake"
Shake = 1
Case "wave"
Wave = 1
Case "blink"
Blink = 1
Case "colorblink"
ColorBlink = 1
Case "rainbow"
Rainbow = 1
EndSelect
Else
If GetTextWidth(*Font,Text$ + RTrim(TempText$),Zoom) + *TextBox\CursorX < *TextBox\Width
If Text$ = ""
Text$ + TempText$
Else
Text$ + " "+TempText$
EndIf
Else
AddTextToBox(*TextBox,*Font,Text$,Shake,Wave,Blink,ColorBlink,Rainbow,Zoom,Opacity,Color)
AddLineToBox(*TextBox)
Text$ = TempText$
EndIf
EndIf
Index + 1
Until Index = SpaceCount
If Not Text$ = ""
AddTextToBox(*TextBox,*Font,Text$,Shake,Wave,Blink,ColorBlink,Rainbow,Zoom,Opacity,Color)
EndIf
EndProcedure
Procedure AddTextBoxStringN(*TextBox,*Font,String$,Zoom.f,Opacity,Color=#PB_Default)
AddTextBoxString(*TextBox,*Font,String$,Zoom,Opacity,Color)
AddLineToBox(*TextBox)
EndProcedure
Procedure MoveTextBox(*TextBox.TextBox,X,Y,Mode = #PB_Absolute)
Select Mode
Case #PB_Absolute
*TextBox\X = X
*TextBox\Y = Y
Case #PB_Relative
*TextBox\X + X
*TextBox\Y + Y
EndSelect
EndProcedure
;---------------Setter and Getter procedures---------------------------
Procedure SetShakeAttribut(Speed.f,Target.f)
ShakeSpeed = Speed
ShakeTarget = Target
EndProcedure
Procedure SetWaveAttribut(Speed.f,Target.f)
WaveSpeed = Speed
WaveTarget = Target
EndProcedure
Procedure SetBlinkSpeed(Speed)
BlinkSpeed = Speed
EndProcedure
Procedure SetBlinkColor(Color)
BlinkColor = Color
EndProcedure
Procedure SetRainbowAttribut(Speed.f,RStep.f)
RainbowSpeed = Speed
RainbowStep = RStep
EndProcedure
Procedure.f GetShakeSpeed()
ProcedureReturn ShakeSpeed
EndProcedure
Procedure.f GetShakeTarget()
ProcedureReturn ShakeTarget
EndProcedure
Procedure.f GetWaveSpeed()
ProcedureReturn WaveSpeed
EndProcedure
Procedure.f GetWaveTarget()
ProcedureReturn WaveTarget
EndProcedure
Procedure GetBlinkSpeed()
ProcedureReturn BlinkSpeed
EndProcedure
Procedure GetBlinkColor()
ProcedureReturn BlinkColor
EndProcedure
Procedure.f GetRainbowSpeed()
ProcedureReturn RainbowSpeed
EndProcedure
Procedure.f GetRainbowStep()
ProcedureReturn RainbowStep
EndProcedure
Procedure.f GetTextBoxX(*TextBox.TextBox)
ProcedureReturn *TextBox\X
EndProcedure
Procedure.f GetTextBoxY(*TextBox.TextBox)
ProcedureReturn *TextBox\Y
EndProcedure
Procedure GetTextWidth(*Font.BitmapFont,Text$,Zoom.f)
Protected Loop, LoopMax=Len(Text$),Width, Index,MemWidth
CompilerIf #PBF_Compatibility = 0
LoopMax - 1
For loop = 0 To LoopMax
Index = PeekC(@Text$+(loop)*2)
If Index = #LF
If Width > MemWidth : MemWidth = Width : EndIf
Width = 0
Else
Width + *Font\CharInfo(Index)\Width * Zoom
EndIf
CompilerElse
Protected Char$
For Loop = 1 To LoopMax
Char$ = Mid(Text$,Loop,1)
If Char$ = #LF$
If Width > MemWidth : MemWidth = Width : EndIf
Width = 0
Else
If FindMapElement(*Font\MapInfo(),Char$)
Width+*Font\MapInfo()\Width * Zoom
EndIf
EndIf
CompilerEndIf
Next Loop
If MemWidth > Width : Width = MemWidth : EndIf
ProcedureReturn Width
EndProcedure
Procedure GetTextHeight(*Font.BitmapFont,Text$,Zoom.f)
Protected Height
Height = *Font\FontInto\Height * (CountString(Text$,#LF$)+1) * Zoom
ProcedureReturn Height
EndProcedure
;-----------------------------------------------------------------------
;--------Private Procedures---------------------------------------------
Procedure AddTextToBox(*TextBox.TextBox,*Font.BitmapFont,Text$,Shake,Wave,Blink,ColorBlink,Rainbow,Zoom.f,Opacity,Color)
If Not Text$ = ""
If *TextBox\CursorY < *TextBox\Height
AddElement(*TextBox\Text())
*TextBox\Text()\Font = *Font
*TextBox\Text()\Text = Text$
If Shake : SetShake(*TextBox) : EndIf
If Wave : PushListPosition(*TextBox\Text()): SetWave(*TextBox) : PopListPosition(*TextBox\Text()) : EndIf
If Blink : SetBlink(*TextBox) : EndIf
If ColorBlink : SetColorBlink(*TextBox) : EndIf
If Rainbow : SetRainbow(*TextBox) : EndIf
*TextBox\Text()\Color = Color
*TextBox\Text()\Opacity = Opacity
*TextBox\Text()\Zoom = Zoom
*TextBox\Text()\X = *TextBox\CursorX
*TextBox\Text()\Y = *TextBox\CursorY
If *TextBox\CursorY + *Font\FontInto\Height * Zoom > *TextBox\Height
*TextBox\Text()\ClipHeight = *Font\FontInto\Height - (*Font\FontInto\Height - (*TextBox\Height - *TextBox\CursorY) / Zoom)
Else
*TextBox\Text()\ClipHeight = *Font\FontInto\Height
EndIf
*TextBox\Text()\Line = *TextBox\CurentLine
*TextBox\CursorX + GetTextWidth(*Font,Text$,Zoom)
If *TextBox\Flag
AligneText(*TextBox)
EndIf
EndIf
EndIf
EndProcedure
Procedure AligneText(*TextBox.TextBox)
Protected DeltaX
If *TextBox\Flag = #PB_Text_Center
DeltaX = (*TextBox\Width - *TextBox\CursorX) / 2
Else
DeltaX = *TextBox\Width - *TextBox\CursorX
EndIf
ForEach *TextBox\Text()
If *TextBox\Text()\Line = *TextBox\CurentLine
*TextBox\Text()\X = DeltaX
DeltaX + GetTextWidth(*TextBox\Text()\Font,*TextBox\Text()\Text,*TextBox\Text()\Zoom)
EndIf
Next
EndProcedure
Procedure AddLineToBox(*TextBox.TextBox)
Protected DeltaLine
*TextBox\CursorY + *TextBox\Text()\Font\FontInto\Height * *TextBox\Text()\Zoom
*TextBox\CursorX = 0
*TextBox\CurentLine + 1
ForEach *TextBox\Text()
If *TextBox\Text()\Wave\Target > DeltaLine
DeltaLine = *TextBox\Text()\Wave\Target
EndIf
Next
*TextBox\CursorY + DeltaLine
EndProcedure
Procedure SetShake(*TextBox.TextBox)
*TextBox\Text()\Shake\Enable = 1
*TextBox\Text()\Shake\Speed = ShakeSpeed
*TextBox\Text()\Shake\Target = ShakeTarget
*TextBox\CursorX + ShakeTarget
EndProcedure
Procedure SetWave(*TextBox.TextBox)
Protected DeltaLine
*TextBox\Text()\Wave\Enable = 1
*TextBox\Text()\Wave\Speed = WaveSpeed
*TextBox\Text()\Wave\Target = WaveTarget
ForEach *TextBox\Text()
If *TextBox\Text()\Line = *TextBox\CurentLine
If *TextBox\Text()\Wave\Enable
If *TextBox\Text()\Wave\Target >= WaveTarget
ProcedureReturn
Else
If *TextBox\Text()\Wave\Target > DeltaLine
DeltaLine = *TextBox\Text()\Wave\Target
EndIf
EndIf
EndIf
EndIf
Next
DeltaLine = WaveTarget - DeltaLine
ForEach *TextBox\Text()
If *TextBox\Text()\Line = *TextBox\CurentLine
*TextBox\Text()\Y + DeltaLine
EndIf
Next
*TextBox\CursorY + DeltaLine
EndProcedure
Procedure SetBlink(*TextBox.TextBox)
*TextBox\Text()\Blink\Enable = 1
*TextBox\Text()\Blink\Speed = BlinkSpeed
EndProcedure
Procedure SetColorBlink(*TextBox.TextBox)
*TextBox\Text()\Blink\Enable = 2
*TextBox\Text()\Blink\Speed = BlinkSpeed
*TextBox\Text()\Blink\Color = BlinkColor
EndProcedure
Procedure SetRainbow(*TextBox.TextBox)
*TextBox\Text()\Rainbow\Enable = 1
*TextBox\Text()\Rainbow\Speed = RainbowSpeed
*TextBox\Text()\Rainbow\RainbowStep = RainbowStep
EndProcedure
Procedure MakeShake(*TextBox.TextBox)
*TextBox\Text()\Shake\Delta + *TextBox\Text()\Shake\Speed
If *TextBox\Text()\Shake\Delta >= *TextBox\Text()\Shake\Target
*TextBox\Text()\Shake\Speed = - *TextBox\Text()\Shake\Speed
ElseIf *TextBox\Text()\Shake\Delta <= - *TextBox\Text()\Shake\Target
*TextBox\Text()\Shake\Speed = Abs(*TextBox\Text()\Shake\Speed)
EndIf
ProcedureReturn *TextBox\Text()\Shake\Delta
EndProcedure
Procedure MakeWave(*TextBox.TextBox,Delta)
If Delta = 1
*TextBox\Text()\Wave\Delta + *TextBox\Text()\Wave\Speed
If *TextBox\Text()\Wave\Delta >= *TextBox\Text()\Wave\Target
*TextBox\Text()\Wave\Delta = 0
EndIf
EndIf
ProcedureReturn *TextBox\Text()\Wave\Target * Sin(2 * #PI / *TextBox\Text()\Wave\Target * (Delta+ *TextBox\Text()\Wave\Delta))
EndProcedure
Procedure MakeRainbow(*TextBox.TextBox,Delta)
Protected Result.f,H.f,R,G,B
If Delta = 1
*TextBox\Text()\Rainbow\Delta + *TextBox\Text()\Rainbow\Speed
If *TextBox\Text()\Rainbow\Delta > #PI * 2
*TextBox\Text()\Rainbow\Delta = 0
EndIf
EndIf
Result =Cos((Delta * *TextBox\Text()\Rainbow\RainbowStep + *TextBox\Text()\Rainbow\Delta))
Result = Degree(#PI * (Result+1))
H = Result / 60
Select Result
Case 0 To 59
R = 255 : G = Mod(H,2) * 255 : B = 0
Case 60 To 119
R = (1-(Mod(H,2)-1)) * 255 : G = 255 : B = 0
Case 120 To 179
R = 0 : G = 255 : B = Mod(H,2) * 255
Case 180 To 239
R = 0 : G = (1-(Mod(H,2)-1)) * 255 : B = 255
Case 240 To 299
R = Mod(H,2) * 255 : G = 0 : B = 255
Case 300 To 360
R = 255 : G = 0 : B = (1-(Mod(H,2)-1)) * 255
EndSelect
ProcedureReturn RGB(R,G,B)
EndProcedure
Procedure MakeBlink(*TextBox.TextBox)
*TextBox\Text()\Blink\Count + 1
If *TextBox\Text()\Blink\Count = *TextBox\Text()\Blink\Speed
*TextBox\Text()\Blink\State = (*TextBox\Text()\Blink\State + 1) % 2
*TextBox\Text()\Blink\Count = 0
EndIf
If *TextBox\Text()\Blink\State
ProcedureReturn *TextBox\Text()\Color
Else
If *TextBox\Text()\Blink\Enable = 1 ; Perform if tag is Blik
ProcedureReturn -2
Else ; Perform if tag is BlinkColor
ProcedureReturn *TextBox\Text()\Blink\Color
EndIf
EndIf
EndProcedure
EndModule
;-------------------------------------------------------------------------------------------
;----------------------------------Exemple of use-------------------------------------------
;-------------------------------------------------------------------------------------------
CompilerIf #PB_Compiler_IsMainFile
InitSprite()
OpenWindow(0,0,0,800,300,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0,0,800,300);,0,0,0,#PB_Screen_NoSynchronization)
SetFrameRate(60)
Define a.f = 1 , b.f = 1
fnt=PureBF::LoadBitmapFont("Arial.afg")
time = ElapsedMilliseconds()
box = PureBF::CreateTextBox(400,100,300,150,#PB_Text_Center)
box2 = PureBF::CreateTextBox(30,150,300,150,#PB_Text_Right)
PureBF::SetBlinkColor($FF2200)
PureBF::AddTextBoxString(box,fnt,"Ceci est un essais de ${shake} phrase {\} longue pour ${blink} voir {\} ",0.25,255)
PureBF::SetBlinkSpeed(60)
PureBF::AddTextBoxString(box,fnt,"si le ${Wave} retour ${colorblink} à la ligne {\} est pris en compte.",0.25,255,#Red)
PureBF::AddTextBoxString(box2,fnt,"Une deuxième ${rainbow} ${wave} textbox avec d'autres effets {\} est-ce que ça fonctionne aussi ?",0.25,140)
Repeat
ClearScreen($000000)
PureBF::DisplayText(fnt,10,10,"Testouille "+#LF$+"???",0.25,255)
PureBF::DisplayText(fnt,10,PureBF::GetTextHeight(fnt,"Testouille "+#LF$+"???",0.25)+10,"Là aussi !!",0.33,100,RGB(128,130,12))
PureBF::DisplayText(fnt,PureBF::GetTextWidth(fnt,"Testouille "+#LF$+"???",0.25)+10+PureBF::GetTextWidth(fnt," ",0.25),10,"Ca marche !!",0.25,128,128)
PureBF::DisplayText(fnt,10,100,"Яабвгдеёжзийкл",0.25,255)
FPS + 1
PureBF::DisplayText(fnt,650,10,"FPS : "+FPSCount,0.25,255)
; PureBF::MoveTextBox(box,a,b,#PB_Relative)
; If PureBF::GetTextBoxX(box) >= 400
; a = - Random(30,10)/10
; ElseIf PureBF::GetTextBoxX(box) <= 200
; a = Random(30,10)/10
; EndIf
; If PureBF::GetTextBoxY(box) >= 150
; b = - Random(20,10)/10
; ElseIf PureBF::GetTextBoxY(box) <= 50
; b = Random(20,10)/10
; EndIf
PureBF::DisplayTextBox(box)
PureBF::DisplayTextBox(box2)
If ElapsedMilliseconds() - time >= 1000
FPSCount = FPS : FPS = 0 : time = ElapsedMilliseconds()
EndIf
FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow
CompilerEndIf