that is my code for blitz3d.
; Font Creator für AGK (C) 2013 bei M.Rauch
; MR 30.01.2013
Graphics 1280,1024,16,2
;Font Namen siehe Corel Draw !
;!!! Standard im Namen weg lassen !!!
.startData
Data "Vivian"
Data "Arial"
Data "Amethyst"
Data "Tahoma"
Data ""
Data "Tahoma"
Data "Bastion"
Data "Alien Encounters"
Data "Allstar"
Data "Amethyst"
Data "Andy"
Data "Arial"
Data "Baby Kruffy"
Data "Bastion"
Data "Freestyle Script"
Data "LCD"
Data "Vivian"
Data "Tahoma"
Data "Edwardian Script ITC"
Data ""
Local Font$="Tahoma" ;"Arial" ;"Sunset-Serial"
Local FontY
Local i,x,y,w,h,xmax#,ymax#,x1,y1,fh
Type bmpFontType
Field x,y,w,h
End Type
Dim bmpFont.bmpFontType (255)
For i=0 To 255
bmpFont.bmpFontType(i)=New bmpFontType
Next
FontY=48
Restore startData
Repeat
Read Font$
DebugLog Font$
If Len(Font$)=0 Then Exit
mfont=LoadFont(Font$,FontY,1)
SetFont mfont
Gosub MakeFont
FreeFont mFont
WaitKey
Forever
End
.MakeFont
x=0
y=0
xmax=0
ymax=0
w=0
h=FontHeight()+2+2
For i=0 To 255
w=StringWidth(Chr(i))+2+2
bmpFont(i)\x=x
bmpFont(i)\y=y
bmpFont(i)\w=w
bmpFont(i)\h=h
x=x+w
If x+w>1024-1 Then ; 1024-1 Then ; 2048-1 Then
xmax=mMax(xmax,x)
x=0
y=y+h
EndIf
Next
xmax=mMax(xmax,x+w)
ymax=mMax(ymax,y+h)
DebugLog xmax +" "+ Int(xmax/32.0)*32
DebugLog ymax +" "+ Int(ymax/32.0)*32
If xmax > Int(xmax/32.0)*32 Then xmax=Int(xmax/32.0)*32+32 ;hinzufügen
If ymax > Int(ymax/32.0)*32 Then ymax=Int(ymax/32.0)*32+32
If xmax < Int(xmax/32.0)*32 Then xmax=Int(xmax/32.0)*32 ;auffüllen
If ymax < Int(ymax/32.0)*32 Then ymax=Int(ymax/32.0)*32
DebugLog "Font Image " + xmax + " x " + ymax
;----------------------------------------------------- Beschreibung speichern für AGK
fh=WriteFile(Font$+Str(fonty)+" subimages.txt")
For i=0 To 255
WriteLine fh,Str(i)+":"+Str(bmpFont(i)\x)+":"+Str(bmpFont(i)\y)+":"+Str(bmpFont(i)\w)+":"+Str(bmpFont(i)\h) ;hatte Streifen wegen Filter darum muß da nen frei Rand drum
Next
CloseFile fh
;----------------------------------------------------- Zeigen
Global bmpfont_img=CreateImage(xmax,ymax)
Global f1=CreateImage(xmax,ymax)
Global f2=CreateImage(xmax,ymax)
SetBuffer ImageBuffer(bmpfont_img)
ClsColor 255,0,255
Cls
For i=0 To 255
Color 255,255,0 ;Rand
;Rect bmpFont(i)\x,bmpFont(i)\y,bmpFont(i)\w,bmpFont(i)\h,0
Color 0,0,0 ;Rand
For x1=-1 To 1
For y1=-1 To 1
Text bmpFont(i)\x+1+1+x1,bmpFont(i)\y+1+1+y1,Chr(i)
Next
Next
Color 255,255,255
Text bmpFont(i)\x+1+1,bmpFont(i)\y+1+1,Chr(i)
Next
;SetBuffer FrontBuffer()
;DrawImage bmpFont_img,0,0
;WaitKey
;End
;---------------------------------------------------------
; Farbverlauf :-)))
;---------------------------------------------------------
MaskImage bmpFont_img,255,255,255
SetBuffer ImageBuffer(f1)
ClsColor 255,255,255
Cls
If 1=0 Then ;Farbverlauf Ja/Nein
imgBG=LoadImage("FILL\b1.bmp") ;White.bmp b1.bmp cc085217.jpg cc063154.jpg cc063038.jpg
;ResizeImage imgBG,ImageWidth(f1),ImageHeight(f1)
TileImage imgBG
;DrawBlock imgBG,0,0
Else
Local r#,g#,b#
Local yl=0
Local f#=bmpFont(0)\h / (255.0/9.5) ;12.0 hier enger oder auseinander
Local wi#
DebugLog "f=" +f
DebugLog "ImageHeight(f1) = "+ImageHeight(f1)
For y=1 To ImageHeight(f1)
If yl=0 Then
r=255;255/4
g=255;255/4
b=255;255/4
EndIf
wi=Float(yl)*(180.0/bmpFont(0)\h)
;r=16.0+Sin(wi)*160.0
;g=16.0+Sin(wi)*160.0
;b=16.0+Sin(wi)*160.0
r=r-2*f
g=g-2*f
b=b-2*f
If r<0 Then r=0
If g<0 Then g=0
If b<0 Then b=0
If r>255 Then r=255
If g>255 Then g=255
If b>255 Then b=255
Color r,g,b
Line 0,y-1,ImageWidth(f1)-1,y-1
yl=yl+1
If yl=bmpFont(0)\h Then yl=0
Next
EndIf ;Farbverlauf
DrawImage bmpFont_img,0,0
MaskImage f1,255,0,255
SetBuffer ImageBuffer(bmpFont_img)
DrawImage f1,0,0
;---------------------------------------------------------
SaveBuffer ImageBuffer(bmpFont_img),Font$+Str(fonty)+".bmp"
;---------------------------------------------------------
SetBuffer FrontBuffer()
ClsColor 50,100,50
Cls
MaskImage bmpFont_img,255,0,255
DrawImageRect bmpFont_img,0,0,0,0,GraphicsWidth(),GraphicsHeight()/2 ;zur hälfte zeigen reicht ja wohl
bmpText 32,GraphicsHeight()/2,"0123456789 B B B Hallo du wie geht es dir ??? ÄÖÜ äöü für -=" ;Test Text ausgeben :-)
Return
;############################################################################################################
Function mMax#(a#, b#)
;MR 22.06.2003
If a > b Then
Return a
Else
Return b
End If
End Function
;############################################################################################################
Function bmpText (x,y,t$,centerx=0,centery=0)
If bmpfont_img=0 Then Return 0
If Len(t$)=0 Then Return 0
If centerx Then x=x-bmpTextWidth(t$)/2
If centery Then y=y-bmpFont(0)\h/2
Local i,p
For i=1 To Len(t$)
p=Asc(Mid(t$,i,1))
DrawImageRect bmpFont_img,x,y,bmpFont(p)\x,bmpFont(p)\y,bmpFont(p)\w,bmpFont(p)\h
x=x+bmpFont(p)\w ;add FontSpace here +2 or so
Next
Return True
End Function
;############################################################################################################
Function bmpTextWidth(t$)
If Len(t$)=0 Then Return 0
Local i,p,x=0
For i=1 To Len(t$)
p=Asc(Mid(t$,i,1))
x=x+bmpFont(p)\w ;add FontSpace here +2 or so
Next
Return x
End Function
;############################################################################################################
Function bmpTextHeight()
Return bmpFont(0)\h
End Function
;############################################################################################################
AGK 108 (B)19 : Windows 8.1 Pro 64 Bit : AMD Radeon HD 6670
