I finally figured out how to take a screencap with API, but it keeps crashing.
It is supposed to scroll the screen faster and faster, but while it is still moving fairly slow, it gives me the BSoD! I made sure to remove any unused DCs, whenever they are no longer being used. However I keep getting a blue screen of death after this program runs for just a few seconds.
Can someone look at this code and tell just why it keeps blowing up on me?
It is supposed to scroll the screen faster and faster, but while it is still moving fairly slow, it gives me the BSoD! I made sure to remove any unused DCs, whenever they are no longer being used. However I keep getting a blue screen of death after this program runs for just a few seconds.
Code:
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Sub Main()
Dim n As Currency
Dim ScrW As Long
Dim ScrH As Long
Dim scrwnd As Long
Dim scrdc As Long
Dim scrcdc As Long
Dim scrbm As Long
ScrW = Screen.Width / Screen.TwipsPerPixelX
ScrH = Screen.Height / Screen.TwipsPerPixelY
scrwnd = GetDesktopWindow
scrdc = GetWindowDC(scrwnd)
scrcdc = CreateCompatibleDC(scrdc)
scrbm = CreateCompatibleBitmap(scrdc, ScrW * 2, ScrH)
SelectObject scrcdc, scrbm
BitBlt scrcdc, 0, 0, ScrW, ScrH, scrdc, 0, 0, vbSrcCopy
BitBlt scrcdc, ScrW, 0, ScrW, ScrH, scrdc, 0, 0, vbSrcCopy
ReleaseDC scrwnd, scrdc
For n = 0 To 1 Step 0.0001
scrwnd = GetDesktopWindow
scrdc = GetWindowDC(scrwnd)
BitBlt scrdc, 0, 0, ScrW, ScrH, scrcdc, (n * n * 10000) Mod ScrW, 0, vbSrcCopy
ReleaseDC scrwnd, scrdc
Next n
DeleteDC scrcdc
DeleteObject scrbm
End Sub