ttf examples with sdl and fb native

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

ttf examples with sdl and fb native

Post by thrive4 »

These examples illustrate using ttf fonts in a fb application
either natively or with sdl2 in order:
- static text
- dynamic (clock and date) and scrolling text
- text input

update 18/12/2022 (fb native)
- reworked rotate text actually rotates instead of vertical orientation text
- added a boundary check for text input
- note there are still a number of issues with the fb ttf library
- like text alignment and more importantly a slight memory leak
- deprecated old flip
' slightly tweaked from viewtopic.php?t=12068&hilit=invert+value+put
' code by counting_pine

update 02/12/2022 (fb native)
- added ghetto rotate text (90 degrees) and flip very primitive
- added some intrinsic defines

update 23/11/2022
- added (fake) text styles (strike-through and underlined)
- added a customizable text marker
- note regrettably the fb library does not support
- text styles, or rotating text, in its current form.

- pre requisites
either copy a ttf font from
<os drive>:\windows\fonts
or download a ttf font and place it
in the same folder as the compiled exe
either rename the ttf to 'gisha.ttf'
or change line 38 (fb only 22):
ttffont as string = exepath + "\gisha.ttf"
to:
ttffont as string = exepath + "\<fontname>.ttf"

- fb native
Add the fb ttf library by d.j.peters aka Joshy
viewtopic.php?t=25083
place the 'lib' folder and 'FBTrueType.bi' contained in
the zip package in the same folder as this code to
compile.

usage: press F11 for fullscreen and basic text input

Code: Select all

' fb truetype lib can be found at
' https://www.freebasic.net/forum/viewtopic.php?t=25083
#include once "fbgfx.bi"
#include once "FBTrueType.bi"
#include once "vbcompat.bi"
#if __FB_LANG__ = "fb"
Using fb '' constants and structures are stored in the FB namespace in lang fb
#endif

Dim e As Event
dim running         as boolean = True
dim screenwidth     As integer = 1280
dim screenheight    As integer = 720
dim fullscreen      as boolean = false
dim desktopw        as integer
dim desktoph        as integer
dim desktopr        as integer
' get desktop info
ScreenInfo desktopw, desktoph,,,desktopr

' font 
dim shared ttffontsize as integer
Dim ttffontcolor    as ulong = rgb(255, 255, 255)
Dim logocolor       as ulong = rgb(55, 55, 55)
Dim textmarkercolor as ulong = rgb(75, 0, 0) ' used for custom text marker as underline etc
Dim ttffont         as string  = exepath + "\gisha.ttf"
dim fontsizeclock   as integer
dim fontsizedate    as integer
dim fontsizelogo    as integer

' supplement message with fb system metrics or...
' wmic cpu list /format:list
' lscpu for unix
dim os as string = "unknown"
#ifdef __FB_WIN32__
    os = "windows" 
#endif
#ifdef __FB_UNIX__
    os = "unix" 
#endif
dim ttfmessagea as string = ":cpu cores "
dim ttfmessageb as string = ":ram "
dim ttfmessagec as string = ":platform " & os
dim ttfmessaged as string = ":fb version " & __FB_VERSION__
dim ttfmessagee as string = ":deprecated "

' used for dimensions and location of text
Dim As Integer iW, iH
Dim As integer posx, sposx
Dim As integer posy, sposy

' setup clock and date display
dim shared clockposx as integer
dim shared clockposy as integer
Dim datetime As Double
dim dateformat as string = "dd/mm/yyyy"
dim timeformat as string = "hh:mm:ss"

' used for text input 
Dim inptext as string = ""
dim bkminptext as string = ""

' load the font
var font = FontLoad(ttffont)
if font < 0 then
  print "error: loading: " & ttffont & " " & ErrorText(font)
end if

Type tmpimage
    image   As FB.Image Ptr
    xpos    As Integer
    ypos    As Integer
    iwidth  As Integer
    iheight As Integer
    bypp    As Integer
    pitch   As Integer
    pixdata As Any Ptr
    size    As Long
End Type
Dim Shared tmpimg As tmpimage

' image information
Function checkimg(img As FB.Image Ptr) As Long
    checkimg = ImageInfo(img,tmpimg.iwidth,tmpimg.iheight,_
                          tmpimg.bypp,tmpimg.pitch,tmpimg.pixdata,tmpimg.size)
End Function

' rotates image 90, 180, or 270 degrees
' based on code by NorbyDroid
' https://www.freebasic.net/forum/viewtopic.php?t=29100
' tweaked by thrive4 2022 rotation only
Function imagerotate(img As FB.Image Ptr, rotation As Integer) As Integer
    Dim As Integer iwidth, iheight

    If checkimg(img) = 0 Then
        iwidth =  tmpimg.iheight - 1
        iheight = tmpimg.iwidth
        if rotation = 180 then
            iwidth =  tmpimg.iwidth - 1
            iheight = tmpimg.iheight
        end if

        tmpimg.image = ImageCreate(iwidth + 1,  iheight)

        For ypos As Integer = 0 To iheight + iwidth
            For xpos As Integer = 0 To iwidth + 1
              Select Case As Const rotation
                Case -90, 270:PSet tmpimg.image,(iwidth - ypos, xpos), Point(xpos, ypos, img)
                Case 180     :PSet tmpimg.image,(iwidth - xpos, iheight - yPos), Point(xpos, yPos - 1, img)
                Case -270, 90:PSet tmpimg.image,(ypos, iheight - xpos), Point(xpos - 1, ypos, img)
              End Select
            Next
        Next
    Else
        return -1
    End If

End Function

