Request Windows Font / Draw Text
BlitzMax Forums/MaxGUI Module/Request Windows Font / Draw Text
| ||
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!!! :) |