Sorry your browser is not supported!

; 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

;############################################################################################################