custom font in window app?

Just starting out? Need help? Post your questions and find answers here.
hss
User
User
Posts: 69
Joined: Thu Mar 08, 2007 6:02 pm

custom font in window app?

Post by hss »

hello.

is it possible to include a custom font into the exe and work with it?
like ..includebinary "font.[otf|ttf|fon]" ..loadfont..

thanks!
-hss
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Code: Select all

;===================================================================================
; Program:          Font Resource Demo
; Author:           netmaestro 
; Date:             April 7, 2007
; Target OS:        Microsoft Windows All
; Target Compiler:  PureBasic 4.0 and later
; License:          Free, unrestricted, credit appreciated
;                   but not required
;
; Find test font at: http://simplythebest.net/fonts/fonts/iron_maiden.html
;
;====================================================================================
;
Procedure InstallIncludedFont(*memstart, length, fontfilename$)

  Protected i = 1, lib, tmp, testfont, notok = #True
  
  lib = OpenLibrary(#PB_Any, "Gdi32.dll") ; For Win2000/XP and later
  If lib
    proc.l = GetFunction(lib, "AddFontMemResourceEx") 
    If proc 
      CallFunction(lib, "AddFontMemResourceEx", ?font1_start, length, 0, @i) 
      notok = #False 
    EndIf 
    CloseLibrary(lib) 
  EndIf 
  
  If notok ; Necessary for Win9x
    tmp = CreateFile(#PB_Any, GetTemporaryDirectory()+fontfilename$) 
    If tmp
      WriteData(tmp, ?font1_start, ?font1_end - ?font1_start) 
      CloseFile(tmp) 
      AddFontResource_(GetTemporaryDirectory()+fontfilename$) 
      SendMessage_(#HWND_BROADCAST, #WM_FONTCHANGE, 0, 0) 
    Else 
      ProcedureReturn 0
    EndIf 
  EndIf 
  
  ProcedureReturn 1
  
EndProcedure

If InstallIncludedFont(?font1_start, ?font1_end-?font1_start, "maiden.ttf")
 
  OpenWindow(0,0,0,640,480,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  CreateGadgetList(WindowID(0))
  If LoadFont(1, "Iron Maiden", 24) 
    SetGadgetFont(#PB_Default, FontID(1)) 
    TextGadget(0,100,50,400,40,"This is a test") 
  EndIf 
  Repeat:Until WaitWindowEvent()=#WM_CLOSE
  
Else
  MessageRequester("OOPS!", "Couldn't load the font!", $C0)
EndIf

DataSection 
  font1_start: 
  IncludeBinary "d:\maiden.ttf" ; adjust this to the location on your machine
  font1_end: 
EndDataSection 
BERESHEIT
hss
User
User
Posts: 69
Joined: Thu Mar 08, 2007 6:02 pm

Post by hss »

thanks, sir - it works.
i use unibody from underware(TM) (http://underware.nl/site2/index.php3?id ... 2=overview)

well, as my app reqs a least win2k, i don't the the win9x proc..
here's my snippet:

Code: Select all


If(OpenLibrary(0,"GDI32.DLL"))
CallFunction(0,"AddFontMemResourceEx",?fs,(?fe-?fs),0,@i+1):CloseLibrary(0)
Else:MessageRequester("E.R.R.O.R.","font problem..."):End:EndIf


OpenWindow(0,0,0,300,300,"T.E.S.T.",#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))

LoadFont(1,"Unibody 8",6):SetGadgetFont(#PB_Default,FontID(1))
TextGadget(0,100,50,400,40,"TEST, TEST -- WORKS? YES.")

Repeat:Delay(5):Until(WaitWindowEvent()=#WM_CLOSE)


DataSection
fs:
IncludeBinary("c:\unibody.otf")
fe:
EndDataSection 

Post Reply