' ttprintex font, posx, posy, txt, fontcolor, orientation, rotation, fontsize
' work around for getting size of text with font
dim shared txtwidth as long
sub ttprintex overload(byval font as long, _
                     byval x as long, byval y as long, _
                     byref txt as string, _
                     byval col as ulong = rgb(255,255,255), _
                     byref orientation as string, _
                     byref rotate as integer, _
                     byval size as long = 24)
  dim as FontProps  fProps
  dim as GlyphProps gProps
  dim as long maxw, maxh, bytes, cx = x, cy = y, bmky = cy
  if screenptr() = 0 then return
  screeninfo maxw, maxh,, bytes
  if bytes <> 4 then return
  if size < 4 then return
  txt = trim(txt)  
  var nChars = len(txt) : if nChars < 1 then return
  if FontPorperties(font, size, fprops) then return
  nChars -= 1
  txtwidth = 0
  for i as long = 0 to nChars
    var char = txt[i]
    if char < 33 then
      if char = 32 then cx += size * 0.25f
    else
      var index1 = GlyphIndex(font, char)
      if index1 <> GLYPH_NOT_FOUND then
        dim as long index2 = iif(i < nChars,GlyphIndex(font, txt[i + 1]), 0)
        if index2 = GLYPH_NOT_FOUND then index2 = 0
        if GlyphProperties(font, fProps, gProps, index1, index2) = 0 then
          if cx + gProps.w >= maxw then cy += fProps.advanceHeight : cx = x
          var AlphaChannel = GlyphImageCreate(font, fProps, gProps, index1)
          if AlphaChannel then
            var glyph = ImageCreate(gProps.w , gProps.h, col)
            put glyph, (0,0), AlphaChannel, ALPHA
            Dim As FB.Image Ptr swapimage = glyph
            ' added rotate and orientation text
            select case orientation
                case "vertical"
                    if rotate <> 0 then
                        imagerotate(swapimage, rotate)
                        Put(x, bmky + gProps.y), tmpimg.image, alpha
                        imagedestroy(swapimage)
                        imagedestroy(tmpimg.image)
                    else
                        Put(x, bmky + gProps.y),glyph,alpha
                    end if
                case else
                    if rotate <> 0 then
                        imagerotate(swapimage, rotate)
                        Put(cx, cy + gProps.y), tmpimg.image,alpha
                        imagedestroy(swapimage)
                        imagedestroy(tmpimg.image)
                    else
                        put(cx, cy + gProps.y), glyph, ALPHA
                    end if
            end select
            bmky += fProps.advanceHeight * 0.8f
            ImageDestroy glyph
            ImageDestroy AlphaChannel
          endif
          cx += gProps.advanceWidth + gProps.kernAdvance
        endif
      endif
    endif
  txtwidth = cx
  next
end sub

' create curved boxes
' lifted from joytest.zip by coderjeff
' see https://www.freebasic.net/forum/viewtopic.php?p=54746&hilit=joytest#p54746
'fb_fillrect x loc,y loc, height, width, arc size, fill color
sub fb_fillrect _
  ( _
    byval x as integer, _
    byval y as integer, _
    byval w as integer, _
    byval h as integer, _
    byval r as integer, _
    byval c as integer _
  )

  circle (x + r    , y + r        ), r, c, , , , f
  circle (x + r    , y + h - r - 1), r, c, , , , f
  circle (x + w - r - 1, y + r    ), r, c, , , , f
  circle (x + w - r - 1, y + h - r - 1), r, c, , , , f

  line (x, y + r) - (x + w - 1, y + h - r), c, bf
  line (x + r, y) - (x + w - r, y + h - 1), c, bf

end sub
 
initscreen:
if fullscreen then
    screenres screenwidth, screenheight, 32, 1, GFX_NO_FRAME
else
    screenres screenwidth, screenheight, 32, 1, GFX_WINDOWED
end if
' (screenwidth * 0.25f) * 14 = 14pt approximation of fontsize proportional to screensize
ttffontsize     = fix(screenheight / (screenwidth * 0.25f) * 14)
fontsizeclock   = fix(screenheight / (screenwidth * 0.25f) * 18)
fontsizedate    = fix(screenheight / (screenwidth * 0.25f) * 13)
fontsizelogo    = fix(screenheight / (screenwidth * 0.25f) * 104)

