This is an adaption of Franks CreateFont example in OxygenBasic. It is a bit smaller as I used winutil.inc
CreateFonts.o2bas:
' create fonts in winapi without gdiplus
' GUI winapi, sdk style
'
$ filename "CreateFonts.exe"
'uses rtl32
'uses rtl64
uses winutil
% OUT_DEFAULT_PRECIS = 0
% OUT_OUTLINE_PRECIS = 8
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
sub setfontcolours(f As sys,text As long,background As long=0)
SetTextColor(f,text)
if background=0 then
SetBkMode(f,TRANSPARENT)
else
SetBkColor(f,background)
end if
end sub
sub setfontsize(f As sys,size As Long,style As string,weight as long=400)
SelectObject(f,CreateFont(size,0,0,0,weight,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,VARIABLE_PITCH,style))
end sub
sys hInstance=inst
MainWindow 720,500
'------------------------------------------------------------------ //
function WndProc ( sys hWnd, wMsg, wParam, lparam ) as sys callback
dim as rect crect
static as sys hdc
static as String txt
static as PaintStruct Paintst
sys hfont
sys hInstances
hfont = CreateFont(50, 50, 0, 0, _ ' --> here you can change font size, 40, 40
FW_NORMAL, FALSE, TRUE, FALSE,_
ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
DEFAULT_PITCH or FF_ROMAN,_
"Comic")
select wMsg
case WM_CREATE
SetWindowText(hwnd, "OxygenBASIC")
GetClientRect hWnd,&cRect
Dim As RECT rc
GetClientRect(hWnd, @rc)
' Create Editbox
sys hwndEdit = CreateWindowEx(0, "EDIT", "size fonts", _
WS_CHILD Or WS_BORDER Or WS_VISIBLE Or ES_AUTOHSCROLL Or ES_MULTILINE, _
20, 220, 640, 180, _
hWnd, 0, hInstances,ByVal 0)
SendMessage(hwndEdit, WM_SETFONT, hfont, TRUE)
case WM_DESTROY
PostQuitMessage 0
case WM_PAINT
GetClientRect hWnd,&cRect
hDC=BeginPaint hWnd,&Paintst
setfontsize(hdc,80,"times new roman")
setfontcolours(hdc,rgb(0,200,0))
SetBkColor hdc,yellow
SetTextColor hdc,red
TextOut hDC, 50, 80, "Hello, OxygenBasic!", 20' 25
setfontcolours(hdc,rgb(100,200,200))
TextOut hDC, 40, 20, "Hello, Batman!", 15
EndPaint hWnd,&Paintst
case WM_KEYDOWN
Select wParam
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0
End Select
case else
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function
..from awinh037.inc
'=========================================================================================================
Function ControlFont ( byval hwnd as long,byval height As Long, byval width As long, byval flag As Long,byval fontname As string)
int hFont
hFont = CreateFont( height,width,0,0,flag,0,0,0,1,0,0,0,2,fontname)
'CreateFont(_fsize,0,0,0,_ff,_fi,_fu,_fs,1,0,0,0,2,_fname)
SendMessage hwnd,WM_SETFONT,hfont,1
End Function