how use windows truetype fonts in freebasic

New to FreeBASIC? Post your questions here.
Apostasio
Posts: 3
Joined: Feb 14, 2015 10:31

how use windows truetype fonts in freebasic

Postby Apostasio » Feb 27, 2015 18:20

Is there any way to use text characters more pleasant than those presented by default?

I do not know how to print via the GUI strings with ttf character, I tried to install truetype2 but I get added to a graphics program truetype text. Any tips on?

regards
TJF
Posts: 3467
Joined: Dec 06, 2009 22:27
Location: N47°, E15°

Re: how use windows truetype fonts in freebasic

Postby TJF » Feb 27, 2015 21:23

Hello Apostasio, welcome at the forum!

There're hundred ways to use vector fonts. It's impossible to guess what you need. So give us more information

  • Do you need simple ASCII characters only
  • Do you need native characters in several language (cyrilic, chinese, ...)
  • Do you need right to left formating (arabic style)
  • ...
The simple start is the toy text API of cairo grafics library. Find example code in the binding package


BR
Apostasio
Posts: 3
Joined: Feb 14, 2015 10:31

Re: how use windows truetype fonts in freebasic

Postby Apostasio » Mar 03, 2015 5:06

First thank you for your reply, I must say that so far all I've seen FreeBasic seemed good. Except the treatment of graphical text. I need to perform some data tracking applications and try nice present to the user why should I use truetype or similar.
dodicat
Posts: 5771
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: how use windows truetype fonts in freebasic

Postby dodicat » Mar 03, 2015 10:53

Mysoft created this method way back.

With his kind permission, I'll pass it on to save you hunting around.
I have used five font types, you can use any of the others available in Windows.

Code: Select all

'====================================
'Fonts  by MYSOFT.
'====================================

#include "windows.bi"
#include "fbgfx.bi"

enum
  FS_BOLD = 2
  FS_ITALIC = 4
  FS_ANTIALIAS = 8
  FS_BLUR = 16+8
End enum