' main loop
Do
    Dim datetime As Double = Now()
    dim offsetcursor as integer = len(inptext)
    If (ScreenEvent(@e)) Then
        Select Case e.type
            case EVENT_WINDOW_CLOSE
                exit do
            Case EVENT_KEY_PRESS
            Case EVENT_KEY_RELEASE
                select case e.scancode
                    case SC_ESCAPE
                        exit do
                    case SC_F11
                        select case fullscreen
                            case true
                                screenwidth  = 1280
                                screenheight = 720
                                fullscreen = false
                                goto initscreen
                            case false
                                screenwidth  = desktopw
                                screenheight = desktoph
                                fullscreen = true
                                goto initscreen
                        end select
                    case SC_BACKSPACE
                        inptext = Left(inptext, offsetcursor - 1) + Mid(inptext, offsetcursor + 1)
                    case SC_ENTER
                        bkminptext = inptext        
                    case else
                        if e.ascii > 31 and e.ascii < 127 then
                            inptext = inptext + chr(e.ascii)
                        end if
                end select
            Case EVENT_WINDOW_CLOSE
                exit do
        End Select
    End If

  ScreenLock()
    CLS()
    ' clock
    clockposx = screenwidth  - 150
    clockposy = 30
    ttprintex font, clockposx, clockposy, format(datetime, timeformat), ttffontcolor, "", 0, fontsizeclock

    ' date
    ttprintex font, clockposx, clockposy + fontsizeclock, format(datetime, dateformat), ttffontcolor, "", 0, fontsizedate

    ' metrics
    ttprintex font, 10, 200, ttfmessagea, ttffontcolor, "", 0, ttffontsize
    ttprintex font, 10, 200 + ttffontsize, ttfmessageb, ttffontcolor, "", 0, ttffontsize
    ttprintex font, 10, 200 + ttffontsize * 2, ttfmessagec, ttffontcolor, "", 0, ttffontsize
    ttprintex font, 10, 200 + ttffontsize * 3, ttfmessaged, ttffontcolor, "", 0, ttffontsize

    ' fake underline with text marker
    fb_fillrect   10, 200 + ttffontsize * 4, txtwidth, 1, 0, ttffontcolor
    ttprintex font, 10, 200 + ttffontsize * 4, ttfmessagee, ttffontcolor, "", 0, ttffontsize

    ' fake striketrhough with text marker
    fb_fillrect   10, 200 + ttffontsize * 4.5, txtwidth, 1, 0, ttffontcolor

    ' text marker
    fb_fillrect   10, 200 + ttffontsize * 5, txtwidth, 3, 0, textmarkercolor

    ' logo
    ttprintex font, screenwidth * 0.5 - fontsizelogo * 0.5, screenheight * 0.5 - fontsizelogo * 0.5, "FB", logocolor, "", 0, fontsizelogo

    ' rotated text
    ttprintex font, screenwidth * 0.5 - ttffontsize * 4.75, screenheight * 0.5 - ttffontsize * 2.7, "ROTATED", ttffontcolor, "vertical", -90, ttffontsize

    ' text input
    ttprintex font, screenwidth * 0.5 - ttffontsize * len(inptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 200, inptext & "|", ttffontcolor, "", 0, ttffontsize
    if bkminptext <> "" then
        ttprintex font, screenwidth * 0.5 - ttffontsize * len(bkminptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 250, bkminptext, ttffontcolor, "", 0, ttffontsize
    end if

    ' scrolling text
    ttprintex font, sposx, screenheight * 0.95 - ttffontsize * 0.95, "scrolling text scrolling textscrolling textscrolling textscrolling text",  ttffontcolor, "", 0, ttffontsize
    if sposx > 0 then
        sposx = sposx - 1
    else
        sposx = (screenwidth * 0.5 - ttffontsize * 0.5)
    end if

  ScreenUnlock()

  ' reduce cpus usage  
  Sleep(15, 1)
Loop

end

Last edited by thrive4 on Dec 18, 2022 12:40, edited 6 times in total.
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

Re: ttf examples with sdl and fb native

Post by thrive4 »

- sdl variant

update 18/12/2022
- replaced text rendering with TTF_RenderUTF8_Blended_Wrapped
- allows for multiline text plus added an example

update 23/11/2022
- added text styles (italics, bold, etc)
- added rotated text
- added a customizable text marker

needs sdl2 dll (tested with 32 bit version)
if needed download
sdl https://github.com/libsdl-org/SDL/releases
sdl ttf https://github.com/libsdl-org/SDL_ttf/releases

place:
SDL2.dll
SDL2_ttf.dll

in the same folder as the compiled exe

More info sdl text input:
http://lazyfoo.net/tutorials/SDL/32_tex ... /index.php

Code: Select all

' loosly based on TwinklebearDev SDL 2.0 Tutorial
' Lesson 6: True Type Fonts with SDL_ttf
' Translated to FreeBASIC by Michael "h4tt3n" Schmidt Nissen, march 2017
' http://www.willusher.io/sdl2%20tutorials/2013/12/18/lesson-6-true-type-fonts-with-sdl_ttf
' tweaked for fb and sdl2 2022 by thrive4

#include once "SDL2/SDL.bi"
#include once "SDL2/SDL_ttf.bi"
#include once "vbcompat.bi"

' setup variables 
dim event as SDL_Event
Dim As SDL_Texture Ptr texture
dim running         as boolean = True
dim screenwidth     As integer = 1280
dim screenheight    As integer = 720
dim aspectratio     as integer = screenwidth / screenheight
dim fullscreen      as boolean = false
dim desktopw        as integer
dim desktoph        as integer
dim desktopr        as integer
' get desktop info
ScreenInfo desktopw, desktoph,,,desktopr

' supplement message with sdl system metrics
' wmic cpu list /format:list
' lscpu for unix
dim compiled as SDL_version
Dim platform As const zstring ptr = SDL_GetPlatform()
dim ttfmessagea as string = ":cpu cores " & SDL_GetCPUCount()
dim ttfmessageb as string = ":ram " & SDL_GetSystemRAM()
dim ttfmessagec as string = ":platform " & *platform
dim ttfmessaged as string = ":sdl version " & SDL_MAJOR_VERSION & "." & SDL_MINOR_VERSION & "." & SDL_PATCHLEVEL
dim ttfmessagee as string = ":deprecated  " & SDL_MAJOR_VERSION & "." & SDL_MINOR_VERSION & "." & SDL_PATCHLEVEL - 1

' font type and Color in RGBA format
Dim As SDL_Color ttffontcolor = (255, 255, 255, 0)
Dim As SDL_Color logocolor    = (55, 55, 55, 0)
Dim As SDL_Color textmarkercolor  = (75, 0, 0, 0) ' used for custom text marker as underline etc
Dim ttffont as string         = exepath + "\gisha.ttf"
dim shared ttffontsize as integer
dim fontsizeclock as integer
dim fontsizedate  as integer
dim fontsizelogo  as integer

' Get the texture w/h so we can center it in the screen
Dim As Integer iW, iH
Dim As integer posx, sposx
Dim As integer posy, sposy

' left side boundry for scrolling text
Dim scrollbound As SDL_Rect
scrollbound.x = 0
scrollbound.y = 0
scrollbound.w = screenwidth * 0.5 - iW * 0.5
scrollbound.h = 0

' set location textinput
Dim textinputloc As SDL_Rect
textinputloc.x = 30
textinputloc.y = 30
textinputloc.w = screenwidth * 0.5 - iW * 0.5
textinputloc.h = 20

' set textfx for by fake underline with custom color
Dim textmarker As SDL_Rect
textmarker.x = 0
textmarker.y = 0
textmarker.w = 0
textmarker.h = 0

' setup clock and date display
dim shared clockposx as integer
dim shared clockposy as integer
Dim datetime As Double
dim dateformat as string = "dd/mm/yyyy"
dim timeformat as string = "hh:mm:ss"

initsdl:
' aspectratio * 12 = 12pt approximation of fontsize proportional to screenheight
aspectratio     = screenwidth / screenheight
ttffontsize     = fix(screenheight / screenwidth * 2 * aspectratio * 12)
fontsizeclock   = fix(screenheight / screenwidth * 2 * aspectratio * 14)
fontsizedate    = fix(screenheight / screenwidth * 2 * aspectratio * 10)
fontsizelogo    = fix(screenheight / screenwidth * 2 * aspectratio * 82)

' init window and render
If (SDL_Init(SDL_INIT_VIDEO) = not NULL) Then
    'logentry("error", "sdl2 video could not be initlized error: " + *SDL_GetError())
    SDL_Quit()
else
    ' no audio needed
    SDL_QuitSubSystem(SDL_INIT_AUDIO)
    ' render scale quality: 0 point, 1 linear, 2 anisotropic
    SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "1")
End If
' setup glass aka window
Dim As SDL_Window Ptr glass
if fullscreen then
    SDL_ShowCursor(SDL_DISABLE)
    glass = SDL_CreateWindow( "sdl ttf demo", null, null, screenwidth, screenheight, SDL_WINDOW_BORDERLESS)
else
    SDL_ShowCursor(SDL_ENABLE)
    glass = SDL_CreateWindow( "sdl ttf demo", 100, 100, screenwidth, screenheight, SDL_WINDOW_RESIZABLE)
end if
if (glass = NULL) Then
    'logentry("error", "sdl2 could not create window")
	SDL_Quit()
EndIf
Dim As SDL_Renderer Ptr renderer = SDL_CreateRenderer(glass, -1, SDL_RENDERER_ACCELERATED Or SDL_RENDERER_PRESENTVSYNC)
'SDL_SetWindowOpacity(glass, 0.5)
if (renderer = NULL) Then	
    'ogentry("error", "sdl2 could not create renderer")
	SDL_Quit()
EndIf

' Initializing SDL_ttf
if (TTF_Init() = Not 0) Then SDL_Quit()_ end EndIf

' todo find better solution for excessive font file reads
Dim shared As TTF_Font Ptr ttffontdef
ttffontdef = TTF_OpenFont(ttffont, ttffontsize)

Dim shared As TTF_Font Ptr ttffontclock
ttffontclock = TTF_OpenFont(ttffont, fontsizeclock)

Dim shared As TTF_Font Ptr ttffontdate
ttffontdate = TTF_OpenFont(ttffont, fontsizedate)

Dim shared As TTF_Font Ptr ttffontlogo
ttffontlogo = TTF_OpenFont(ttffont, fontsizelogo)

Sub renderTexture(  ByVal tex As SDL_Texture Ptr, _
	                ByVal ren As SDL_Renderer Ptr, _ 
	                Byval x   As Integer, _
	                Byval y   As Integer, _
	                Byval r   As Integer, _ ' rotate in degrees
	                Byval c   As Integer, _ ' the point around which dstrect will be rotated
	                Byval f   As Integer)   ' flip SDL_FLIP_NONE, SDL_FLIP_HORIZONTAL, SDL_FLIP_VERTICAL
	
    if tex <> null then	
        Dim As Integer w, h
        Dim As SDL_Rect dst
        SDL_QueryTexture(tex, NULL, NULL, @w, @h)
        dst.x = x
        dst.y = y
        dst.w = w
        dst.h = h
        SDL_RenderCopyEx(ren, tex, NULL, @dst, r, c, f)
        SDL_DestroyTexture(tex)' todo check this	
    end if
End Sub

Function renderText( ByRef message  As Const String, _
                     Byval ttffont  As TTF_Font ptr, _
                     ByVal col      As SDL_Color, _
                     ByVal wrap     As integer, _
                     ByVal renderer As SDL_Renderer Ptr ) As SDL_Texture Ptr
    if message <> "" then
        if (ttffontdef = NULL) Then
            Return NULL
        End If
        ' load surface into a texture
        Dim As SDL_Surface Ptr surf
        surf = TTF_RenderUTF8_Blended_Wrapped(ttffont, message, col, wrap)
        if (surf = NULL) Then 
            TTF_CloseFont(ttffontdef)
            Return NULL
        End If
        Dim As SDL_Texture Ptr texture = SDL_CreateTextureFromSurface(renderer, surf)
        if (texture = NULL) Then
            Return NULL
        EndIf
        ' clean up
        SDL_FreeSurface(surf)
        return texture
    else
        return null
    end if

End Function

' parse html and prep for display
function replace(byref haystack as string, byref needle as string, byref substitute as string) as string
'found at https://freebasic.net/forum/viewtopic.php?f=2&t=9971&p=86259&hilit=replace+character+in+string#p86259   
    dim as string temphaystack = haystack
    dim as integer fndlen = len(needle), replen = len(substitute)
    dim as integer i = instr(temphaystack, needle)
   
    while i
        temphaystack = left(temphaystack, i - 1) & substitute & mid(temphaystack, i + fndlen)
        i = instr(i + replen, temphaystack, needle)
    wend
   
    return temphaystack

end function

function striphtmltags(html as string) as string
' found at https://www.freevbcode.com/ShowCode.asp?ID=1037

    dim bpos as integer = InStr(html, "<")
    dim epos as integer = InStr(html, ">")
    dim dummy as string
    
    Do While bpos <> 0 And epos <> 0 And epos > bpos
          dummy = Mid(html, bpos, epos - bpos + 1)
          html = replace(html, dummy, "")
          bpos = InStr(html, "<")
          epos = InStr(html, ">")
    Loop

    ' Translate common escape sequence chars
    html = Replace(html, "&nbsp;", " ")
    html = Replace(html, "&amp;", "&")
    html = Replace(html, "&quot;", "'")
    html = Replace(html, "&#", "#")
    html = Replace(html, "&lt;", "<")
    html = Replace(html, "&gt;", ">")
    html = Replace(html, "%20", " ")
    html = LTrim(Trim(html))

    return html

end function
dim filename as string = command(1)
dim itemnr as integer = 1
dim listitem as string
dim text as string = ""

filename = "test.html"

    Open filename For input As 1
    Do Until EOF(1)
        Line Input #1, listitem
        'print listitem
        text = text + listitem + " "
        if itemnr = 5 then exit do
        itemnr += 1
    Loop
close 1
'striphtmltags(text)

dim inptext as string = ""
dim bkminptext as string = ""

' display the text aka texture with sdl
while running
    Dim datetime As Double = Now()     
    dim offsetcursor as integer = len(inptext)

    while SDL_PollEvent(@event) <> 0
        ' basic window interaction
        select case event.type
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_ESCAPE
                running = False
                exit while
            case SDL_WINDOWEVENT and event.window.event = SDL_WINDOWEVENT_CLOSE
                running = False
                exit while
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_F11
                SDL_DestroyRenderer(renderer)
                SDL_DestroyWindow(glass)
                select case fullscreen
                    case true
                        screenwidth  = 1280
                        screenheight = 720
                        fullscreen = false
                        goto initsdl
                    case false
                        screenwidth  = desktopw
                        screenheight = desktoph
                        fullscreen = true
                        goto initsdl
                end select
            case SDL_TEXTINPUT
                inptext = inptext + event.text.text
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_BACKSPACE
                inptext = Left(inptext, offsetcursor - 1) + Mid(inptext, offsetcursor + 1)
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_RETURN
                bkminptext = inptext        
        end select
    wend

    SDL_RenderClear(renderer)
        ' clock
        SDL_DestroyTexture(texture)
        texture = renderText(format(datetime, timeformat), ttffontclock, ttffontcolor, 0, renderer)
        clockposx = screenwidth  - 150
        clockposy = 30
        renderTexture(texture, renderer, clockposx, clockposy, 0, null, SDL_FLIP_NONE)

        ' date
        SDL_DestroyTexture(texture)
        texture = renderText(format(datetime, dateformat), ttffontdate, ttffontcolor, 0, renderer)
        renderTexture(texture, renderer, clockposx, clockposy + fontsizeclock, 0, null, SDL_FLIP_NONE)

        ' metrics
        texture = renderText(ttfmessagea,  ttffontdef, ttffontcolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, 10, 200, 0, null, SDL_FLIP_NONE)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_BOLD)
        texture = renderText(ttfmessageb,  ttffontdef, ttffontcolor, 0, renderer)
        renderTexture(texture, renderer, 10, 200 + iH, 0, null, SDL_FLIP_NONE)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_ITALIC)
        texture = renderText(ttfmessagec,  ttffontdef, ttffontcolor, 0, renderer)
        renderTexture(texture, renderer, 10, 200 + iH * 2, 0, null, SDL_FLIP_NONE)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_UNDERLINE)
        texture = renderText(ttfmessaged,  ttffontdef, ttffontcolor, 0, renderer)
        renderTexture(texture, renderer, 10, 200 + iH * 3, 0, null, SDL_FLIP_NONE)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_STRIKETHROUGH)
        texture = renderText(ttfmessagee,  ttffontdef, ttffontcolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )

        ' custom textmarker
        SDL_SetRenderDrawBlendMode(renderer, SDL_BLENDMODE_NONE)
        SDL_SetRenderDrawColor(renderer, textmarkercolor.r, textmarkercolor.g, textmarkercolor.b, 1)
        textmarker.x = 10
        textmarker.y = 200 + iH * 5
        textmarker.w = iW
        textmarker.h = iH * 0.1
        SDL_RenderFillRect(renderer, @textmarker)
        renderTexture(texture, renderer, 10, 200 + iH * 4, 0, null, SDL_FLIP_NONE)

        ' restore text style and draw color
        SDL_SetRenderDrawColor(renderer, 0, 0, 0, 0)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_NORMAL)
        ' center screenwidth * 0.5 - iW * 0.5, screenheight * 0.5 - iH * 0.5)

        ' text block
        texture = renderText(text,  ttffontdef, logocolor, 350, renderer)
        TTF_SetFontStyle(ttffontdef, TTF_STYLE_NORMAL)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, screenwidth * 0.80 - iW * 0.5, screenheight * 0.5 - iH * 0.5, 0, null, SDL_FLIP_NONE)

        ' logo
        texture = renderText("SDL",  ttffontlogo, logocolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, screenwidth * 0.5 - iW * 0.5, screenheight * 0.5 - iH * 0.5, 0, null, SDL_FLIP_NONE)

        ' rotated text
        texture = renderText("demo",  ttffontdef, ttffontcolor, 0, renderer)
        renderTexture(texture, renderer, screenwidth * 0.5 - iW * 0.65, screenheight * 0.5 - iH * 0.22, 90, null, SDL_FLIP_NONE)
        
        ' textinput
        texture = renderText(inptext + "|",  ttffontdef, ttffontcolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, screenwidth * 0.5 - iW * 0.5, (screenheight * 0.5 - iH * 0.5) + 200, 0, null, SDL_FLIP_NONE)
        texture = renderText(bkminptext,  ttffontdef, ttffontcolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, screenwidth * 0.5 - iW * 0.5, (screenheight * 0.5 - iH * 0.5) + 250, 0, null, SDL_FLIP_NONE)

        ' scrolling text
        texture = renderText("scrolling text scrolling textscrolling textscrolling textscrolling text",  ttffontdef, ttffontcolor, 0, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH )
        renderTexture(texture, renderer, sposx, screenheight * 0.95 - iH * 0.95, 0, null, SDL_FLIP_NONE)
        SDL_RenderFillRect(renderer, @scrollbound)
        if sposx > 0 then
            sposx = sposx - 1
        else
            sposx = (screenwidth * 0.5 - iW * 0.5)
        end if

    SDL_RenderPresent(renderer)

    ' use sdl_delay to keep cpu usage low
    SDL_Delay(60)
