Error application, help me =(

Blitz3D Forums/Blitz3D Programming/Error application, help me =(

Alexander88

(Posted 2013) [#1]

Hello. Prompt is a piece of code to generate the fonts in .bmp format, but when I run the program fails, tell me how to fix it?

AppTitle("Demo FontGen");name app


End Function

RemiD

(Posted 2013) [#2]

Try this way, it seems to work :

AppTitle("Demo FontGen");name app

; Misc ------------------------------------------------------------------------------------------------------------------------------

;Const GY_Letters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789,./\'#?<>[]();:!?$%^&*+-@~=_|????????????????????????????????"
Const GY_Letters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789,./\'#?<>[]();:!?$%^&*+-@~=_|????????????????????????????????"

; Types -----------------------------------------------------------------------------------------------------------------------------

; Arrays used for creation and saving only. not lookup
Dim Spacing(256)
Dim OffsetX(256)
Dim OffsetY(256)

Name$ = ("Title")
Font$ = Input("Enter Font name:")
;Height$ = Input("Enter size:")
R=(255)
G=(255)
B=(255)
GY_GenerateFont(Name$, Font$, 16, R, G, B)

; Functions -------------------------------------------------------------------------------------------------------------------------

; Returns the width of a text gadget in units if a certain string is applied

; Generates a font texture
Function GY_GenerateFont(Name$, Font$, Height, R, G, B)

	; Load font
	FontHandle = LoadFont(Font$, Height)
	SetFont(FontHandle)

	; Find maximum character width/height
	ShadowSize = Height / 12
	CharWidth = 1
	FH = 1
	For Char = 1 To Len(GY_Letters$)

		; Create 1 tile image with 1 char
		Temp_Image = CreateImage(FontWidth() + 25, FontHeight() + 25)
		SetBuffer(ImageBuffer(Temp_Image))
		Color(0, 0, 0)
		Rect(0, 0, ImageWidth(Temp_Image), ImageWidth(Temp_Image))
		Color(R, G, B)
		Text(0, 0, Mid$(GY_Letters$, Char, 1))
		CharWidth = 0
		AvgWidth = 0

		; Determine width/height
		LockBuffer(ImageBuffer(Temp_Image))
		For i = 0 To ImageWidth(Temp_Image) - 1
			For ii = 0 To ImageHeight(Temp_Image) - 1
				ThisPixel = ReadPixelFast(i, ii)
				RCVal = ThisPixel Shr 0 And 255 Shl 0
				If RCVal <> 0 ; TEXT SPOT.. RECORD WIDTH
					If CharWidth < i Then CharWidth = i
					If FH < ii Then FH = ii
				EndIf
			Next
		Next
		UnlockBuffer(ImageBuffer(Temp_Image))

		FreeImage(Temp_Image)
		SetBuffer(BackBuffer())
		Color(0, 0, 0)
		Rect(0, 0, 256, 256)

		If Char = 1
			CharWidth = FontWidth() / 2
		Else
			CharWidth = CharWidth + 4
		EndIf

		FH = FontHeight()
		If Shadow Then FH = FH + ShadowSize + 2
		Spacing(Char) = CharWidth
		If CharWidth > AvgWidth Then AvgWidth = CharWidth

	Next

	; If it's really wide, add extra rows to reduce final texture width
	ImgWidth = 512
	ImgHeight = 512
   
	; Create temporary stuff
	CharsPerRow = Int(Ceil#(Float#(ImgWidth) / Float#(AvgWidth)))
	Image = CreateImage(ImgWidth, ImgHeight)
	OldBuffer = GraphicsBuffer()
	SetBuffer(ImageBuffer(Image))
   
	; Do each letter one at a time
	X = 0
	Y = 0
	For Char = 1 To Len(GY_Letters$)
		; Draw
		If Shadow
			Color(SR, SG, SB)
			Text(X + ShadowSize, Y + ShadowSize, Mid$(GY_Letters$, Char, 1), 0)
		EndIf
		Color(R, G, B)
		Text(X, Y, Mid$(GY_Letters$, Char, 1), 0)

		; Record place in image that character is stored
		OffsetX(Char) = X
		OffsetY(Char) = Y
		
		; Advance to next letter position
		X = X + Spacing(Char) + 4
		Chc = Chc + Spacing(Char) + 4
		If Chc > (ImgWidth - 72)
			X = 0
			Chc = 0
			Y = Y + Fh
		EndIf
	Next

	; Save
	SaveBuffer(ImageBuffer(Image), Name$ + ".bmp")
	F = WriteFile(Name$ + ".dat")
		WriteShort(F, FH)
		For i = 1 To 256
			WriteInt(F, Spacing(i))
			WriteInt(F, OffsetX(i))
			WriteInt(F, OffsetY(i))
		Next
	CloseFile(F)

	; Free temporary stuff
	SetBuffer(OldBuffer)
	FreeImage(Image)
	FreeFont(FontHandle)

End Function

Please note that the R,G,B values passed to Color() must be integers

Alexander88

(Posted 2013) [#3]

Thanks =)