Request Windows Font / Draw Text

BlitzMax Forums/MaxGUI Module/Request Windows Font / Draw Text

Clyde

(Posted 2014) [#1]

Hi,

I'm trying to load a font image so that I can draw text to a canvas. I was using blitplus, but it displays text with a weird anti aliasing colour.

And as the request font in maxgui doesn't let you use that font with drawtext, I found some great code by Neilo - http://www.blitzbasic.com/Community/posts.php?topic=57224#bottom

However, the font never gets loaded / created. I've put in what I think are checks for a null object, but that's not working as expected. I'm new to using bmax / maxgui stuff, so go easy on me! ;) The test code I knocked up from the examples included with bmax.

And I don't want to use other peoples modules,if I can help it even though their great and all, I never get them to sync or interface properlly.

Here's the codes. And I really appreciate the help!!
-Clyde.

Test Code

SuperStrict 

Import MaxGui.Drivers
Import BRL.freetypefont

Include "neilo - request windows font.bmx"

Const LOAD_FONT:Int=1
Const EXIT_PROG:Int=2

Global app_window:TGadget
Global app_canvas:TGadget

Global app_menu:TGadget
Global file_menu:TGadget

Global image_font:Timagefont
Global true_type_font:WindowsFont

init_app()
main_app()


Function main_app()

	While WaitEvent()

		Select EventID()

			Case EVENT_GADGETPAINT
		
				Select EventSource()
				
					Case app_canvas
						'
						' Draw to the canvas
						SetGraphics CanvasGraphics(app_canvas)
						Cls
						
							If ( image_font ) Then
						
								SetImageFont( image_font )
							
							End If	
							
							SetColor 255,255,255
							DrawText "example text",0,0
						
							'End If
						
						Flip	
						RedrawGadget ( app_canvas )
						
				End Select
					
		Case EVENT_WINDOWCLOSE
			'
			' Quit
			End
			
		Case EVENT_WINDOWACCEPT

		
		Case EVENT_MENUACTION
			'
			' Menu stuff
			Select EventData()
			
				Case LOAD_FONT
					
					Local cx:Int=ClientWidth	(Desktop())/2 - 269 / 2
					Local cy:Int=ClientHeight	(Desktop())/2 - 234 / 2

					
					true_type_font=RequestWindowsFont( cx, cy, Null )', true_type_font )
					
					If ( true_type_font=Null ) Then
						Notify "null object"
					End If
					
					load_image_font( true_type_font )
					
					
				Case EXIT_PROG
					End
				
			End Select
		
		
		EndSelect
		
	Wend 

EndFunction


Function load_image_font( font_name:WindowsFont )
	
	image_font=LoadImageFont( font_name.name, font_name.size )
	
	If (image_font=Null ) Then
		Notify "creation unsuccessfull"
	End If
	
End Function


Function init_app()

	graphics_gui("draw text to canvas",640,480)

End Function

Function graphics_gui( title:String, wwidth:Int, height:Int )

	Local cx:Int =ClientWidth	(Desktop())/2 - wwidth/2
	Local cy:Int =ClientHeight	(Desktop())/2 - height/2
	
	app_window=CreateWindow( title, cx, cy, wwidth, height )

	app_canvas=CreateCanvas( 0, 0, ClientWidth(app_window),ClientHeight(app_window), app_window )

	app_menu	=WindowMenu(app_window)
	file_menu	=CreateMenu("&File",0, WindowMenu(app_window))
	
	CreateMenu("&Load Font"	,LOAD_FONT, file_menu)
	CreateMenu("E&xit"		,EXIT_PROG, file_menu)
	
	UpdateWindowMenu( app_window )

End Function

Request Windows Font - Neilo

'
' http://www.blitzbasic.com/Community/posts.php?topic=57224#bottom
'
Type WindowsFont
	Field name:String
	Field fullPath:String
	Field size:Int
End Type

Function RequestWindowsFont:WindowsFont(x:Int,y:Int,font:WindowsFont)
	Local win:TGadget
	Local btnOk:TGadget
	Local btnCancel:TGadget
	Local lstFontNames:TGadget
	Local lstFontSizes:TGadget
	Local tbFontSize:TGadget
	Local canSample:TGadget
	Local fontPath:String
	Local fontDirHandle:Int
	Local fileName:String
	Local quit:Int
	Local iFont:TImageFont
	Local i:Int
	Local winFont:WindowsFont
	Local defaultFontSizes:Int[]=[8,10,12,14,18,24,36,48,72]
	
	Function renderSampleText(gr:TGraphics,font:TImageFont)
		Local width:Int,tWidth:Int
		Local height:Int,tHeight:Int
		Local x:Int,y:Int
		
		SetGraphics gr
		width=GraphicsWidth()
		height=GraphicsHeight()
		SetImageFont font
		
		tWidth=TextWidth("Sample")
		tHeight=TextHeight("Sample")
		x=(width-tWidth)/2
		y=(height-tHeight)/2
		Cls
		DrawText "Sample",x,y
		Flip
		
	End Function
	
	win=CreateWindow("Select Font",x,y,269,234,Null,WINDOW_TITLEBAR|WINDOW_CLIENTCOORDS)
	lstFontNames=CreateListBox(3,3,200,140,win)
	tbFontSize=CreateTextField(GadgetX(lstFontNames)+GadgetWidth(lstFontNames)+3,..
							   GadgetY(lstFontNames),60,22,win)
	lstFontSizes=CreateListBox(GadgetX(tbFontSize),GadgetY(tbFontSize)+26,60,..
							   GadgetHeight(lstFontNames)-25,win)
	canSample=CreateCanvas(3,146,263,60,win)
	btnOk=CreateButton("Ok",206,209,60,22,win)
	btnCancel=CreateButton("Cancel",143,209,60,22,win)
	
	fontPath=getenv_("windir")
	fontPath:+"\Fonts\"
	fontDirHandle=ReadDir(fontPath)
	Repeat
		fileName=NextFile(fontDirHandle)
		Select fileName
			Case ""
			Case "."
			Case ".."
			Default
				If Right(fileName,3)="ttf" Then ..
					AddGadgetItem lstFontNames,fileName
		End Select
	Until fileName=""
	
	For i=0 To defaultFontSizes.length-1
		AddGadgetItem lstFontSizes,defaultFontSizes[i]
	Next
	SetGadgetText tbFontSize,"16"
	
	quit=False
	While Not quit
		WaitEvent
		Select EventID()
			Case EVENT_GADGETACTION
				Select EventSource()
					Case lstFontNames
						i=SelectedGadgetItem(lstFontNames)
						If i>-1
							fileName=fontPath+GadgetItemText(lstFontNames,i)
							iFont=LoadImageFont(fileName,TextFieldText(tbFontSize).ToInt())
							renderSampleText CanvasGraphics(canSample),iFont
						EndIf
					Case lstFontSizes
						i=SelectedGadgetItem(lstFontSizes)
						If i>-1
							SetGadgetText tbFontSize,GadgetItemText(lstFontSizes,i)
							iFont=LoadImageFont(fileName,TextFieldText(tbFontSize).ToInt())
							renderSampleText CanvasGraphics(canSample),iFont
						EndIf
					Case btnOk
						i=SelectedGadgetItem(lstFontNames)
						If i>-1
							winFont=New WindowsFont
							winFont.name=GadgetItemText(lstFontNames,i)
							winFont.fullPath=fontPath+GadgetItemText(lstFontNames,i)
							winFont.size=TextFieldText(tbFontSize).ToInt()
							quit=True
						EndIf
					Case btnCancel
						winFont=Null
						quit=True
				End Select
			Case EVENT_WINDOWCLOSE
				Select EventSource()
					Case win
						quit=True
						winFont=Null
				End Select
			Case EVENT_GADGETPAINT
				Select EventSource()
					Case canSample
						renderSampleText CanvasGraphics(canSample),iFont
				End Select
		End Select	
	Wend
	FreeGadget win
	Return winFont
End Function

'RequestWindowsFont 40,40,Null

Cheers!!! :)