CreateFont example

[Roland Stowasser]

This is an adaption of Franks CreateFont example in OxygenBasic. It is a bit smaller as I used winutil.inc

CreateFonts.o2bas:

Code Select Expand

' 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



[Zlatko Vid]

..from awinh037.inc

Code Select Expand

'=========================================================================================================
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