FreeBasic

Отличный пример создания шрифтов для функции Draw String. 
Платформы: Windows , Linux
Автор: dodicat, создано в 2011 году.

Type point2d
    As Single x,y
    As Uinteger col
End Type

Type retainer
    As Single minx,miny,maxx,maxy
    As Long pixels
End Type

Declare Function rotatepoint2d(pivot As point2d,_
_point As point2d,_
angle As Double,_
dilator As double=1) As point2d
Declare Sub scan_for_image(background As Uinteger,c As retainer)
Declare  Sub scaleimage(pivot As point2d,size As Single,angle As Double)
Declare Sub drawfont(x As Integer,_
y As Integer,_
text As String,_
colour As Uinteger,_
size As Single,_
angle As single=0)

Redim Shared As point2d infoarray(0)           'required in all cases
Dim Shared As Uinteger background               ' -''-
background=rgb(255,255,255)                    'optional colour

'__________________________________________________
Screen 19,32',,1                               'fullscreen if wanted
Paint (0,0),background                         'optional

Draw String (100,10),"normal size",Rgb(0,0,200)
drawfont(100,50,"Two times size",Rgb(200,0,0),2)
drawfont(100,100,"Four times size",Rgb(255,200,0),4)
drawfont(10,200,"3.5 times size at 10 degrees",Rgb(0,200,0),3.5,10)
drawfont(0,400,"GOODNIGHT! (5 Times)",Rgb(0,0,0),5)
Sleep

'________________________________________________

'To scale/rotate
Function rotatepoint2d(pivot As point2d,_
    _point As point2d,_
    angle As Double,_
    dilator As double=1) As point2d
    Dim pi As Double=4*Atn(1)
    #DEFINE rad *pi/180

    Dim As point2d np=_point
    np.x=dilator*(Cos(angle rad)*(_point.x-pivot.x)-Sin(angle rad)*(_point.y-pivot.y)) +pivot.x
    np.y=dilator*(Sin(angle rad)*(_point.x-pivot.x)+Cos(angle rad)*(_point.y-pivot.y)) +pivot.y
    Return np
End Function

'pixel scan across text
Sub scan_for_image(background As Uinteger,c As retainer)
    Dim count As Long


    For x As Integer=c.minx To c.maxx Step 1

        For y As Integer=c.miny To c.maxy Step 1

            If Point(x,y)<>background Then

                count=count+1

                Redim Preserve infoarray(count)
                infoarray(count).x=x
                infoarray(count).y=y
                infoarray(count).col=Point(x,y)
            End If

        Next y
    Next x
End Sub


'draw the new font
Sub scaleimage(pivot As point2d,size As Single,angle As Double)
    Dim As point2d cpt(Ubound(infoarray))
    For z As Integer=1 To Ubound (infoarray)
        cpt(z)=rotatepoint2d(pivot,infoarray(z),angle,size)
    Next z
    'DRAW
    Dim sz As single=size/2

    For z As Integer=1 To Ubound(infoarray)

        Line(cpt(z).x-sz,cpt(z).y-sz)-(cpt(z).x+sz,cpt(z).y+sz),cpt(z).col,BF
    Next z
End Sub


Sub drawfont(x As Integer,y As Integer,text As String,colour As Uinteger,size As Single,angle As single=0)
    Dim As Integer xres,yres
    'dim as uinteger background=rgb(0,0,1)
    Screeninfo xres,yres
    Dim c As point2d
    c=type<point2d>(x,y)
    Dim  scanline As retainer
    scanline= Type<retainer>(x,y,8*size*len(text),y+8*size)
    Line(scanline.minx,scanline.miny)-(scanline.maxx,scanline.maxy),background,BF
    Draw String(x,y),text,colour
    scan_for_image(background,scanline)
    Draw String(x,y),text,background
    scaleimage(c,size,angle)
End Sub