wend

' cleanup
SDL_DestroyTexture(texture)
SDL_DestroyRenderer(renderer)
SDL_DestroyWindow(glass)
TTF_CloseFont(ttffontdef)
TTF_CloseFont(ttffontclock)
TTF_CloseFont(ttffontdate)
TTF_CloseFont(ttffontlogo)
TTF_Quit()
SDL_Quit()
end
Last edited by thrive4 on Dec 18, 2022 12:43, edited 1 time in total.
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: ttf examples with sdl and fb native

Post by Makoto WATANABE »

Dear thrive4;

Thank you for publishing the FBTrueType.bi sample program.
I would appreciate it if you could add a screenshot of yours so I can see the results you are expecting.
On my screen I see the string ":fb version" but not "fb version".
Is this correct?
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

Re: ttf examples with sdl and fb native

Post by thrive4 »

@Makoto WATANABE
> Thank you for publishing the FBTrueType.bi sample program.

You're welcome.

> On my screen I see the string ":fb version" but not "fb version".
> Is this correct?

Yes it is, I had not added the intrinsic
dim ttfmessaged as string = ":fb version "
I have updated the code to:
dim ttfmessaged as string = ":fb version " & __FB_VERSION__

Intrinsic defines can be found in the manual or here:
https://www.freebasic.net/wiki/CatPgDddefines
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: ttf examples with sdl and fb native

