fonts

[canuck22]

hi newbie here, I am writing a small inventory program in dos running on windows,, problem is how do I make the font larger than 8x16

thanks
peter

[Destructosoft]

The largest text font is 8x16, because text screen technology never advanced beyond 1981. :)

However, graphics fonts are the way to go, provided you use DRAW STRING() instead of PRINT, and of course the graphics screen.

There should be plenty of examples of its use in the manual.

The only drawback is you have to create a font, unless you can find a good royalty-free one somewhere.

Then there's the matter of deciding to make the font monospaced or multiple width. Monospaced (like the 8x8 and 8x16 ones) are excellent and easier to deal with, but in larger fonts they can look clumsy. Multiple width is much better provided you keep track of pixel width of strings as well as ordinary string length.

[dodicat]

hi newbie here, I am writing a small inventory program in dos running on windows,, problem is how do I make the font larger than 8x16

thanks
peter

(IF) you use a graphics screen, (way to go), then you can use these basic extensions of drawstring if you like, royalty free.
Only basic 2d stuff mind you, but no need to load any libraries or whatever, just the first 93 lines of code in this example supplies the dos fonts.

Code: Select all

Sub draw_string(xpos As Integer,ypos As Integer,text As String,colour As Uinteger,size As Single,textangle As Single=0,charangle As Single=0)
    Type point2d
        As Single x,y
        As Uinteger col
    End Type
    Dim As Integer codenum=128            '(Full Asci 256 if required)
    Static As Integer runflag
    Static As point2d infoarray()
    Redim Preserve As point2d infoarray(64,codenum) '64 = 8 x 8 pixel size
    If runflag=0 Then   '                  'scan codenum of codepage once
        Dim As Uinteger background=Rgb(0,0,0)
        Screenres 10,10,32  '8 x 8 pixels on this screen
        Dim count As Integer
        For ch As Integer=1 To codenum
            Cls
            Draw String(1,1),Chr(ch)
            For x As Integer=1 To 8  'scan for characters
                For y As Integer=1 To 8
                    If Point(x,y)<>background Then
                        count=count+1
                        infoarray(count,ch)=Type<point2d>(x,y)'save pixel position
                    End If 
                Next y
            Next x
            count=0
        Next ch
        runflag=1 
    End If
    If size=0 Then Exit Sub
    Dim As point2d temp(1 To 64,codenum),np
    Dim As Single cr= 0.01745329,x1,y1,x2,y2 '(4*atn(1))/180=.017453....
    #macro rotate(p1,p2,a,d)
    np.col=p2.col
    np.x=d*(Cos(a*cr)*(p2.x-p1.x)-Sin(a*cr)*(p2.y-p1.y)) +p1.x
    np.y=d*(Sin(a*cr)*(p2.x-p1.x)+Cos(a*cr)*(p2.y-p1.y)) +p1.y
    #endmacro
    #macro _box()
    Dim As Single dx=x2-x1,dy=y2-y1
    Swap dx,dy:dx=-dx
    Dim As Single p1x=x1+dx/2,p1y=y1+dy/2
    Dim As Single p2x=x1-dx/2,p2y=y1-dy/2
    Dim As Single p3x=x2+dx/2,p3y=y2+dy/2
    Dim As Single p4x=x2-dx/2,p4y=y2-dy/2
    Dim As Uinteger c=Rgb(255,255,254)
    For x As Integer=1 To 2
        Line(p1x,p1y)-(p2x,p2y),c
        Line(p3x,p3y)-(p4x,p4y),c
        Line(p1x,p1y)-(p3x,p3y),c
        Line(p2x,p2y)-(p4x,p4y),c
        Paint((p1x+p2x+p3x+p4x)/4,(p1y+p2y+p3y+p4y)/4),c,c
        c=cpt(z).col
    Next x
    #endmacro
    Dim As point2d cpt(1 To 64),c=Type<point2d>(xpos,ypos),c2
    Dim As Single sz =size/2
    Dim As Integer dx=xpos,dy=ypos,asci
    For z6 As Integer=1 To Len(text)
        asci=Asc(Mid(text,z6,1))
        For x1 As Integer=1 To 64
            temp(x1,asci).x=infoarray(x1,asci).x+dx
            temp(x1,asci).y=infoarray(x1,asci).y+dy
            temp(x1,asci).col=colour
        Next x1
        c2=Type<point2d>(xpos+(size*(z6-1)*8)*Cos(textangle*cr),ypos+(size*(z6-1)*8)*Sin(textangle*cr))
        For z2 As Integer=1 To 64
            rotate(c,temp(z2,asci),textangle,size)
            cpt(z2)=np
            If charangle<>0 Then
                rotate(c2,cpt(z2),charangle,1)
                cpt(z2)=np
            End If
        Next z2
        For z As Integer=1 To 64
            x1=cpt(z).x-sz*(Cos((textangle+charangle)*cr)):y1=cpt(z).y-sz*(Sin((textangle+CHARANGLE)*cr))
            x2=cpt(z).x+sz*(Cos((textangle+charangle)*cr)):y2=cpt(z).y+sz*(Sin((textangle+charangle)*cr))
            If infoarray(z,asci).x<>0 Then 'paint only relevant points 
                If Abs(size)>1 Then
                    _box()
                Else
                    Pset(cpt(z).x,cpt(z).y),cpt(z).col
                End If
            End If
        Next z
        dx=dx+8
    Next z6 
