Tweet
Powerbasic's Graphic commands are simple and easy to use but glaring omissions in my opinion were colorkeying and alphablending in the GRAPHIC COPY statement. Here is how I implemented them using the Windows API calls TransparentBlt and AlphaBend.
Code:
'CopyBitmapEx by Jim Klutho Nov 7,2009
'Attempt to use Powerbasic's built in graphic commands to combine TransparentBlt and Alphablending
'PBWin 9.02
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
'--------Constants-----------------------
%IDM_FILE_EXIT = 1001
%IDC_TRANS = 1000
'--------Globals------------------------
GLOBAL lpPoint AS POINTAPI
GLOBAL hMenu AS DWORD
GLOBAL hDlg AS LONG
GLOBAL hBoard AS DWORD
GLOBAL hBmp AS DWORD
GLOBAL Bkgnd AS DWORD
GLOBAL Ball AS DWORD
GLOBAL dx,dy AS LONG
GLOBAL BkgndDC AS DWORD
GLOBAL BallDC AS DWORD
GLOBAL hBoardDC AS DWORD
SUB CopyBitMapEx(BYVAL MyTargetDest AS LONG,BYVAL xDest AS LONG, BYVAL yDest AS LONG, _
BYVAL hSrcBmp AS LONG, BYVAL x AS LONG,BYVAL y AS LONG,BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
BYVAL TransColor AS LONG, BYVAL Alpha AS BYTE)
'Alphablend needs 32bpp bitmaps to work
'If Alpha is zero then Alphablending is ignored otherwise
'This routine will 1) copy the soon to be overlaid destination to a buffer
' 2) copy the portion of the source bitmap to be used to a buffer
' 3) alphablend the source bitmap buffer to the destination buffer
' 4) replace the colorkey location pix in the destination buffer with the Transcolor
' 5) tranparentblt the thing to the screen
LOCAL BF AS BLENDFUNCTION
LOCAL ScrBits AS STRING
LOCAL TempBits AS STRING
LOCAL hDestDC AS LONG
LOCAL hSrcDC AS LONG
LOCAL TransColorBGR AS LONG
LOCAL hTempBmp AS LONG
LOCAL hTempDC AS LONG
LOCAL hMyScrBmp AS LONG
GRAPHIC ATTACH hSrcBmp, 0
GRAPHIC GET DC TO hSrcDC
IF Alpha <> 0 THEN
'Make a temp bitmap to alter and display and grab just enough source bitmap in case many frame are included
GRAPHIC BITMAP NEW nWidth, nHeight& TO hMyScrBmp
GRAPHIC ATTACH hMyScrBmp, 0
GRAPHIC COPY hSrcBmp, 0,(0,0)-(nWidth,nHeight) TO (0,0)
GRAPHIC GET BITS TO ScrBits
GRAPHIC BITMAP NEW nWidth, nHeight TO hTempBmp
GRAPHIC ATTACH hTempBmp, 0
GRAPHIC GET DC TO hTempDC
GRAPHIC COPY MyTargetDest, 0,(xDest,yDest)-(xDest + nWidth,yDest + nHeight) TO (0,0)
END IF
'need to put back the proper drawing surface
GRAPHIC ATTACH MyTargetDest,0, REDRAW
GRAPHIC GET DC TO hDestDC
IF TransColor < 0 THEN TransColor = GetPixel(hSrcDC, 0, 0)
IF Alpha <> 0 THEN
'Fill in the Alphablend structure
BF.BlendOp = %AC_SRC_OVER
BF.BlendFlags = 0
BF.SourceConstantAlpha = Alpha
BF.AlphaFormat = 0
AlphaBlend(hTempDC,0, 0&, nWidth, nHeight, hSrcDC, x, y, nWidth, nHeight, BYVAL CVDWD(bf))
'Now need to GetBits and swap out the TransColor
GRAPHIC ATTACH hTempBmp, 0
GRAPHIC GET BITS TO TempBits
LOCAL ScrPixelPtr AS LONG PTR
LOCAL TempPixelPtr AS LONG PTR
LOCAL xsize,ysize,i AS LONG
xsize = CVL(TempBits,1)
ysize = CVL(TempBits,5)
ScrPixelPtr = STRPTR(ScrBits) + 8
TempPixelPtr = STRPTR(TempBits) + 8
TransColorBGR = BGR(TransColor&)
FOR i = 1 TO xsize * ysize
IF @ScrPixelPtr = TransColorBGR THEN
@TempPixelPtr = TransColorBGR
END IF
INCR ScrPixelPtr
INCR TempPixelPtr
NEXT
GRAPHIC SET BITS TempBits
GRAPHIC ATTACH MyTargetDest,0, REDRAW
CALL TransparentBlt(hDestDC, xDest, yDest, nWidth, nHeight, htempDC, x, y, nWidth, nHeight, TransColor)
ELSE
CALL TransparentBlt(hDestDC, xDest, yDest, nWidth, nHeight, hSrcDC, x, y, nWidth, nHeight, TransColor)
END IF
IF Alpha <> 0 THEN
'Destroy the temp bitmaps and return focus to the target
GRAPHIC ATTACH hMyScrBmp, 0
GRAPHIC BITMAP END
GRAPHIC ATTACH hTempBmp, 0
GRAPHIC BITMAP END
GRAPHIC ATTACH MyTargetDest,0, REDRAW
END IF
END SUB
SUB PrintText(MyText AS STRING)
END SUB
SUB MakeBitMaps
GRAPHIC BITMAP NEW 640, 480 TO bkgnd
GRAPHIC ATTACH bkgnd, 0
'GRAPHIC CLEAR %GREEn,5
GRAPHIC BOX (0, 0) - (640, 480),0,%BLACK ,%GREEN , 5
GRAPHIC BITMAP NEW 140, 140 TO ball
GRAPHIC ATTACH ball, 0
GRAPHIC CLEAR %CYAN
GRAPHIC ELLIPSE (0, 0) - (140, 140),%BLACK ,%RED , 0
END SUB
CALLBACK FUNCTION ShowBmpWindowProc()
LOCAL Result AS LONG
LOCAL rc AS RECT
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
CALL SetTimer(CBHNDL, 1, 15, %NULL)
CASE %WM_TIMER
SceneRedraw
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_CLOSE
CALL DeleteObject(hBmp)
CALL KillTimer(CBHNDL, 1)
CASE %WM_PAINT
SceneRedraw
FUNCTION = 0: EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_TRANS
'%STN_CLICKED or %STN_DBLCLK assumed
Result=GetCursorPos (lpPoint)
Result=ScreenToClient (CBHNDL,lpPoint)
CASE %IDM_FILE_EXIT
DIALOG END CBHNDL , 0
END SELECT
END SELECT
END FUNCTION
SUB SceneRedraw
GRAPHIC ATTACH hDlg, %IDC_TRANS, REDRAW
GRAPHIC COPY bkgnd, 0
dx=dx+2
IF dx> 550 THEN dx = 1
CopyBitmapEx(hBoard, dx, 250,ball, 0, 0, 140, 140, -1,dx)
CopyBitmapEx(hBoard, dx, 100,ball, 0, 0, 140, 140, -1,0)
GRAPHIC REDRAW
END SUB
FUNCTION AttachMenu1(BYVAL hDlg AS DWORD) AS DWORD
LOCAL hPopUp1 AS DWORD
MENU NEW BAR TO hMenu
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "File", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Exit", %IDM_FILE_EXIT, %MF_ENABLED
MENU ATTACH hMenu, hDlg
FUNCTION = hMenu
END FUNCTION
FUNCTION ShowBmpWindow(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
DIALOG NEW PIXELS, hParent, "CopyBitMapEx", 70, 70, 650, 500, TO hDlg
CONTROL ADD GRAPHIC, hDlg, %IDC_TRANS, "", 5, 0, 640, 480, %SS_NOTIFY
CONTROL HANDLE hDlg,%IDC_TRANS TO hBoard
MakeBitmaps
GRAPHIC ATTACH bkgnd, 0
GRAPHIC GET DC TO bkgndDC
GRAPHIC ATTACH ball, 0
GRAPHIC GET DC TO ballDC
GRAPHIC ATTACH hDlg, %IDC_TRANS, REDRAW
GRAPHIC GET DC TO hBoardDC
AttachMenu1 hDlg
SceneRedraw
DIALOG SHOW MODAL hDlg, CALL ShowBmpWindowProc TO lRslt
FUNCTION = lRslt
GRAPHIC ATTACH bkgnd, 0
GRAPHIC BITMAP END
GRAPHIC ATTACH ball, 0
GRAPHIC BITMAP END
END FUNCTION
FUNCTION PBMAIN()
ShowBmpWindow %HWND_DESKTOP
END FUNCTION
Comment