Liberty BASIC Programmer's Encyc

JanetTerra Aug 26, 2010
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 Boolean
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 Boolean
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 Boolean
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
Return to Drawing a Tiled Background with CreateCompatibleBitmap
TiledBkGrdCCBDemo4
