Announcement

Collapse
No announcement yet.

Painting text

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Painting text

    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)

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

    Comment


    • #3
      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.
      Code:
      %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

      Comment


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

        Code:
        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

        Comment


        • #5
          Code:
          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.
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            If you are using DDT, this may help in how to use fonts
            Simplistic dialog
            Code:
            #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
            Last edited by Fred Buffington; 21 Aug 2008, 07:46 PM.
            Client Writeup for the CPA

            buffs.proboards2.com

            Links Page

            Comment

            Working...
            X