none
SetFont RRS feed

  • Question

  • I'm trying to get a Windows Edit control to show all 256 DOS ASCII characters...

    Here's some FreeBASIC code ...  compiler at Freebasic.net 

    Can any one help with the SetFont  code????

    #define WIN_INCLUDEALL
    #Include once "windows.bi"
    #Include once "/win/commctrl.bi"

    '===============================================================================
    '===============================================================================
    Private function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
      Dim As HDC hDC=GetDC(HWND_DESKTOP)
      Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
      ReleaseDC(HWND_DESKTOP,hDC)
      Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,OEM_CHARSET _
      ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
    End Function

    Dim As HFONT   fonthdl
    Dim As String  fontname
    Dim As Integer fontsize = 8
    fontname = "Fixed System" ' "Courier new"
    fonthdl = fb_Set_Font(fontname, 8,0,0,0,0)


    Dim shared As MSG msg     ' Message variable (stores massages)
    Dim shared As HWND hWnd , EDIT_IN

    ' Create window
    hWnd = CreateWindowEx( 0, "#32770", "Testing for DOS Font", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 600, 600, 0, 0, 0, 0 )

    'create in edit
    EDIT_IN  = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL  , 10, 10,430,110, hWnd, 0, 0, 0 )

    dim as string DOS_CHAR=""
    for a as longint = 0 to 255
        DOS_CHAR+= chr(a)
    next

    SetWindowText( EDIT_IN , DOS_CHAR)


    '===============================================================================
    '===============================================================================
    'begin mesage processing
    While GetMessage( @msg, 0, 0, 0 )
       
        dim as WPARAM wparam
        dim as LPARAM lparam
       
        TranslateMessage( @msg )
        DispatchMessage( @msg )
     
        Select Case msg.hwnd
            Case hWnd
                Select Case msg.message
                    Case 273
                    PostQuitMessage(0)
                    'End
                End Select
        end select
        
    Wend
    PostQuitMessage(0)
    END


    Thursday, January 31, 2019 6:11 PM