Announcement

Collapse
No announcement yet.

Painting text

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

  • Fred Buffington
    replied
    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, 06:46 PM.

    Leave a comment:


  • Michael Mattias
    replied
    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.

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Paul Dixon
    replied
    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

    Leave a comment:


  • Chris Holbrook
    replied
    Send it a %WM_SETFONT message (having created a font first)

    Leave a comment:


  • Iain Kennedy
    started a topic Painting text

    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)
Working...
X