Post by Makoto WATANABE »

Dear thrive4;

Thank you for your explanation.
I was able to display Japanese characters on the screen using Japanese fonts.
I am very grateful to you.

Image

Code: Select all

' fb truetype lib can be found at
' https://www.freebasic.net/forum/viewtopic.php?t=25083
'Last edited by thrive4 on Dec 02, 2022 16:09, edited 5 times in total.
'Japanese by Makoto Watanabe 2022/12/06

#Include Once "fbgfx.bi"
#Include Once "FBTrueType.bi"
#Include Once "vbcompat.bi"
#If __FB_LANG__ = "fb"
Using fb '' constants and structures are stored in the FB namespace in lang fb
#EndIf

Dim e As Event
Dim running         As boolean = TRUE
Dim screenwidth     As Integer = 1280*4/5
Dim screenheight    As Integer = 720*4/5
Dim fullscreen      As boolean = FALSE
Dim desktopw        As Integer
Dim desktoph        As Integer
Dim desktopr        As Integer
' get desktop info
ScreenInfo desktopw, desktoph,,,desktopr

' font 
Dim Shared ttffontsize As Integer
Dim ttffontcolor    As ULong = RGB(255, 255, 255)
Dim logocolor       As ULong = RGB(55, 55, 55)
Dim textmarkercolor As ULong = RGB(75, 0, 0) ' used for custom text marker as underline etc
'Dim ttffont         As String  = ExePath + "\gisha.ttf"
Const ttffont = "MS 明朝.ttf"
Dim fontsizeclock   As Integer
Dim fontsizedate    As Integer
Dim fontsizelogo    As Integer

