I can add a font to ONE control using this code, adding the font to more than one control makes Blitz quit:
Strict
Import "-luser32"
'Import "-lkernel32"
Extern
Function GetSysColorBrush:Int(nIndex:Int) = "GetSysColorBrush@4"
Function SendMessage:Int(hWnd:Int,MSG:Int,wParam:Int,lParam:Int) = "SendMessageA@16"
'Function CreateFontA:Int(nHeight,nWidth,nEscapement,nOrientation ,fnWeight, fdwItalic,dwUnderline , fdwStrikeOut,fdwCharSet, fdwOutputPrecision , fdwClipPrecision,fdwQuality, fdwPitchAndFamily, lpszFace:String) = "CreateFontA@56"
Function GetLastError() = "GetLastError@0"
Function CreateFontIndirectA:Int(lpLogFont:Byte Ptr) = "CreateFontIndirectA@4"
End Extern
'Type LOGFONT
' Field lfHeight:Int
' Field lfWidth:Int
' Field lfEscapement:Int
' Field lfOrientation:Int
' Field lfWeight:Int
' Field lfItalic:Byte
' Field lfUnderline:Byte
' Field lfStrikeOut:Byte
' Field lfCharSet:Byte
' Field lfOutPrecision:Byte
' Field lfClipPrecision:Byte
' Field lfQuality:Byte
' Field lfPitchAndFamily:Byte
' 'TCHAR lfFaceName[LF_FACESIZE];
'End Type
'5*4 + 8*1 + 32
Const COLOR_BTNFACE = 15
Local WinProcADDR:Byte Ptr = WinProc
If WinProcADDR > Null Then
Print "winproc addr obtained "
EndIf
Local classname$ = "WindowCLASS"
Local class:WNDCLASS = New WNDCLASS
Local classADDR:Byte Ptr = Byte Ptr class
class.hInstance = GetModuleHandleA(0)
class.lpfnWndProc = WinProcADDR
class.lpszClassName = Byte Ptr classname$
class.hbrBackground = GetSysColorBrush(COLOR_BTNFACE)
If(RegisterClassA(classADDR) <> Null) Then
Print "class reg ok"
EndIf
Local message:MSG = New MSG
'Local messageADDR:Byte Ptr = Byte Ptr message
Local windowTitle$ = "Testing"
Const WS_CAPTION = $C00000
Const WS_SYSMENU = $80000
Const WS_VISIBLE = $10000000
Const WS_MINIMIZEBOX = $20000
Const WS_MAXIMIZEBOX = $10000
Const WS_CHILD = $40000000
Const WM_DESTROY = 2
Const WM_SETFONT = $30
Const WM_KEYDOWN = $100
Const WM_COMMAND = $111
Local lpParamADDR:Byte Ptr
Local window = CreateWindowExA( 0,Byte Ptr classname$,Byte Ptr windowTitle$,WS_CAPTION | WS_MINIMIZEBOX | WS_MAXIMIZEBOX | WS_SYSMENU | WS_VISIBLE,100,100,400,350,0,0,GetModuleHandleA(0),lpParamADDR )
Global btnOk = CreateWindowExA( 0 ,Byte Ptr "BUTTON",Byte Ptr "Ok",WS_CHILD | WS_VISIBLE,250,250,100,20,window ,0,GetModuleHandleA(0),Byte Ptr 0 )
Global btnCancel = CreateWindowExA( 0 ,Byte Ptr "BUTTON",Byte Ptr "Cancel",WS_CHILD | WS_VISIBLE,250,250+24,100,20,window ,0,GetModuleHandleA(0),Byte Ptr 0)
Local lpParamADDR2:Byte Ptr
Global lblHeadline = CreateWindowExA( 0 ,Byte Ptr "STATIC",Byte Ptr "I am the label, I am",WS_CHILD | WS_VISIBLE,10,10,100,20,window ,0,GetModuleHandleA(0),lpParamADDR2 )
Local Fontname:String = "Arial" + Chr(0) + Chr(0)
'Local myfont = CreateFontA(-16,0,0,0 ,400, 0,0 , 0,0, 4 , 0,0, 0, Fontname)
Local lf:TBank = CreateBank(60)
PokeInt lf,0,-10
PokeInt lf,4*4,1000
PokeByte lf,28+0,Asc("A")
PokeByte lf,28+1,Asc("r")
PokeByte lf,28+2,Asc("i")
PokeByte lf,28+3,Asc("a")
PokeByte lf,28+4,Asc("l")
Local myfont =CreateFontIndirectA(BankBuf(lf))
DebugLog "GetLastError() " + GetLastError()
DebugLog "myfont " + myfont
If myfont
SendMessage btnOk ,WM_SETFONT,myfont ,0
' SendMessage btnCancel ,WM_SETFONT,myfont ,0
' SendMessage lblHeadline ,WM_SETFONT,myfont ,True
' DebugLog "GetLastError() " + GetLastError()
EndIf
DebugLog "here"
Local bRet
Repeat
bRet = GetMessageA( message, 0, 0, 0 )
DebugLog "bRet " + bRet
If bRet = -1
'handle the error And possibly Exit
DebugLog "handle the error And possibly Exit"
Else
TranslateMessage(message)
DispatchMessageA(message)
EndIf
Until bret =0
DebugLog "here"
'
'
'
Function WinProc(hWnd:Int,Msg:Int,wParam:Int,lParam:Int)
Select Msg
Case WM_DESTROY
Notify "Bye!"
End
Case WM_KEYDOWN
DebugLog "Keydown " + wParam + " " + lParam
Select wParam
Case 27 ' ESC
SendMessage hWnd,WM_DESTROY,0,0
End Select
Case WM_COMMAND
Select lParam
Case btnOk
Notify "You clicked Ok"
Case btnCancel
Notify "You clicked Cancel"
End Select
Default
'DebugLog Msg
End Select
Return DefWindowProcA(hWnd,Msg,wParam,lParam)
End Function