Pure BitmapFont

Programmation avancée de jeux en PureBasic
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Pure BitmapFont

Message par boby »

De quoi afficher du text sans perdre tous ses PFS d'un seul coup ! Je vous présente mon module PureBF accompagné de son générateur de bitmapfont.
Le module comporte quelques effets (tremblement, text en vaguelette, clignottement). 2 moyens d'afficher du text :
Soit via affichage directe d'un text (ne permet pas l'utilisation d'effets)
Soit via un système de box qui gérera automatiquement les retour à la ligne et la succétion d'ajout de text dans cette box.
Les fonctions sont doccumentés dans le DeclareModule.
Image
(Réglé volontairement à 30 FPS pour le GIF)

Le générateur "Awesome bitmapFont Generation" (rien que ça) :

Code : Tout sélectionner

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
Le module (avec l'exemple servant à faire le GIF) :

Code : Tout sélectionner

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


Enjoy.
Dernière modification par boby le mer. 12/déc./2018 16:08, modifié 3 fois.
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pure BitmapFont

Message par Micoute »

Merci beaucoup, boby, pour le partage, c'est un merveilleux cadeau pour Noël, j'adore.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Pure BitmapFont

Message par GallyHC »

Merci pour le partage "Papala" ^^.

GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: Pure BitmapFont

Message par boby »

MAJ : Remplacement du tag "Snake" par "Wave"... Je ne sais pas d'où m'était venu l'idée de l'appeler comme ça... Il faut croire que quand on est con c'est pour la vie.
Ajout de l'argument Flag dans la procédure CreateTextBox() prenant en compte les flag de PB #PB_Text_Center et #PB_Text_Right pour centrer ou aligner à droite automatiquement le texte contenu dans les TextBox.

Edit : Ajout du tag (et son effet) rainbow. SetRainbowAttribut(Speed,RStep) permet de regler l'effet, Speed défini la vitesse de défilement, RStep l'écart sur la roue des couleur entre chaques lettres.
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Pure BitmapFont

Message par Fig »

Est ce que c'est une fonction similaire ou une extension de ça : https://www.purebasic.fr/english/viewto ... 12&t=43223 ?
Image
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: Pure BitmapFont

Message par boby »

C'est une autre approche que Typeface (c'est par-ce qu'elle existe déjà que je n'ai repris aucun des effets qu'elle permet).
Typeface forme des sprites contenant le text puis travail dessus pour les "deformer" et jouer avec.
Ma lib préscalcule l'emplacement des texts quand on ajoute du text à une "box" (comme je les ais appelées), au moment de l'affichage il ne reste plus qu'à jouer les effets et afficher les sprites aux positions près calculé, ça ne permet donc pas des effets tel que la rotation ou la courbure, par contre ça permet des traiter lettres par lettres (example l'effet wave ou rainbow).

J'avais vu cette lib mais ne répondais pas à mes besoins précis, j'ai donc fait la mienne et profité de l'occasion pour apporter une autre approche. (En therme de perf je dirais qu'elles sont relativement proche, si je coupe la limitation de FPS lié au Vsync j'ai environ 6000 FPS pour environ 200 caractères)

(Un petit GIF de la dernière MAJ, le "phrase" ne shake plus à cause de la conversion en GIF :p)
Image
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: Pure BitmapFont

Message par boby »

Petite MAJ : Correction de quelques bugs et suppression de l'utilisation des pointeurs, en activant le mode de compatibilité : #PBF_Compatibility = 1 (et en refaisant la procedure LoadBitmapFont) ça devrait être compatible SpiderBasic. Je n'ai pas encore pris ma liscence de SB, si quelqu'un est motivé pour tester, je serais intéressé d'un retour pour savoir si ça fonctionne.
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pure BitmapFont

Message par Ar-S »

Salut et merci pour ce partage qui va être pratique.
Dans ton exemple GIF, j'ai une erreur accés mémoire invalide ligne 469 en #PBF_Compatibility = 0
et la même erreur en #PBF_Compatibility = 1 Ligne 479
J'ai compilé en 5.62 x64 et x86
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: Pure BitmapFont

Message par boby »

@Ar-S tu n'as probablement pas utilisé la générateur de font pour générer la font arial que j'utilise dans mon exemple :
Ligne 685 : fnt=PureBF::LoadBitmapFont("Arial.afg")

Compile le premier code (l'éditeur de Font) fait sauvegarder sans toucher à rien, il te sortira la bitmapfont (Arial.afg) que j'utilise pour mon exemple.
Il est vrai que dans l'exemple je ne vérifi pas si la font est bien chargée.
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pure BitmapFont

Message par Ar-S »

Effectivement c'est nickel.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

Re: Pure BitmapFont

Message par poshu »

Code : Tout sélectionner

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
	ClearList(ftd())
	
	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
Tout petit Bugfix sur l'éditeur.
Répondre