Sub DrawFont(byref BUFFER As Any Ptr=0,byval POSX As Integer, byval POSY As Integer, _
  byref FTEXT As String, byref FNAME As String,byval FSIZE As Integer, _
 byval FCOLOR As Uinteger=rgba(255,255,255,0),byval FSTYLE As Integer=0,byval CHARSET As Integer=DEFAULT_CHARSET )
  Static FINIT As Integer
  Static As hdc THEDC
  Static As hbitmap THEBMP
  Static As Any Ptr THEPTR
  Static As fb.image Ptr FBBLK
  Static As Integer WIDCHAR(65535)
  Static As Integer TXTSZ,COUNT,RESU,RESUU
  Static As Any Ptr SRCBUF,DSTBUF
  Static As hfont THEFONT
  Static As Integer FW,FI,TXYY,FCOR
  Static DSKWND As hwnd, DSKDC As hdc
  Static MYBMPINFO As BITMAPINFO
  Static As TEXTMETRIC MYTXINFO
  Static As SIZE TXTSIZE
  Static As RECT RCT
 #define GAMMA 1.3
  #define FontSize(PointSize) -MulDiv(PointSize, GetDeviceCaps(THEDC, LOGPIXELSY), 72)
 
  If FINIT = 0 Then   
    FINIT = 1   
    With MYBMPINFO.bmiheader
      .biSize = sizeof(BITMAPINFOHEADER)
      .biWidth = 2048
      .biHeight = -513
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = BI_RGB
    End With   
    DSKWND = GetDesktopWindow()
    DSKDC = GetDC(DSKWND)
    THEDC = CreateCompatibleDC(DSKDC)
    THEBMP = CreateDIBSection(THEDC,@MYBMPINFO,DIB_RGB_COLORS,@THEPTR,null,null) 
    ReleaseDC(DSKWND,DSKDC)   
  End If
  If (FSTYLE And FS_BOLD) Then FW = FW_BOLD Else FW = FW_NORMAL   
  If (FSTYLE And FS_ITALIC) Then FI = True Else FI = False   
  THEFONT = CreateFont(FontSize(FSIZE),0,0,0,FW,FI,0,0,CHARSET,0,0,0,0,cast(Any Ptr,Strptr(FNAME)))   
  SelectObject(THEDC,THEBMP)
  SelectObject(THEDC,THEFONT)
  GetTextMetrics(THEDC,@MYTXINFO)
  GetTextExtentPoint32(THEDC,Strptr(FTEXT),Len(FTEXT),@TXTSIZE)
  TXTSZ = TXTSIZE.CX
  TXYY = TXTSIZE.CY
  If (FSTYLE And FS_ITALIC) Then
    If MYTXINFO.tmOverhang Then
      TXTSZ += MYTXINFO.tmOverhang
    Else
      TXTSZ += 1+(FSIZE/2)
    End If
    TXYY += 1+(FSIZE/8)
  End If
  If (FSTYLE And FS_ANTIALIAS) Then
    #if GAMMA>1 And GAMMA <= 2
    TXTSZ += GAMMA*2
    #endif
  End If
  With RCT
    .LEFT = 0
    .TOP = 1
    .RIGHT = TXTSZ
    .BOTTOM = TXYY+1
  End With
  TXTSZ -= 1
  TXYY -= 1
  asm
    mov eax,[FCOLOR]
    And eax,0xFFFFFF
    mov [FCOR],eax
    bswap eax
    ror eax,8
    mov [FCOLOR],eax
  End asm
  SetBkColor(THEDC,rgba(255,0,255,0))
  SetTextColor(THEDC,FCOLOR)
  SystemParametersInfo(SPI_GETFONTSMOOTHING,null,@RESU,null)
  If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,False,@RESUU,null)
  ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)
  If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,True,@RESUU,null)
  FBBLK = THEPTR+(2048*4)-sizeof(fb.image)
  FBBLK->type = 7
  FBBLK->bpp = 4
  FBBLK->width = 2048
  FBBLK->height = 512
  FBBLK->pitch = 2048*4
  If (FSTYLE And FS_ANTIALIAS) Then
    Dim As Any Ptr MYBLK
    MYBLK = THEPTR+(2048*4)
    asm
      mov ecx,2048*511
      mov ebx,[FCOR]
      mov esi,[MYBLK]     
      HERE:
      cmp [esi], dword Ptr 0xFF00FF     
      je _TRANS_
      mov [esi+3], Byte Ptr 0xFF     
      _TRANS_:     
      And [esi], dword Ptr 0xFF000000
      Or [esi], ebx
      add esi,4
      dec ecx
      jnz HERE
    End asm
   
    Dim As Integer TX,TY
    Dim As Integer ALP
    #define GetAlpha(PX,PY) Peek(MYBLK+((PY)*8192)+((PX)*4)+3)
    #define SetAlpha(PX,PY,NA) Poke(MYBLK+((PY)*8192)+((PX)*4)+3),NA
    If (FSTYLE And FS_BLUR) = FS_BLUR Then
      For TX = 1 To TXTSZ-1
        ALP = (GetAlpha(TX,0)+GetAlpha(TX+1,0)+GetAlpha(TX-1,0)+ _
        GetAlpha(TX,1)+GetAlpha(TX-1,1)+GetAlpha(TX+1,1)) / 6
        #if GAMMA>1 And GAMMA <= 1.6
        ALP *= (GAMMA+.5)
        If ALP > 255 Then ALP = 255
        #endif
        SetAlpha(TX,TY,ALP)
      Next TX
      For TX = 1 To TXTSZ-1
        For TY = 1 To TXYY-1         
          ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+ _
          GetAlpha(TX,TY-1)+GetAlpha(TX,TY+1) + _
          GetAlpha(TX-1,TY-1)+GetAlpha(TX-1,TY+1)+ _
          GetAlpha(TX+1,TY-1)+GetAlpha(TX+1,TY+1)) / 9
          #if GAMMA>1 And GAMMA <= 1.6
        ALP *= (GAMMA+.5)
        If ALP > 255 Then ALP = 255
        #endif
          SetAlpha(TX,TY,ALP)
        Next TY
      Next TX
      For TX = 1 To TXTSZ-1
        ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+ _
        GetAlpha(TX,TY-1)+GetAlpha(TX-1,TY-1)+GetAlpha(TX+1,TY-1)) / 6
        #if GAMMA>1 And GAMMA <= 1.6
        ALP *= (GAMMA+.5)
        If ALP > 255 Then ALP = 255
        #endif
        SetAlpha(TX,TY,ALP)
      Next TX
    Else     
      For TX = 1 To TXTSZ-1
        ALP = (GetAlpha(TX,0)+GetAlpha(TX+1,0)+_
        GetAlpha(TX-1,0)+GetAlpha(TX,1))/4       
        #if GAMMA>1 And GAMMA <= 2
        ALP *= GAMMA
        If ALP > 255 Then ALP = 255
        #endif       
        SetAlpha(TX,TY,ALP)
      Next TX
      For TX = 1 To TXTSZ-1
        For TY = 1 To TXYY-1
          ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+_
          GetAlpha(TX,TY-1)+GetAlpha(TX,TY+1))/5
          #if GAMMA>1 And GAMMA <= 2
          ALP *= GAMMA
          If ALP > 255 Then ALP = 255
          #endif         
          SetAlpha(TX,TY,ALP)         
        Next TY
      Next TX
      For TX = 1 To TXTSZ-1
        ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+ _
        GetAlpha(TX-1,TY)+GetAlpha(TX,TY-1))/4       
        #if GAMMA>1 And GAMMA <= 2
        ALP *= GAMMA
        If ALP > 255 Then ALP = 255
        #endif       
        SetAlpha(TX,TY,ALP)
      Next TX
    End If
    Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),alpha
  Else
    Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),trans
  End If
  DeleteObject(THEFONT)