End Sub

Sub init Constructor
    draw_string(0,0,"",0,0)
    Screen 0
End Sub
'________________________________________________________________
'EXAMPLE
screen 20,32
paint(0,0),rgb(100,100,100)
draw_string(20,10,"Size 1",rgb(200,0,200),1)
draw_string(20,30,"Size 2",rgb(200,0,200),2)
draw_string(20,50,"Size .75",rgb(200,0,0),.75)
draw_string(20,70,"Size 2.5, lineangle 45 degrees",rgb(200,100,100),2.5,45)
draw_string(400,20,"Size 2.5, character angle 10",rgb(200,200,100),2.5,0,10)
draw_string(400,50,"Size 1.5, line angle 90, Character angle minus 90",rgb(200,200,200),1.5,90,-90)
draw_string(450,400,"Size 4",rgb(0,200,0),4)

for z as single=5 to 10  
    draw_string(400+2*z,500+2*z,"Good Luck.",rgb(20*z,200-20*z,20*z),8)
    next z
sleep

[D.J.Peters]

only for fun

Joshy

Code: Select all

type Font
  w as integer
  h as integer
  d as any ptr
end type
extern Font8  alias "fb_font_8x8"  as Font
extern Font14 alias "fb_font_8x14" as Font
extern Font16 alias "fb_font_8x16" as Font

