Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Transparent text to graphic background

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

  • PBWin Transparent text to graphic background

    Simple routine to apply text with transparent background to a graphic control.
    Write the text to a mask buffer in white on black.
    Use the bgr values of the pixels to blend it with the new background, applying
    the color byte values found in the monochrome example.
    Hand drawn characters that are not automatically dithered may be dithered by
    using a blur on the monochrome example prior to background blending.
    But that is another code module altogether.
    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "win32api.inc"
    ENUM ctrls SINGULAR
        grfx = 500
        bgimage
        apply
        dtext
    END ENUM
    
    TYPE bgra
        b AS BYTE
        g AS BYTE
        r AS BYTE
        a AS BYTE
    END TYPE
    
    FUNCTION PBMAIN () AS LONG
        LOCAL hWin, xitcode AS LONG
        RANDOMIZE
        DIALOG NEW PIXELS, 0, "PB_GradBlur", , , 300, 230, %WS_BORDER OR %WS_CAPTION OR %WS_SYSMENU TO hWin
        DIALOG SET COLOR hWin, %WHITE, %GRAY
        CONTROL ADD BUTTON, hWin, %bgimage, "New Background", 5, 5, 120, 20
        CONTROL ADD BUTTON, hWin, %apply, "Apply", 130, 5, 40, 20
        CONTROL ADD LABEL, hWin, %dtext, "Text to Show", 175, 6, 120, 15, %SS_SUNKEN OR %SS_NOTIFY
        CONTROL SET COLOR hWin, %dtext, %YELLOW, %GRAY
        CONTROL ADD GRAPHIC, hWin, %grfx, "", 5, 30, 290, 195
        GRAPHIC ATTACH hWin, %grfx
        GRAPHIC CLEAR %BLACK
        DIALOG SHOW MODAL hWin, CALL dlgproc() TO xitcode
        FUNCTION = xitcode
    END FUNCTION
    
    CALLBACK FUNCTION dlgproc()
        LOCAL getvalue AS STRING, wgt, itr AS LONG
        SELECT CASE CB.MSG
            CASE %WM_INITDIALOG
                make_background(CB.HNDL, %grfx)
            CASE %WM_COMMAND
                SELECT CASE CB.CTL
                    CASE %bgimage
                        IF CB.CTLMSG = %BN_CLICKED THEN
                            make_background CB.HNDL, %grfx
                        END IF
                    CASE %apply
                        IF CB.CTLMSG = %BN_CLICKED THEN
                            LOCAL hfont AS LONG
                            CONTROL GET TEXT CB.HNDL, %dtext TO getvalue
                            FONT NEW "Comic Sans MS", 16 TO hfont
                            TransparentText CB.HNDL, %grfx, getvalue, 8, 20, hfont, %RGB_INDIGO
                        END IF
                    CASE %dtext
                        IF CB.CTLMSG = %STN_CLICKED THEN
                            getvalue = INPUTBOX$("Enter text to be displayed","Text Input", "0")
                            IF getvalue <> "" THEN CONTROL SET TEXT CB.HNDL, CB.CTL, getvalue
                        END IF
                END SELECT
        END SELECT
    END FUNCTION
    
    SUB make_background(dlg AS DWORD, ctl AS LONG)
        LOCAL bginit, x, y, xl, yl, x0, y0, fgc, bgc AS LONG
        CONTROL GET SIZE dlg, ctl TO x, y
        xl = x \ 40
        yl = y \ 40
        GRAPHIC ATTACH dlg, ctl, REDRAW
        FOR bginit = 0 TO 1000
            fgc = RGB(RND(100, 120), RND(100, 120), RND(100, 120))
            bgc = RGB(RND(150, 240), RND(150, 240), RND(150, 240))
            x0 = RND(-1, xl) * 40
            y0 = RND(-1, yl) * 40
            GRAPHIC BOX (x0, y0)-(x0 + 60, y0 + 60), 85, fgc, bgc
        NEXT
        GRAPHIC REDRAW
    END SUB
    
    SUB TransparentText(dlg AS DWORD, ctl AS LONG, strt AS STRING, xpos AS LONG, ypos AS LONG, hfont AS LONG, fgc AS LONG)
        LOCAL textcolor, tx, ty, bufsize, itr8, prcnt, minusp AS LONG
        LOCAL hbmp1 AS DWORD
        LOCAL textbuf, maskbuf AS STRING
        LOCAL lptr_textbuf, lptr_maskbuf AS LONG PTR
        LOCAL bgr_t, bgr_m, bgr_c AS bgra PTR
    ' get bgr value of text color and set bgr pointer to text color
        textcolor = BGR(fgc)
        bgr_c = VARPTR(textcolor)
    ' get size of working area
        GRAPHIC ATTACH dlg, ctl:  GRAPHIC SET FONT hfont:  tx = GRAPHIC(TEXT.SIZE.X, strt):  ty = GRAPHIC(TEXT.SIZE.Y, strt)
    ' create bitmap, print text to mask buffer and get background info
        GRAPHIC BITMAP NEW tx, ty TO hbmp1:  GRAPHIC ATTACH hbmp1, 0:  GRAPHIC SET FONT hfont
        GRAPHIC COLOR %WHITE, %BLACK:  GRAPHIC CLEAR:  GRAPHIC SET POS (0, 0):  GRAPHIC PRINT strt
        GRAPHIC GET BITS TO maskbuf:  GRAPHIC COPY dlg, ctl, (xpos, ypos)-(xpos + tx, ypos + ty) TO (0, 0)
        GRAPHIC GET BITS TO textbuf
    ' set up string buffers for writing text to background
        bufsize = (LEN(textbuf) \ 4) - 3
        lptr_textbuf = STRPTR(textbuf) + 8:  bgr_t = lptr_textbuf
        lptr_maskbuf = STRPTR(maskbuf) + 8:  bgr_m = lptr_maskbuf
    ' using value of text in mask, calculate and apply blending of text and background
        FOR itr8 = 0 TO bufsize
            @bgr_t[itr8].b = ((@bgr_c.b * @bgr_m[itr8].b) + (@bgr_t[itr8].b * (255 - @bgr_m[itr8].b))) \ 255
            @bgr_t[itr8].g = ((@bgr_c.g * @bgr_m[itr8].g) + (@bgr_t[itr8].g * (255 - @bgr_m[itr8].g))) \ 255
            @bgr_t[itr8].r = ((@bgr_c.r * @bgr_m[itr8].r) + (@bgr_t[itr8].r * (255 - @bgr_m[itr8].r))) \ 255
        NEXT
    ' copy edited rectangle back to original control end bitmap and font
        GRAPHIC ATTACH hbmp1, 0:  GRAPHIC SET BITS textbuf
        GRAPHIC ATTACH dlg, ctl, REDRAW:  GRAPHIC COPY hbmp1, 0, (0, 0)-(tx, ty) TO (xpos, ypos):  GRAPHIC REDRAW
        GRAPHIC ATTACH hbmp1, 0:  GRAPHIC BITMAP END:  FONT END hfont
    END SUB
    The world is strange and wonderful.*
    I reserve the right to be horrifically wrong.
    Please maintain a safe following distance.
    *wonderful sold separately.

  • #2
    Update. Selected area printing doesn't work properly with italics or variable pitch.
    Improved code to handle entire area.
    Notice that applying shadows can be done.
    Shadows may also be blurred, using the blur routines in another source thread.
    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "win32api.inc"
    ENUM ctrls SINGULAR
        grfx = 500
        bgimage
        apply
        dtext
    END ENUM
    
    TYPE bgra
        b AS BYTE
        g AS BYTE
        r AS BYTE
        a AS BYTE
    END TYPE
    
    FUNCTION PBMAIN () AS LONG
        LOCAL hWin, xitcode AS LONG
        RANDOMIZE
        DIALOG NEW PIXELS, 0, "PB_Transparent Text", , , 300, 230, %WS_BORDER OR %WS_CAPTION OR %WS_SYSMENU TO hWin
        DIALOG SET COLOR hWin, %WHITE, %GRAY
        CONTROL ADD BUTTON, hWin, %bgimage, "New Background", 5, 5, 100, 20
        CONTROL ADD BUTTON, hWin, %apply, "Apply", 110, 5, 35, 20
        CONTROL ADD LABEL, hWin, %dtext, "Text to Show", 150, 6, 145, 15, %SS_SUNKEN OR %SS_NOTIFY
        CONTROL SET COLOR hWin, %dtext, %YELLOW, %GRAY
        CONTROL ADD GRAPHIC, hWin, %grfx, "", 5, 30, 290, 195
        GRAPHIC ATTACH hWin, %grfx
        GRAPHIC CLEAR %BLACK
        DIALOG SHOW MODAL hWin, CALL dlgproc() TO xitcode
        FUNCTION = xitcode
    END FUNCTION
    
    CALLBACK FUNCTION dlgproc()
        LOCAL getvalue AS STRING, wgt, itr AS LONG
        SELECT CASE CB.MSG
            CASE %WM_INITDIALOG
                make_background(CB.HNDL, %grfx)
            CASE %WM_COMMAND
                SELECT CASE CB.CTL
                    CASE %bgimage
                        IF CB.CTLMSG = %BN_CLICKED THEN
                            make_background CB.HNDL, %grfx
                        END IF
                    CASE %apply
                        IF CB.CTLMSG = %BN_CLICKED THEN
                            LOCAL hfont AS LONG
                            CONTROL GET TEXT CB.HNDL, %dtext TO getvalue
                            ' create font for use with transparent print
                            FONT NEW "Arial", 18, 1, 1, 0, 0  TO hfont
    '                        FONT NEW "Lucida Handwriting", 18, 2, 1, 1, 350  TO hfont
    '                        FONT NEW "Comic Sans MS", 18, 2, 1, 0, 350  TO hfont
                            ' create anti-shadow, shadow, and print text
                            TransparentText CB.HNDL, %grfx, getvalue, 27, 149, hfont, %WHITE
                            TransparentText CB.HNDL, %grfx, getvalue, 29, 151, hfont, %BLACK
                            TransparentText CB.HNDL, %grfx, getvalue, 28, 150, hfont, %RGB_DEEPSKYBLUE
                        END IF
                    CASE %dtext
                        IF CB.CTLMSG = %STN_CLICKED THEN
                            CONTROL GET TEXT CB.HNDL, %dtext TO getvalue
                            getvalue = INPUTBOX$("Enter text to be displayed","Text Input", getvalue)
                            IF getvalue <> "" THEN CONTROL SET TEXT CB.HNDL, CB.CTL, getvalue
                        END IF
                END SELECT
        END SELECT
    END FUNCTION
    
    SUB make_background(dlg AS DWORD, ctl AS LONG)
        LOCAL bginit, x, y, xl, yl, x0, y0, fgc, bgc AS LONG
        CONTROL GET SIZE dlg, ctl TO x, y
        xl = x \ 40
        yl = y \ 40
        GRAPHIC ATTACH dlg, ctl, REDRAW
        FOR bginit = 0 TO 1000
            fgc = RGB(RND(100, 120), RND(100, 120), RND(100, 120))
            bgc = RGB(RND(150, 240), RND(150, 240), RND(150, 240))
            x0 = RND(-1, xl) * 40
            y0 = RND(-1, yl) * 40
            GRAPHIC BOX (x0, y0)-(x0 + 60, y0 + 60), 85, fgc, bgc
        NEXT
        GRAPHIC REDRAW
    END SUB
    
    SUB TransparentText(dlg AS DWORD, ctl AS LONG, strt AS STRING, xpos AS LONG, ypos AS LONG, hfont AS LONG, fgc AS LONG)
        LOCAL textcolor, tx, ty, bufsize, itr8 AS LONG
        LOCAL hbmp1 AS DWORD
        LOCAL textbuf, maskbuf AS STRING
        LOCAL lptr_textbuf, lptr_maskbuf AS LONG PTR
        LOCAL bgr_t, bgr_m, bgr_c AS bgra PTR
    ' get bgr value of text color and set bgr pointer to text color
        textcolor = BGR(fgc)
        bgr_c = VARPTR(textcolor)
    ' get size of working area
        CONTROL GET SIZE dlg, ctl TO tx, ty
    ' create bitmap, print text to mask buffer and get background info to text buffer
        GRAPHIC BITMAP NEW tx, ty TO hbmp1:  GRAPHIC ATTACH hbmp1, 0:  GRAPHIC SET FONT hfont
        GRAPHIC COLOR %WHITE, %BLACK:  GRAPHIC CLEAR:  GRAPHIC SET POS (xpos, ypos):  GRAPHIC PRINT strt
        GRAPHIC GET BITS TO maskbuf: GRAPHIC BITMAP END
        GRAPHIC ATTACH dlg, ctl:  GRAPHIC GET BITS TO textbuf
    ' set up pointers to string buffers for writing text to background
        bufsize = (LEN(textbuf) \ 4) - 3
        lptr_textbuf = STRPTR(textbuf) + 8:  bgr_t = lptr_textbuf
        lptr_maskbuf = STRPTR(maskbuf) + 8:  bgr_m = lptr_maskbuf
    ' using value of text in mask, calculate and apply blending of text and background
        FOR itr8 = 0 TO bufsize
            IF @lptr_maskbuf[itr8] THEN ' if transparent background color
                @bgr_t[itr8].b = ((@bgr_c.b * @bgr_m[itr8].b) + (@bgr_t[itr8].b * (255 - @bgr_m[itr8].b))) \ 255
                @bgr_t[itr8].g = ((@bgr_c.g * @bgr_m[itr8].g) + (@bgr_t[itr8].g * (255 - @bgr_m[itr8].g))) \ 255
                @bgr_t[itr8].r = ((@bgr_c.r * @bgr_m[itr8].r) + (@bgr_t[itr8].r * (255 - @bgr_m[itr8].r))) \ 255
            END IF
        NEXT
    ' copy edited data back to original control end font
        GRAPHIC ATTACH dlg, ctl, REDRAW:  GRAPHIC SET BITS textbuf:  GRAPHIC REDRAW
        FONT END hfont
    END SUB
    The world is strange and wonderful.*
    I reserve the right to be horrifically wrong.
    Please maintain a safe following distance.
    *wonderful sold separately.

    Comment

    Working...
    X