End Sub

'======================================================
screen 20,32
dim as string TNR="Times New Roman"
dim  as string CSM="Comic Sans MS"
dim as string CN="Courier New"
dim as string A="Arial"
dim as string V="Vivaldi"

drawfont(,10,10,"Hello World!",TNR,50)
drawfont(,10,90,"Hello World!",CSM,40,rgb(0,200,0))
drawfont(,10,200,"Hello World!",CN,30,rgb(200,0,0),FS_BOLD)
drawfont(,10,250,"Hello World!",A,60,rgb(200,100,0),FS_ANTIALIAS or FS_ITALIC)
drawfont(,10,350,"Hello World!",V,70,rgb(200,100,100),FS_BLUR)
drawfont(,10,550,"Hello World!",TNR,10)

draw string(10,600),"Goodbye"



sleep
 
Apostasio
Posts: 3
Joined: Feb 14, 2015 10:31

Re: how use windows truetype fonts in freebasic

Postby Apostasio » Mar 03, 2015 11:43

Great example, is an ideal starting point for my program. I am very grateful for your help.
a greeting
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: how use windows truetype fonts in freebasic

Postby fxm » Mar 03, 2015 12:11

The above program does not compile with fbc 1.02.0.
Weird error message:
.....\FBIde0.4.6r4_fbc1.02.0\FBIDETEMP.bas(94) error 145: Only valid in -lang deprecated or fblite or qb in 'ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)'
dodicat
Posts: 5771
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: how use windows truetype fonts in freebasic

Postby dodicat » Mar 03, 2015 12:22

OK here fxm with 1.02.0 (downloaded a few days ago)
-- and I believe we both use a similar system, unless you have bought a new computer?

