Painting text

[Iain Kennedy]

Could someone help me with painting text to a window. I wish to use a font that is not the system font to write text onto a the main window (not a dialog). I cannot find a windows function that will work. I have tried AddFontResource. Note I don't want the user to select a font, merely to specify a font more interesting than the system font (eg VERDANA.ttf)

[Chris Holbrook]

Send it a %WM_SETFONT message (having created a font first)

[Paul Dixon]

Iain,
you first create the font with CreateFont
Then you select the created font.
Then you use TextOut to print the text.

Below is an extremely untidy PBCC program which does it.

Paul.

%CCWIN = 1

$INCLUDE "WIN32API.INC"

DECLARE FUNCTION NewWindow (hInstance AS LONG, WindowName AS ASCIIZ*200,iCmdShow AS LONG) AS LONG

DEFSNG A-Z

GLOBAL Window1 AS LONG
GLOBAL hMemDC AS LONG, hBmp AS LONG


SUB PLOT(BYVAL hWnd AS LONG, hDC AS LONG)

  LOCAL hBmp      AS LONG
  LOCAL hBrush    AS LONG
  LOCAL hPen      AS LONG
  LOCAL WinX      AS LONG
  LOCAL WinY      AS LONG
  LOCAL r         AS RECT
  LOCAL Myr       AS RECT


  'get the size of the visible window
  GetClientRect hWnd, r
  WinX = r.nRight - r.nLeft
  WinY = r.nBottom - r.nTop


  'create a memory version of the Window to draw into rather than write to screen directly
'  hMemDC = CreateCompatibleDC(hDC)
  hBmp = CreateCompatibleBitmap(hDC, 640, 480)
  old1&=SelectObject( hDC,hBmp)


  'set background green
  MYr.nleft=0:MYr.nright=640:MYr.ntop=0:MYr.nbottom=480
  hBrush = CreateSolidBrush(%GREEN)
  Old3&=SelectObject (hDC, hBrush)
  FillRect hDC, MYr, hBrush
  SelectObject hDC, Old3&
  DeleteObject hBrush


 'try adding a bit of text
 height&=30
 wwidth&=20
 escapement&=100
 orientation&=100
 weight&=700
 

fonth&= CreateFont(BYVAL height&, BYVAL wwidth&, BYVAL escapement&, BYVAL orientation&, _
     BYVAL weight&, BYVAL 0 , BYVAL 0, BYVAL 0, BYVAL %ANSI_CHARSET , BYVAL %OUT_DEFAULT_PRECIS , _
     BYVAL %CLIP_DEFAULT_PRECIS , BYVAL %DEFAULT_QUALITY , BYVAL %FF_MODERN + %DEFAULT_PITCH , "Times New Roman" )


  Old5&=SELECTObject (hDC,fonth&)
  SetBkMode hdc, %TRANSPARENT
  a$="This is text!"
  StrAddr&=STRPTR(a$)
  TextOut BYVAL hDC,200,100,BYVAL STRPTR(a$),LEN(a$)

  SELECTObject hDC,Old5&
  DeleteObject fonth&


    'tidy up
    SelectObject hDC,Old1&
    DeleteDC hDC
    DeleteObject hBmp

END SUB



FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine           AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

  LOCAL Msg         AS tagMsg

  'make "Window1" global so I can get at it everywhere
  Window1=NewWindow (hInstance,"Window name",iCmdShow)


  WHILE GetMessage(Msg, %NULL, 0, 0)
    TranslateMessage Msg
    DispatchMessage Msg
  WEND

  FUNCTION = msg.wParam

END FUNCTION  ' WinMain

'------------------------------------------------------------------------------

FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

  LOCAL hDC       AS LONG
  LOCAL LpPaint   AS PaintStruct
  LOCAL tRect     AS Rect
  STATIC First    AS LONG


  SELECT CASE wMsg

    CASE %WM_CREATE

    CASE %WM_ERASEBKGND
      IF First = 0 THEN
        First = 1

      ELSE
        FUNCTION = 1
        EXIT FUNCTION
      END IF


    CASE %WM_PAINT
      hDC = BeginPaint(hWnd, LpPaint)
      Plot hWnd,hDC
      EndPaint hWnd, LpPaint
      FUNCTION = 0
      EXIT FUNCTION

    CASE %WM_DESTROY

      PostQuitMessage 0
      FUNCTION = 0
      EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION




FUNCTION NewWindow (hInstance AS LONG, WindowName AS ASCIIZ*200, iCmdShow AS LONG) AS LONG
REM DO ALL the bits needed TO SET UP a graphics window
REM RETURN the HANDLE of that window
  LOCAL wwndclass    AS WndClassEx
  LOCAL szAppName   AS ASCIIZ * 80
  LOCAL hWnd        AS LONG

  szAppName              = "GDIWINDOW"

  wwndclass.cbSize        = SIZEOF(wwndclass)
  wwndclass.style         = %CS_HREDRAW OR %CS_VREDRAW

  wwndclass.lpfnWndProc   = CODEPTR( WndProc )

  wwndclass.cbClsExtra    = 0
  wwndclass.cbWndExtra    = 0
  wwndclass.hInstance     = hInstance
  wwndclass.hIcon         = %NULL
  wwndclass.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
  wwndclass.hbrBackground = GetStockObject( %BLACK_BRUSH )
  wwndclass.lpszMenuName  = %NULL
  wwndclass.lpszClassName = VARPTR( szAppName )
  wwndclass.hIconSm       = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )

  RegisterClassEx wwndclass

  ' Create a window using the registered class
  hWnd = CreateWindow("GDIWINDOW", _             ' window class name
                      WindowName, _   ' window caption
                      %WS_SYSMENU, _      '%WS_OVERLAPPEDWINDOW, _    ' window style
                      %CW_USEDEFAULT, _          ' initial x position
                      %CW_USEDEFAULT, _          ' initial y position
                     640,_' %CW_USEDEFAULT, _          ' initial x size
                     480,_' %CW_USEDEFAULT, _          ' initial y size
                      %NULL, _                   ' parent window handle
                      %NULL, _                   ' window menu handle
                      hInstance, _               ' program instance handle
                      BYVAL %NULL)               ' creation parameters

  ShowWindow hWnd, iCmdShow

  FUNCTION=hWnd

END FUNCTION

[Chris Holbrook]

Here's some DDT code generated by PBForms, my comments:

LOCAL hFont1 as DWORD
....
    DIALOG NEW hParent, "Dialog1", 70, 70, 201, 121, TO hDlg
    CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Label1", 50, 20, 120, 60
' there are several examples of Makefont functions in the forums
' this one is PBForms's own
    hFont1 = PBFormsMakeFont("Verdana", 10, 400, %FALSE, %FALSE, %FALSE, %ANSI_CHARSET) 

    CONTROL SEND hDlg, %IDC_LABEL1, %WM_SETFONT, hFont1, 0

....
' after the dialog has finished, or in the %WM_DESTROY handler, etc
    DeleteObject Hfont1

[Michael Mattias]

fonth&= CreateFont(BYVAL height&, BYVAL wwidth&, BYVAL escapement&, BYVAL orientation&, _
     BYVAL weight&, BYVAL 0 , BYVAL 0, BYVAL 0, BYVAL %ANSI_CHARSET , BYVAL %OUT_DEFAULT_PRECIS , _
     BYVAL %CLIP_DEFAULT_PRECIS , BYVAL %DEFAULT_QUALITY , BYVAL %FF_MODERN + %DEFAULT_PITCH , "Times New Roman" )

See: http://www.powerbasic.com/support/pb...ad.php?t=24609

Might be a little easier to understand the CreateFont() call there.

[Fred Buffington]

If you are using DDT, this may help in how to use fonts
Simplistic dialog

#COMPILE EXE
#INCLUDE "win32api.inc"
GLOBAL hDlg AS LONG 'use DWORD instead of long if you have version 7 or above
CALLBACK FUNCTION dlgproc
  SELECT CASE CBMSG
    CASE %WM_COMMAND
      SELECT CASE CBCTL
        CASE 201
          DIALOG END hDlg,0
      END SELECT
  END SELECT
END FUNCTION

FUNCTION PBMAIN() AS LONG
    LOCAL lf AS LOGFONT, hFont AS LONG
    GetObject GetStockObject(%ANSI_VAR_FONT), SIZEOF(lf), BYVAL VARPTR(lf)
    lf.lfHeight = 14*yoffset!'64 '48 '-14
    lf.lfWeight = 0 '%FW_BOLD
    lf.lfItalic = 0 '1
    lf.lfFaceName =  "VERDANA" 'MS Sans Serif" 'MS LineDraw" 'Times New Roman"' Bold Italic" 'Courier New" 'Arial" 'MS Sans Serif" '"MS UI Gothic" '"MS Linedraw" '"Courier New"'Arial" '
    hFont = CreateFontIndirect(lf)
    lTitle$="My Dialog"
    xoffset!=1:yoffset!=1
    DIALOG NEW 0,ltitle$,,,380*xoffset!,180*yoffset!,%WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU,%WS_EX_APPWINDOW TO hDlg
    CONTROL ADD LABEL,hDlg,101,"THIS IS VERDANA",10,10,160,20
    CONTROL SEND hDlg,101,%WM_SETFONT, hFont, %TRUE
    CONTROL ADD BUTTON, hDlg, 201,"End",180,90,40,20
    DIALOG SHOW MODAL hDlg CALL dlgproc
    deleteobject hFont
END FUNCTION