' supplement message with fb system metrics or...
' wmic cpu list /format:list
' lscpu for unix
Dim os As wstring * 20 = "unknown"
#Ifdef __FB_WIN32__
    os = "windows" 
#EndIf
#Ifdef __FB_UNIX__
    os = "unix" 
#EndIf
Dim ttfmessagea As wstring * 20 = ":cpu cores "
Dim ttfmessageb As wstring * 20 = ":ram "
Dim ttfmessagec As wstring * 20 = ":プラットホーム " & os
Dim ttfmessaged As wstring * 20 = ":fb バージョン " & __FB_VERSION__
Dim ttfmessagee As wstring * 20 = ":取り消し "

' used for dimensions and location of text
Dim As Integer iW, iH
Dim As Integer posx, sposx
Dim As Integer posy, sposy

' setup clock and date display
Dim Shared clockposx As Integer
Dim Shared clockposy As Integer
Dim datetime As Double
Dim dateformat As wstring * 20 = "yyyy/mm/dd"
Dim timeformat As wstring * 20 = "hh:mm:ss"

' used for text input 
Dim inptext As wstring * 20 = ""
Dim bkminptext As wstring * 20 = ""

' load the font
Var font = FontLoad(ttffont)
If font < 0 Then
  Print "error: loading: " & ttffont & " " & ErrorText(font)
End If

' ghetto text orientation fx
' slightly tweaked from https://www.freebasic.net/forum/viewtopic.php?t=12068&hilit=invert+value+put
' code by counting_pine
Sub put_hflip(ByVal x As Integer, ByVal y As Integer, ByVal img As Any Ptr)
    Dim As Integer w, h
    If ImageInfo( img, w, h ) <> 0 Then Exit Sub
    For x2 As Integer = 0 To w-1
        Put (x + x2, y), img, (w - 1 - x2, 0) - Step(0, h - 1), Alpha
    Next x2
End Sub

Sub put_vflip(ByVal x As Integer, ByVal y As Integer, ByVal img As Any Ptr)
    Dim As Integer w, h
    If ImageInfo( img, w, h ) <> 0 Then Exit Sub        
    For y2 As Integer = 0 To h - 1
        Put (x, y + y2), img, (0, h - 1 - y2) - Step(w - 1, 0), Alpha
    Next y2
End Sub

' work around for getting size of text with font
Dim Shared txtwidth As Long
Sub ttprintex OverLoad(ByVal font As Long, _
                     ByVal x As Long, ByVal y As Long, _
                     ByRef txt As wString, _
                     ByVal col As ULong = RGB(255,255,255), _
                     ByRef fliptype As String, _
                     ByVal size As Long = 24)
  Dim As FontProps  fProps
  Dim As GlyphProps gProps
  Dim As Long maxw, maxh, bytes, cx = x, cy = y, bmky = cy
  If ScreenPtr() = 0 Then Return
  ScreenInfo maxw, maxh,, bytes
  If bytes <> 4 Then Return
  If size < 4 Then Return
  txt = Trim(txt)  
  Var nChars = Len(txt) : If nChars < 1 Then Return
  If FontPorperties(font, size, fprops) Then Return
  nChars -= 1
  txtwidth = 0
  For i As Long = 0 To nChars
    Var char = txt[i]
    If char < 33 Then
      If char = 32 Then cx += size * 0.25f
    Else
      Var index1 = GlyphIndex(font, char)
      If index1 <> GLYPH_NOT_FOUND Then
        Dim As Long index2 = IIf(i < nChars,GlyphIndex(font, txt[i + 1]), 0)
        If index2 = GLYPH_NOT_FOUND Then index2 = 0
        If GlyphProperties(font, fProps, gProps, index1, index2) = 0 Then
          If cx + gProps.w >= maxw Then cy += fProps.advanceHeight : cx = x
          Var AlphaChannel = GlyphImageCreate(font, fProps, gProps, index1)
          If AlphaChannel Then
            Var glyph = ImageCreate(gProps.w , gProps.h, col)
            Put glyph, (0,0), AlphaChannel, Alpha
            ' added flip and rotate text orientation
            Select Case fliptype
                Case "fb_flip_horizontal"
                    put_hflip(cx, cy + gProps.y,glyph)
                Case "fb_flip_vertical"
                    put_vflip(cx, cy + gProps.y,glyph)
                Case "fb_flip_rotate"
                    'put_hflip(x, bmky,glyph)
                    Put(x, bmky + gProps.y), glyph, Alpha
                Case Else
                    Put(cx, cy + gProps.y), glyph, Alpha
            End Select
            bmky += fProps.advanceHeight * 0.8f
            ImageDestroy glyph
            ImageDestroy AlphaChannel
          EndIf
          cx += gProps.advanceWidth + gProps.kernAdvance
        EndIf
      EndIf
    EndIf
  txtwidth = cx
  Next
End Sub

