Announcement

Collapse
No announcement yet.

Custom Fonts and Window Bitmaps

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

  • Custom Fonts and Window Bitmaps

    I have been reading the archive about creating text with a custom font and color and applying a custom background to my MainDialog.

    Here is a snippet of what I am using from the SMTP.BAS example in the TCP folder ...

    SELECT CASE CBMSG

    CASE %WM_INITDIALOG
    hFont = MakeFont("Courier New", 10)
    CONTROL SEND hDlgMain, 105, %WM_SETFONT,hFont, 1

    DIALOG SEND hDlgMain, %WM_GETFONT, 0, 0 TO hFont
    GetObject hFont, SIZEOF(lf), BYVAL VARPTR(lf)
    lf.lfWeight = %FW_BOLD
    hFont = CreateFontIndirect(lf)

    CONTROL SET FOCUS hDlgMain, 103

    DIALOG GET SIZE CBHNDL TO x, y
    DIALOG UNITS CBHNDL, x, y TO PIXELS x, y

    ' Load the bitmap from a file
    GetModuleFilename %NULL, bmpfile, SIZEOF(bmpfile)
    bmpfile = UCASE$(bmpfile)
    REPLACE ".EXE" WITH ".BMP" IN bmpfile
    hBmp = LoadImage(BYVAL %NULL, bmpfile, %IMAGE_BITMAP, x, y, %LR_LOADFROMFILE)
    FUNCTION = 1

    CASE %WM_CTLCOLOREDIT
    SetTextColor CBWPARAM, %BLUE
    FUNCTION = GetStockObject(%WHITE_BRUSH)

    CASE %WM_CTLCOLORSTATIC
    SelectObject CBWPARAM, hFont
    SetBkMode CBWPARAM, %TRANSPARENT
    SetTextColor CBWPARAM, %YELLOW
    FUNCTION = GetStockObject(%NULL_BRUSH)

    CASE %WM_ERASEBKGND
    hBmpDC = CreateCompatibleDC(CBWPARAM)
    SelectObject hBmpDC, hBmp
    BitBlt CBWPARAM, 0, 0, x, y, hBmpDC, 0, 0, %SRCCOPY
    DeleteDC hBmpDC
    FUNCTION = 1

    END SELECT

    This works great.
    The problem is that I send text to the window MANY times with:
    CONTROL SET TEXT hDlg, 104, MyString

    Each time I send the text it IS displayed but ON TOP of whats allready there. How do i delete whats allredy there just befor i display the new text.

    Thanks


    ------------------
    Kind Regards
    Mike

  • #2
    You could use FillRect, but easier is to change
    SetBkMode CBWPARAM, %TRANSPARENT
    to
    SetBkMode CBWPARAM, %OPAQUE

    (or skip that line at all, since I think OPAQUE is default mode)

    You may have to set SetBkColor too, for proper background color.
    If text is of different lengths, add/insert enough spaces to
    overwrite previous text.


    ------------------

    Comment


    • #3
      Mike;

      From Borje's Code drawer...

      Code:
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' Rotate text in any angle (degr%) - x and y are Left and Top position of text
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB RotateText(BYVAL hWnd&, BYVAL degr%, BYVAL Txt$, BYVAL x&, BYVAL y&)
       
        LOCAL lFont AS LOGFONT, rc AS RECT
        LOCAL hDc AS LONG, hfont AS LONG, newfont AS LONG
        IF degr% = 0 THEN degr% = 360
       
        lFont.lfescapement  = degr% * 10                         '<- Set Angle
        lFont.lforientation = degr% * 10
        lFont.lfHeight = -18                                     '<- Font Size
        lFont.lfWeight = %FW_BOLD                                '<- Bold
        lFont.lfItalic = %FALSE
        lFont.lfCharSet = %ANSI_CHARSET
        lFont.lfOutPrecision = %OUT_TT_PRECIS
        lFont.lfClipPrecision =%CLIP_DEFAULT_PRECIS
        lFont.lfQuality = %DEFAULT_QUALITY
        lFont.lfPitchAndFamily = %FF_DONTCARE
        lFont.lfFaceName = "Times New Roman"
       
       'create font and assign handle to a variable
        hFont = CreateFontIndirect(BYVAL VARPTR(lFont))
       
        hDC = getDc(hWnd&)
          newfont = selectobject(hDC, hfont)
       
          GetClientRect hWnd&, rc : rc.nBottom = rc.nBottom - 40
          FillRect hDC, rc, GetStockObject(%LTGRAY_BRUSH)        '<- Erase background
       
          SetBkColor   hDC, RGB(192, 192, 192)
          SetTextColor hDC, RGB(128,   0, 128)
       
          TextOut hDC, x&, y&, BYVAL STRPTR(Txt$), LEN(Txt$)     '<- Print text
       
        ReleaseDC hWnd&, hDC
        deleteobject hfont
      END SUB
      You will need to clean the ID=104 control up first before you put new
      text on it, so Borje FillRect() suggestion would be the one to use. You
      can get the Idea from his code snippet above.

      HTH
      Regards,
      Jules
      Best regards
      Jules
      www.rpmarchildon.com

      Comment


      • #4
        Thx for your replys.
        I have spent alot of time reading and experimenting and getting nowhere. I tried your suggestions, but I get a white hole punched in the background (Smtp.BMP) and grey text on the white.

        SO, i have rewritten the code as simply as i can from Smtp.bas to illustrate the problem.

        You need to put the file in the same folder as the Smtp.BMP so that the program can find it. It compiles and runs to illustrate the problem.

        Can someone take a look and suggest a way to fix it pls

        '==============================================================================
        ' Rewritten SMTP example for PB/DLL 6.0 - to illustrate color font on background problem
        ' Copyright (c) 1999 PowerBASIC, Inc.
        '==============================================================================
        #COMPILE EXE "Smtp.exe"
        #INCLUDE "WIN32API.INC"
        GLOBAL hDlgMain AS LONG
        '------------------------------------------------------------------------------
        FUNCTION MakeFont(BYVAL Font AS STRING, BYVAL PointSize AS LONG) AS LONG
        LOCAL hDC AS LONG
        LOCAL CyPixels AS LONG
        hDC = GetDC(%HWND_DESKTOP)
        CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
        ReleaseDC %HWND_DESKTOP, hDC
        PointSize = (PointSize * CyPixels) \ 72
        FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
        %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
        %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY Font)
        END FUNCTION
        '------------------------------------------------------------------------------
        CALLBACK FUNCTION DlgProc () AS LONG
        STATIC hFont AS LONG
        STATIC hBmp AS LONG
        STATIC x AS LONG
        STATIC y AS LONG
        LOCAL hBmpDC AS LONG
        LOCAL e AS LONG
        LOCAL lf AS LOGFONT
        LOCAL bmpfile AS ASCIIZ * 64

        SELECT CASE CBMSG
        CASE %WM_INITDIALOG
        hFont = MakeFont("Courier New", 10)
        CONTROL SEND hDlgMain, 105, %WM_SETFONT,hFont, 1

        DIALOG SEND hDlgMain, %WM_GETFONT, 0, 0 TO hFont
        GetObject hFont, SIZEOF(lf), BYVAL VARPTR(lf)
        lf.lfWeight = %FW_BOLD
        hFont = CreateFontIndirect(lf)

        CONTROL SET FOCUS hDlgMain, 103
        DIALOG GET SIZE CBHNDL TO x, y
        DIALOG UNITS CBHNDL, x, y TO PIXELS x, y

        ' Load the bitmap from a file
        GetModuleFilename %NULL, bmpfile, SIZEOF(bmpfile)
        bmpfile = UCASE$(bmpfile)
        REPLACE ".EXE" WITH ".BMP" IN bmpfile
        ' MSGBOX(bmpfile)
        hBmp = LoadImage(BYVAL %NULL, bmpfile, %IMAGE_BITMAP, x, y, %LR_LOADFROMFILE)
        FUNCTION = 1

        CASE %WM_CTLCOLOREDIT
        SetTextColor CBWPARAM, %BLUE
        FUNCTION = GetStockObject(%WHITE_BRUSH)

        CASE %WM_CTLCOLORSTATIC
        SelectObject CBWPARAM, hFont
        SetBkMode CBWPARAM, %TRANSPARENT
        SetTextColor CBWPARAM, %YELLOW
        FUNCTION = GetStockObject(%NULL_BRUSH)

        CASE %WM_ERASEBKGND
        hBmpDC = CreateCompatibleDC(CBWPARAM)
        SelectObject hBmpDC, hBmp
        BitBlt CBWPARAM, 0, 0, x, y, hBmpDC, 0, 0, %SRCCOPY
        DeleteDC hBmpDC
        FUNCTION = 1
        END SELECT
        END FUNCTION
        '------------------------------------------------------------------------------
        CALLBACK FUNCTION CancelButton() AS LONG
        DIALOG END hDlgMain, 1
        END FUNCTION
        '------------------------------------------------------------------------------
        CALLBACK FUNCTION OkButton() AS LONG ' to illustrate the text problem
        LOCAL AllStr AS STRING, SendStr AS STRING
        AllStr = "PowerBASIC offers three distinct ways TO store AND retrieve information FROM disk" _
        +"sequential, RANDOM, AND BINARY file INPUT AND OUTPUT (I/O). Each has advantages"
        SendStr = " " + MID$(AllStr,RND(1,(LEN(allStr)-14)),RND(10,150))
        CONTROL SET TEXT hDlgMain, 2, SendStr
        FUNCTION = 1
        END FUNCTION
        '------------------------------------------------------------------------------
        FUNCTION PBMAIN () AS LONG
        DIALOG NEW 0, "Color Example", ,, 300, 100, 0, %WS_SYSMENU TO hDlgMain
        CONTROL ADD LABEL, hDlgMain, 2, "Please rewrite DlgProc", 20, 30, 250, 8,
        CONTROL ADD BUTTON, hDlgMain, 101, "& Show Me Da Problem", 100, 80, 80, 14, %BS_DEFPUSHBUTTON OR %WS_TABSTOP CALL OkButton
        CONTROL ADD BUTTON, hDlgMain, 102, "&Quit", 200, 80, 40, 14, 0 CALL CancelButton
        DIALOG SHOW MODAL hDlgMain CALL DlgProc
        END FUNCTION
        '-----------------------------------------------------------------------------



        ------------------
        Kind Regards
        Mike

        Comment


        • #5
          Originally posted by Mike Trader:
          Can someone take a look and suggest a way to fix it pls
          Mike:

          In the CALLBACK FUNCTION for your OKButton, replace the following line...
          Code:
             CONTROL SET TEXT hDlgMain, 2, SendStr
          With these three lines...
          Code:
             CONTROL SET TEXT hDlgMain, 2, ""
             InvalidateRgn hDlgMain, %NULL, %TRUE
             CONTROL SET TEXT hDlgMain, 2, SendStr
          That should give you what you've been looking for.

          Timm
          mailto:[email protected]
          Tsunami Record Manager

          Comment


          • #6
            Arrgh. I hate when its that simple! I feel so dumb.
            thx so much

            ------------------
            Kind Regards
            Mike

            Comment

            Working...
            X