sub PrintXY3(byref f       as Font, _
             byval xpos    as integer, _
             byval ypos    as integer, _
             byref text    as string, _
             byval fgcol   as integer=&HFFFFFF, _
             byval bgcol   as integer=-1, _
             byval Size    as integer=1, _
             byval Filled  as integer=1, _
             byval Round   as integer=0 )

  dim as integer i,y,yend,l,code,x,bits,sx
  dim row as ubyte ptr
  l=len(text)-1:if l<0 then exit sub
  yend=f.h-1:if Size<1 then exit sub
  screeninfo sx
  screenlock
  for i = 0 to l
    code=text[i]:code*=f.h:row=f.d+code
    if Size>1 then
      if Filled=0 then
        for y = 0 to yend
          bits=*row 
          for x=0 to 7
            if (bits and 1) then 
              if Round=0 then
                line (xpos+x*size,ypos+y*size)-step(size,size),fgcol,b
              else
                circle (xpos+x*size+size*0.5,ypos+y*size+size*0.5),size*0.5,fgcol
              end if
            elseif bgcol<>-1 then
              if Round=0 then
                line (xpos+x*size,ypos+y*size)-step(size,size),bgcol,b
              else
                circle (xpos+x*size+size*0.5,ypos+y*size+size*0.5),size*0.5,bgcol
              end if
            end if
            bits=bits shr 1
          next
          row+=1
        next
        xpos+=f.w*Size::if (xpos-f.w*Size)>sx then screenunlock:exit sub
      else ' filled
        for y = 0 to yend
          bits=*row 
          for x=0 to 7
            if (bits and 1) then
              if Round=0 then
                line (xpos+x*size,ypos+y*size)-step(size,size),fgcol,bf
              else
                circle (xpos+x*size+size*0.5,ypos+y*size+size*0.5),size*0.5,fgcol,,,,f
              end if
            elseif bgcol<>-1 then
              if Round=0 then
                line (xpos+x*size,ypos+y*size)-step(size,size),bgcol,bf
              else
                circle (xpos+x*size+size*0.5,ypos+y*size+size*0.5),size*0.5,bgcol,,,,f
              end if
            end if
            bits=bits shr 1
          next
          row+=1
        next
        xpos+=f.w*Size:if (xpos-f.w*Size)>sx then screenunlock:exit sub
      end if
    else 'no Size
      for y = 0 to yend
        bits=*row 
        for x=0 to 7
          if (bits and 1) then 
            pset (xpos+x,ypos+y),fgcol
          elseif bgcol<>-1 then
            pset (xpos+x,ypos+y),bgcol
          endif
          bits=bits shr 1
        next
        row+=1
      next
      xpos+=f.w:if (xpos-f.w)>sx then screenunlock:exit sub
    end if

  next
  screenunlock
end sub


dim as integer Size,y,x,filled,round,fgcol,bgcol,c
dim as double  w
screen 19 
'screenres 640,480 ',32
y=0:cls
for Size=1 to 8
  x=0        :printxy3 font14 ,x,y,"8x14 ",1 ,,Size
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",2 ,,Size,0
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",3 ,,Size,1,1
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",4 ,,Size,0,1
  y+=Size*14
next
sleep 3000,1

y=0:cls
for Size=1 to 8
  x=0        :printxy3 font14 ,x,y,"8x14 ",4 ,5,Size
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",3 ,6,Size,0
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",2 ,7,Size,1,1
  x+=Size*8*4:printxy3 font14 ,x,y,"8x14 ",1 ,8,Size,0,1
  y+=Size*14
next
sleep 3000,1

do
  fgcol    = 1+rnd*254
  bgcol    = rnd*2 :if bgcol>1 then bgcol=1 +rnd *254 else bgcol=-1
  while fgcol=bgcol:fgcol= 1+rnd*254:wend
  for filled=1 to 0 step -1
    for round=0 to 1
      for w=-3.14 to 3.14 step 6.28/80
        size=cos(w)*32+33
        cls
        printxy3 font8 ,0,0,"Play with font.",fgcol,bgcol,Size,filled,round
        printxy3 font16,400,400,"Size=" & str(Size),7,,4,0
        sleep 50:if len(inkey) then exit do
      next 
    next
  next
loop
end

[MichaelW]

The largest text font is 8x16, because text screen technology never advanced beyond 1981. :)

Actually, the VGA introduced in 1987 used a 9x16 font, on a 720x400 screen, for the default alphanumeric mode (and also provided the capability to handle user-specified fonts up to 32x32 IIRC).

http://www.freebasic.net/forum/viewtopi ... 0390#80390

[Triopstor]

Thank You dogicat for your code:

I think I'll use it if I can't find my old one from my personal library. I had a program that made different fonts by first printing the font in the bottom left hand corner. Then reading the pixel and doing double, quadruple sizes.


Triopstor.