' create curved boxes
' lifted from joytest.zip by coderjeff
' see https://www.freebasic.net/forum/viewtopic.php?p=54746&hilit=joytest#p54746
'fb_fillrect x loc,y loc, height, width, arc size, fill color
Sub fb_fillrect _
  ( _
    ByVal x As Integer, _
    ByVal y As Integer, _
    ByVal w As Integer, _
    ByVal h As Integer, _
    ByVal r As Integer, _
    ByVal c As Integer _
  )

  Circle (x + r    , y + r        ), r, c, , , , f
  Circle (x + r    , y + h - r - 1), r, c, , , , f
  Circle (x + w - r - 1, y + r    ), r, c, , , , f
  Circle (x + w - r - 1, y + h - r - 1), r, c, , , , f

  Line (x, y + r) - (x + w - 1, y + h - r), c, bf
  Line (x + r, y) - (x + w - r, y + h - 1), c, bf

End Sub
 
initscreen:
If fullscreen Then
    ScreenRes screenwidth, screenheight, 32, 1, GFX_NO_FRAME
Else
    ScreenRes screenwidth, screenheight, 32, 1, GFX_WINDOWED
End If
' (screenwidth * 0.25f) * 14 = 14pt approximation of fontsize proportional to screensize
ttffontsize     = Fix(screenheight / (screenwidth * 0.25f) * 14)
fontsizeclock   = Fix(screenheight / (screenwidth * 0.25f) * 16)
fontsizedate    = Fix(screenheight / (screenwidth * 0.25f) * 13)
fontsizelogo    = Fix(screenheight / (screenwidth * 0.25f) * 104)

