Older Version
Newer Version
JanetTerra
Apr 30, 2006
This is Demo 3 to Accompany [[Drawing a Tiled Background with CreateCompatibleBitmap]] [[code format="vbnet"]] ' Demo3: Using CreateCompatibleBitmap and BitBlt to Append a Large Graphic 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" 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" 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 [[code]] * Return to [[Drawing a Tiled Background with CreateCompatibleBitmap]]