...

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.02.0 (02-18-2015), built for win32 (32bit)
OS: Windows XP (build 2600, Service Pack 3)

...
Drago
Posts: 115
Joined: Aug 10, 2005 13:15

Re: how use windows truetype fonts in freebasic

Postby Drago » Mar 03, 2015 12:28

Here is also ok.

C:\FreeBasic>fbc --version
FreeBASIC Compiler - Version 1.02.0 (02-12-2015), built for win32 (32bit)
Copyright (C) 2004-2015 The FreeBASIC development team.
standalone

Geany:

c:\FreeBasic\fbc -exx -w all "DrawFont.bas" (im Verzeichnis: C:\FreeBasic\Test)
Kompilierung erfolgreich beendet.
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: how use windows truetype fonts in freebasic

Postby fxm » Mar 03, 2015 13:02

fxm wrote:The above program does not compile with fbc 1.02.0.
Weird error message:
.....\FBIde0.4.6r4_fbc1.02.0\FBIDETEMP.bas(94) error 145: Only valid in -lang deprecated or fblite or qb in 'ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)'

dkl,
The compilation fails only when I use the new Windows API headers win32 (2015-01-12), from your post:
viewtopic.php?p=204201#p204201
available at:
http://sourceforge.net/projects/fbc/fil ... %20Builds/


[edit]
That compiles and runs if, at line #94, I replace ExtTextOut() with ExtTextOutA() or ExtTextOut_() (but only with these new headers).
wingdi.bi (2015-01-12) ?????
.....
#define EXTTEXTOUT 512
.....
dkl
Site Admin
Posts: 3206
Joined: Jul 28, 2005 14:45
Location: Germany

Re: how use windows truetype fonts in freebasic

Postby dkl » Mar 03, 2015 15:17

Ok, thanks for testing the new Windows API headers, that issue should be fixed in the next update. (the problem is the name conflict between the #define EXTTEXTOUT constant and the #define ExtTextOut function, so one of them must be renamed, but it shouldn't be ExtTextOut because it's a pretty important function)
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: how use windows truetype fonts in freebasic

Postby fxm » Mar 03, 2015 19:24

Before, 'EXTTEXTOUT_' was the constant!
dodicat
Posts: 5771
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: how use windows truetype fonts in freebasic

Postby dodicat » Mar 03, 2015 19:52

I will now use the updated headers, previously I didn't.

I take it the repair will use EXTTEXTOUT() as the function, so Mysoft's code still will stand as it is?

There are so many bits of Freebasic now, hard to get cutting edge compiler with the cutting edge headers and libraries.

Even hard to get the older libraries.

Couldn't the important links be included in the Git Builds thread.
Just so members like myself have access without necessarily building from source?
dkl
Site Admin
Posts: 3206
Joined: Jul 28, 2005 14:45
Location: Germany

Re: how use windows truetype fonts in freebasic

Postby dkl » Mar 03, 2015 20:22

I'm working on a second update to the new winapi headers, then I think they can be added to fbc's Git master branch, then they will appear in the Git builds too. I just didn't want to add the most-likely-to-be-broken initial update there immediately before any testing was done...
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: how use windows truetype fonts in freebasic

Postby fxm » Mar 03, 2015 21:21

I am presently using the test build from:
http://sourceforge.net/projects/fbc/fil ... rce=navbar
updated with the last stw build from:
http://users.freebasic-portal.de/stw/builds/
BasicCoder2
Posts: 3349
Joined: Jan 01, 2009 7:03

Re: how use windows truetype fonts in freebasic

Postby BasicCoder2 » Mar 03, 2015 22:22

dodicat wrote:Mysoft created this method way back.

There are probably many little gems like that which are buried beyond reach unless you were there at the time to save it yourself or just luck on the right search words. This one goes in my windows snippets folder just in case ...
Thanks for posting and thanks to mysoft.

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 1 guest