' main loop
Do
    Dim datetime As Double = Now()
    Dim offsetcursor As Integer = Len(inptext)
    If (ScreenEvent(@e)) Then
        Select Case e.type
            Case EVENT_WINDOW_CLOSE
                Exit Do
            Case EVENT_KEY_PRESS
            Case EVENT_KEY_RELEASE
                Select Case e.scancode
                    Case SC_ESCAPE
                        Exit Do
                    Case SC_F11
                        Select Case fullscreen
                            Case TRUE
                                screenwidth  = 1280*4/5
                                screenheight = 720*4/5
                                fullscreen = FALSE
                                GoTo initscreen
                            Case FALSE
                                screenwidth  = desktopw/2
                                screenheight = desktoph/2
                                fullscreen = TRUE
                                GoTo initscreen
                        End Select
                    Case SC_BACKSPACE
                        inptext = Left(inptext, offsetcursor - 1) + Mid(inptext, offsetcursor + 1)
                    Case SC_ENTER
                        bkminptext = inptext        
                    Case Else
                        inptext = inptext + Chr(e.ascii)
                End Select
            Case EVENT_WINDOW_CLOSE
                Exit Do
        End Select
    End If

  ScreenLock()
    Cls()
    ' clock
    clockposx = screenwidth  - 150
    clockposy = 30
    ttprintex font, clockposx, clockposy, Format(datetime, timeformat), ttffontcolor, "", fontsizeclock

    ' date
    ttprintex font, clockposx, clockposy + fontsizeclock, Format(datetime, dateformat), ttffontcolor, "", fontsizedate

    ' metrics
    ttprintex font, 10, 200, ttfmessagea, ttffontcolor, "", ttffontsize
    ttprintex font, 10, 200 + ttffontsize, ttfmessageb, ttffontcolor, "", ttffontsize
    ttprintex font, 10, 200 + ttffontsize * 2, ttfmessagec, ttffontcolor, "", ttffontsize
    ttprintex font, 10, 200 + ttffontsize * 3, ttfmessaged, ttffontcolor, "", ttffontsize

    ' fake underline with text marker
    fb_fillrect   10, 200 + ttffontsize * 4, txtwidth, 1, 0, ttffontcolor
    ttprintex font, 10, 200 + ttffontsize * 4, ttfmessagee, ttffontcolor, "", ttffontsize

    ' fake striketrhough with text marker
    fb_fillrect   10, 200 + ttffontsize * 4.5, txtwidth, 1, 0, ttffontcolor

    ' text marker
    fb_fillrect   10, 200 + ttffontsize * 5, txtwidth, 3, 0, textmarkercolor

    ' logo
    ttprintex font, screenwidth * 0.5 - fontsizelogo * 0.5, screenheight * 0.5 - fontsizelogo * 0.5, "FB", logocolor, "", fontsizelogo

    ' rotated text
    ttprintex font, screenwidth * 0.5 - ttffontsize * 4.75, screenheight * 0.5 - ttffontsize * 2.7, "縦書き ROTATED", ttffontcolor, "fb_flip_rotate", ttffontsize

    ' text input
    ttprintex font, screenwidth * 0.5 - ttffontsize * Len(inptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 200, inptext & "|", ttffontcolor, "", ttffontsize
    If bkminptext <> "" Then
        ttprintex font, screenwidth * 0.5 - ttffontsize * Len(bkminptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 250, bkminptext, ttffontcolor, "", ttffontsize
    End If

    ' scrolling text
    ttprintex font, sposx, screenheight * 0.95 - ttffontsize * 0.95, "scrolling text 流れる文字列 scrolling text 流れる文字列 scrolling text",  ttffontcolor, "", ttffontsize
    If sposx > 0 Then
        sposx = sposx - 1
    Else
        sposx = (screenwidth * 0.5 - ttffontsize * 0.5)
    End If

  ScreenUnLock()

  ' reduce cpus usage  
  Sleep(15, 1)
Loop

End
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: ttf examples with sdl and fb native

Post by UEZ »

Windows only:

You can use also the Windows API to display TTF font.

Example using GDIPlus:

Code: Select all

'Example coded by UEZ build 2022-12-08
#include "fbgfx.bi"
#Ifdef __Fb_64bit__
   #Inclib "gdiplus"
   #Include Once "win/gdiplus-c.bi"
#Else
   #Include Once "win/gdiplus.bi"
   Using Gdiplus
#Endif

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 


Function _GDIPlus_Startup() As Bool
	GDIp.GdiplusVersion = 1
	If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
		Error 1
		Return False
	Endif
	Return True
End Function

Sub _GDIPlus_Shutdown()
	GdiplusShutdown(gdipToken)
End Sub

Const w = 1000, h = 600
ScreenControl FB.SET_DRIVER_NAME, "GDI"
ScreenRes w, h, 32

WindowTitle "GDI+ TTF Font Example by UEZ"

Dim as HWND hHWND
ScreenControl(FB.GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr hCanvas, hBrush, hFont, hFamily, hFormat
Dim As GpRectF tLayout
tLayout.x = 0
tLayout.y = 0
tLayout.width = w
tLayout.height = h
	
_GDIPlus_Startup()	'init GDIPlus
GdipCreateFromHWND(hHWND, @hCanvas)	'create canvas not double buffered mapped to FB screen
GdipSetSmoothingMode(hCanvas, 6) '6 = 8x8 anti-aliasing mode for canvas
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit) 'anti-aliasing for font

GdipCreateSolidFill(&hFFFFFFFF, @hBrush)	'create brush handle
GdipCreateStringFormat(0, 0, @hFormat)	'create format handle
GdipCreateFontFamilyFromName("Consolas", 0, @hFamily)	'create familiy handle
GdipCreateFont(hFamily, 50, 0, 3, @hFont)	'create font handle with 50px of size
GdipSetStringFormatAlign(hFormat, StringAlignmentCenter)	'center font H
GdipSetStringFormatLineAlign(hFormat, StringAlignmentCenter)	'center font V
	
GdipDrawString(hCanvas, "Freebasic はクールです。", -1, hFont, @tLayout, hFormat, hBrush)	'draw string to canvas
	
Do
	Sleep(20)
Loop Until Len(Inkey())

'release GDIPlus resources
GdipDeleteBrush(hBrush)
GdipDeleteFontFamily(hFamily)
GdipDeleteStringFormat(hFormat)
GdipDeleteFont(hFont)
GdipDeleteGraphics(hCanvas)
_GDIPlus_Shutdown()
Last edited by UEZ on Dec 09, 2022 23:15, edited 1 time in total.
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: ttf examples with sdl and fb native

Post by Makoto WATANABE »

Dear UEZ;

Thank you for showing us how to use the Windows API.
The first time I used the program you taught me, the expected strings were displayed.
However, after the second time, the screen turns black after the characters are displayed for a moment.
When I restart Windows, the text appears again only the first time.
Please tell me how to modify the program.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: ttf examples with sdl and fb native

Post by UEZ »

This is the disadvantage of GDI+ that the canvas gets erased but you have several ways to workaround it.

This examples works for me on Win11:

Code: Select all

'Example coded by UEZ build 2022-12-09
#Ifdef __Fb_64bit__
   #Inclib "gdiplus"
   #Include Once "win/gdiplus-c.bi"
#Else
   #Include Once "win/gdiplus.bi"
   Using Gdiplus
#Endif
#Include "windows.bi"

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
Dim Shared As Any Ptr hCanvas, hBrush, hFont, hFamily, hFormat
Dim Shared As GpRectF tLayout

Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
	Select Case uMsg
		Case WM_CLOSE
			PostQuitMessage(0)
		Case WM_CREATE
		Case WM_ERASEBKGND
			GdipGraphicsClear(hCanvas, &hFF000000)
			GdipDrawString(hCanvas, "Freebasic はクールです。", -1, hFont, @tLayout, hFormat, hBrush)	'draw string to canvas
			Return 0			
	End Select
	Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Function _GDIPlus_Startup() As Bool
	GDIp.GdiplusVersion = 1
	If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
		Error 1
		Return False
	Endif
	Return True
End Function

Sub _GDIPlus_Shutdown()
	GdiplusShutdown(gdipToken)
End Sub

Dim As Long sW, sH
ScreenInfo(sW, sH)

Const w = 1000, h = 600
Dim as HWND hHWND
Dim wc As WNDCLASSEX
Dim msg As MSG
Dim szAppName As ZString * 6 => "FB GUI"
Dim As String sTitle = "GDI+ TTF Font Example by UEZ"

With wc
	.style			= CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc	= @WndProc
	.cbClsExtra		= NULL
	.cbWndExtra		= NULL
	.hInstance		= GetModuleHandle(NULL)
	.hIcon			= LoadIcon(NULL, IDI_APPLICATION)
	.hCursor		= LoadCursor(NULL, IDC_ARROW)
	.hbrBackground	= GetStockObject(BLACK_BRUSH)
	.lpszMenuName	= NULL
	.lpszClassName	= @szAppName
	.cbSize			= SizeOf(WNDCLASSEX)
End With

RegisterClassEx(@wc)
hHWND = CreateWindowEx(WS_EX_APPWINDOW Or WS_EX_WINDOWEDGE, wc.lpszClassName, sTitle, _
							  WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_SYSMENU Xor WS_MAXIMIZEBOX, _
							  (sW - w) / 2, (sH - h) / 2, _
							  w, h, _
							  NULL, NULL, wc.hInstance, NULL)
ShowWindow(hHWND, SW_SHOW)
							  
tLayout.x = 0
tLayout.y = 0
tLayout.width = w
tLayout.height = h
	
_GDIPlus_Startup()	'init GDIPlus
GdipCreateFromHWND(hHWND, @hCanvas)	'create canvas not double buffered
GdipSetSmoothingMode(hCanvas, 6) '6 = 8x8 anti-aliasing mode for canvas
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit) 'anti-aliasing for font

GdipCreateSolidFill(&hFFFFFFFF, @hBrush)	'create brush handle
GdipCreateStringFormat(0, 0, @hFormat)	'create format handle
GdipCreateFontFamilyFromName("Consolas", 0, @hFamily)	'create familiy handle
GdipCreateFont(hFamily, 50, 0, 3, @hFont)	'create font handle with 50px of size
GdipSetStringFormatAlign(hFormat, StringAlignmentCenter)	'center font H
GdipSetStringFormatLineAlign(hFormat, StringAlignmentCenter)	'center font V

InvalidateRect(hHWND, NULL, TRUE) 'force GUI to be redrawn

While GetMessage(@msg, 0, 0, 0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
Wend

'release GDIPlus resources
GdipDeleteBrush(hBrush)
GdipDeleteFontFamily(hFamily)
GdipDeleteStringFormat(hFormat)
GdipDeleteFont(hFont)
GdipDeleteGraphics(hCanvas)
_GDIPlus_Shutdown()
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: ttf examples with sdl and fb native

Post by Makoto WATANABE »

Dear UEZ;

Thanks for your quick reply.
I was able to display strings.

Image
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

Re: ttf examples with sdl and fb native

Post by thrive4 »

@Makoto WATANABE

> Thank you for your explanation.
Once again you're welcome and a hearty arigato
for adding a screenshot.

I have done some updates and followed your example.

fb ttf example
Image

sdl2 ttf example
Image

fb ttf lib alignment issue example
Image
Post Reply