This is Demo 4 to Accompany
Drawing a Tiled Background with CreateCompatibleBitmap
' Demo4: Drawing a Large Scrolling Sprite Background
Nomainwin
WindowWidth = 600
WindowHeight = 400
Graphicbox #w.g1, 10, 10, 102, 102
Statictext #w.st1a, "Image Source", 8, 120, 110, 32
Graphicbox #w.g2, 140, 10, 440, 102
Statictext #w.st2a, "Image transferred from memory using the gdi32 DLL calls", 138, 120, 440, 16
Statictext #w.st2b, "CreateCompatibleBitmap and BitBlt", 138, 136, 440, 16
' Open the Window
Open "Appending Bitmaps in Memory Demo" For Window as #w
#w "Trapclose EndProgram"
' Display Solid Backgrounds
Call hueBackground "#w.g2", "Darkgreen"
' Get handles and dc of second graphicbox with GetDC
' Place handle numbers in array to make global
hWG1 = hWnd(#w.g1)
hDC1 = GetDC(hWG1)
hWG2 = hWnd(#w.g2)
hDC2 = GetDC(hWG2)
' Create two compatible memory DC with CreateCompatibleDC
dcMem1 = CreateCompatibleDC(hDC1) ' Compatible with #w.g1 'memDC
MemDC(1) = dcMem1
dcMem2 = CreateCompatibleDC(hDC2) ' Compatible with #w.g2
MemDC(2) = dcMem2
' Get a simple bitmap for appending
#w.g1 "Getbmp MemBitmap 0 0 1200 100"
hMemBitmap = hBmp("MemBitmap")
' Create a large bitmap with CreateCompatibleBmp
' Use ScreenDC and not MemoryDC
hCompBitmap = CreateCompatibleBitmap(hDC2, 1200, 100)
' Select the large bitmap into the second memory device context
hMemBitmap = SelectObject(dcMem2, hMemBitmap)
' Draw the first bitmap and get its handle
Call SimpleHouse "#w.g1", 0, 0
#w.g1 "Getbmp SimpleHouse 0 0 100 100"
#w.g1 "Flush"
hSimpleHouse = hBmp("SimpleHouse")
' Draw the second bitmap and get its handle
Call hueBackground "#w.g1", "Darkblue"
Call SimpleTrees "#w.g1", 0, 0
#w.g1 "Getbmp SimpleTrees 0 0 100 100"
#w.g1 "Flush"
hSimpleTrees = hBmp("SimpleTrees")
' Draw the third bitmap and get its handle
Call hueBackground "#w.g1", "Darkblue"
Call SimpleFence "#w.g1", 0, 0
#w.g1 "Getbmp SimpleFence 0 0 100 100"
#w.g1 "Flush"
hSimpleFence = hBmp("SimpleFence")
For i = 0 to 11
' Select the bitmap into the first memory device context
randomPic = Int(Rnd(1) * 3) + 1
Select Case randomPic
Case 1
hPic = SelectObject(dcMem1, hSimpleHouse)
Case 2
hPic = SelectObject(dcMem1, hSimpleTrees)
Case 3
hPic = SelectObject(dcMem1, hSimpleFence)
End Select
' BitBlt the 1st memory device context to the 2nd memory device context
null =BitBlt(dcMem2, i * 100, 0, 100, 100, dcMem1, 0, 0, _SRCCOPY)
Next i
' Deselect the bitmap from memory
hMemBitmap = SelectObject(dcMem2, hMemBitmap)
' Store handle of bitmap in memory in array to make Global
' Or declare hMemBitmap Global in beginning of program
hMemBitmap(0) = hMemBitmap
' ReleaseDC on Screen DC
null = ReleaseDC(hWG1, hDC1)
null = ReleaseDC(hWG2, hDC2)
' DeleteDC on both memory DC's
null = DeleteDC(dcMem1)
null = DeleteDC(dcMem2)
' Loadbmp from handle
Loadbmp "SimpleScene", hMemBitmap
#w.g2 "Drawbmp SimpleScene 0 0"
#w.g2 "Flush"
' Unload the small bmp's as they are no longer needed
Unloadbmp "SimpleHouse"
Unloadbmp "SimpleTrees"
Unloadbmp "SimpleFence"
' Set SimpleScene as background
#w.g2 "Background SimpleScene"
' Create 2 sprites and cyclesprite for animation
Call SimpleCar "#w.g1", 1, 15
#w.g1 "Cls; Fill Darkgreen; Flush"
Call SimpleCar "#w.g1", 2, 30
#w.g1 "Cls; Fill Darkgreen; Flush"
#w.g2 "Addsprite SimpleCar SimpleCar1 SimpleCar2"
#w.g2 "Spritexy SimpleCar 200 68"
#w.g2 "Cyclesprite SimpleCar 1"
#w.g2 "Drawsprites"
' Scroll background
ProgramIsRunning = 1
x = 0
While ProgramIsRunning = 1
#w.g2 "Backgroundxy ";x;" 0"
CallDLL #kernel32, "Sleep", 50 as Long, result as Void
Scan
x = x + 10
#w.g2 "Drawsprites"
Wend
Wait
Sub EndProgram handle$
' API Bitmaps cannot be unloaded with Unloadbmp
' DeleteObject instead
null = DeleteObject(hMemBitmap(0))
' Unload the appended bmp and sprite bmps
Unloadbmp "SimpleScene"
Unloadbmp "SimpleCar1"
Unloadbmp "SimpleCar2"
Close #w
End
End Sub
Function GetDC(handle)
CallDLL #user32, "GetDC", _
handle As Ulong, _
GetDC as Ulong
End Function
Function ReleaseDC(handle, hDC)
CallDLL #user32, "ReleaseDC", _
handle As Ulong, _
hDC As Ulong, _
ReleaseDC As Long
End Function
Function DeleteDC(hDC)
CallDLL #gdi32, "DeleteDC", _
hDC as Ulong, _
result as Long
End Function
Function CreateCompatibleDC(hDC)
CallDLL #gdi32, "CreateCompatibleDC", _
hDC as Ulong, _
CreateCompatibleDC as Ulong
End Function
Function CreateCompatibleBitmap(hDC, wMem, hMem)
CallDLL #gdi32, "CreateCompatibleBitmap", _
hDC as Ulong, _
wMem as Long, _
hMem as Long, _
CreateCompatibleBitmap as Ulong
End Function
Function SelectObject(hDC, hPic)
CallDLL #gdi32, "SelectObject", _
hDC as Ulong, _
hPic as Ulong, _
SelectObject as Ulong
End Function
Function DeleteObject(handleObject)
CallDLL #gdi32,"DeleteObject", _
handleObject as Ulong, _
result as Long
End Function
Function BitBlt(hdcDest, xDest, yDest, wDest, hDest, hdcSource, xSource, ySource, ROP)
CallDLL #gdi32, "BitBlt", _
hdcDest as Ulong, _
xDest as Long, _
yDest as Long, _
wDest as Long, _
hDest as Long, _
hdcSource as Ulong, _
xSource as Long, _
ySource as Long, _
ROP as Ulong, _
result as Long
End Function
Sub hueBackground handle$, hue$
#handle$ "Down; Fill ";hue$
#handle$ "Flush; Discard"
End Sub
Sub SimpleHouse handle$, xLoc, yLoc
Call hueBackground handle$, "Darkblue"
#handle$ "Color 128 64 0; Backcolor Brown"
#handle$ "Place ";xLoc + 5;" ";yLoc + 50
#handle$ "Boxfilled ";xLoc + 95;" ";yLoc + 90
For x = xLoc to xLoc + 100
#handle$ "Line ";xLoc + 50;" ";y + 10;" ";x;" ";y + 50
Next x
#handle$ "Backcolor 128 64 0"
#handle$ "Place ";xLoc + 10;" ";yLoc + 60
#handle$ "Boxfilled ";xLoc + 30;" ";yLoc + 80
#handle$ "Place ";xLoc + 65;" ";yLoc + 60
#handle$ "Boxfilled ";xLoc + 85;" ";yLoc + 80
#handle$ "Place ";xLoc + 35;" ";yLoc + 70
#handle$ "Boxfilled ";xLoc + 60;" ";yLoc + 90
#handle$ "Color 16 16 16; Backcolor 16 16 16"
#handle$ "Place ";xLoc;" ";yLoc + 90
#handle$ "Boxfilled ";xLoc + 100;" ";yLoc + 100
Call SimpleGrass handle$, xLoc, yLoc
End Sub
Sub SimpleTrees handle$, xLoc, yLoc
#handle$ "Color 128 64 0; Backcolor Brown"
#handle$ "Place ";xLoc + 30;" ";yLoc + 60
#handle$ "Boxfilled ";xLoc + 50;" ";yLoc + 90
#handle$ "Place ";xLoc + 65;" ";yLoc + 40
#handle$ "Boxfilled ";xLoc + 75;" ";yLoc + 90
#handle$ "Color 0 64 0; Backcolor 0 128 64"
#handle$ "Place ";xLoc + 40;" ";yLoc + 40
#handle$ "Circlefilled 30"
#handle$ "Place ";xLoc + 70;" ";yLoc + 50
#handle$ "Circlefilled 20"
Call SimpleGrass handle$, xLoc, yLoc
End Sub
Sub SimpleFence handle$, xLoc, yLoc
#handle$ "Color 64 64 64; Backcolor 192 192 192"
#handle$ "Place ";xLoc + 10;" ";yLoc + 60
#handle$ "Boxfilled ";xLoc + 95;" ";yLoc + 70
#handle$ "Place ";xLoc + 10;" ";yLoc + 80
#handle$ "Boxfilled ";xLoc + 95;" ";yLoc + 90
#handle$ "Place ";xLoc + 10;" ";yLoc + 40
#handle$ "Boxfilled ";xLoc + 15;" ";yLoc + 90
#handle$ "Place ";xLoc + 30;" ";yLoc + 40
#handle$ "Boxfilled ";xLoc + 35;" ";yLoc + 90
#handle$ "Place ";xLoc + 50;" ";40
#handle$ "Boxfilled ";xLoc + 55;" ";yLoc + 90
#handle$ "Place ";xLoc + 70;" ";yLoc + 40
#handle$ "Boxfilled ";xLoc + 75;" ";yLoc + 90
#handle$ "Place ";xLoc + 90;" ";yLoc + 40
#handle$ "Boxfilled ";xLoc + 95;" ";yLoc + 90
Call SimpleGrass handle$, xLoc, yLoc
End Sub
Sub SimpleGrass handle$, xLoc, yLoc
For x = xLoc to xLoc + 100
greenHue = Int(Rnd(1) * 128) + 16
#handle$ "Color 0 ";greenHue;" 0"
y = Int(Rnd(1) * 10) + 85
#handle$ "Line ";x;" ";y;" ";x;" 100"
Next x
End Sub
Sub SimpleCar handle$, nCar, angle
#handle$ "Cls; Fill Black"
#handle$ "Color White; Backcolor White"
#handle$ "Place 0 0; Boxfilled 100 30"
#handle$ "Color Black; Backcolor Black"
#handle$ "Place 25 12; Boxfilled 75 22"
#handle$ "Place 50 12; Ellipsefilled 30 20"
#handle$ "Place 40 22; Circlefilled 7"
#handle$ "Place 60 22; Circlefilled 7"
#handle$ "Color Red; Backcolor Red"
#handle$ "Place 25 42; Boxfilled 75 52"
#handle$ "Place 50 42; Ellipsefilled 30 20"
#handle$ "Color Black; Backcolor Lightgray"
#handle$ "Place 40 52; Circlefilled 7"
#handle$ "Place 60 52; Circlefilled 7"
Call SimpleWheel handle$, angle
SimpleCar$ = "SimpleCar";nCar
#handle$ "Getbmp ";SimpleCar$;" 0 0 100 60"
End Sub
Sub SimpleWheel handle$, StartAngle
#handle$ "Color 16 16 16"
For angle = StartAngle to 360 + StartAngle Step 30
#handle$ "North; Place 40 52; Turn ";angle
#handle$ "Go 7"
#handle$ "North; Place 60 52; Turn ";angle
#handle$ "Go 7"
Next angle
End Sub