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
fonts
-
- Posts: 88
- Joined: Apr 03, 2011 3:44
- Location: Inside the bomb
- Contact:
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.
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.
Re: fonts
(IF) you use a graphics screen, (way to go), then you can use these basic extensions of drawstring if you like, royalty free.canuck22 wrote: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
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
-
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
only for fun
Joshy
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
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).Destructosoft wrote:The largest text font is 8x16, because text screen technology never advanced beyond 1981. :)
http://www.freebasic.net/forum/viewtopi ... 0390#80390
Re: fonts
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.
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.