home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / VBZ01.ZIP / SCRNCAP.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-02-24  |  1.5 KB  |  45 lines
  1. DefInt A-Z
  2.  
  3. Declare Sub DeleteDC Lib "GDI" (ByVal hDC)
  4. Declare Sub BitBlt Lib "GDI" (ByVal DestDC, ByVal X, ByVal Y, ByVal BWidth, ByVal BHeight, ByVal SourceDC, ByVal X, ByVal Y, ByVal Constant&)
  5. Declare Sub DrawIcon Lib "User" (ByVal hDC, ByVal X, ByVal Y, ByVal hIcon)
  6. Declare Sub GetCursorPos Lib "User" (lpPNT)
  7. Declare Sub CopyRect Lib "User" (lpDest, ByVal lpSrc&)
  8. Declare Sub UnlockResource Lib "Kernel" Alias "GlobalUnlock" (ByVal hRes)
  9.  
  10. Declare Function CreateDC Lib "GDI" (ByVal Driver$, ByVal Dev&, ByVal O&, ByVal Init&)
  11. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC, ByVal nIndex)
  12. Declare Function GetCursor Lib "User" ()
  13. Declare Function LockResource& Lib "Kernel" (ByVal hRes)
  14.  
  15. Global ScrnW, ScrnH
  16. Dim RECT(3)
  17.  
  18. Const HORZRES = 8
  19. Const VERTRES = 10
  20.  
  21. Sub GetScrnRes ()
  22.     DC = CreateDC("DISPLAY", 0, 0, 0)
  23.     ScrnW = GetDeviceCaps(DC, HORZRES)
  24.     ScrnH = GetDeviceCaps(DC, VERTRES)
  25.     DeleteDC DC
  26. End Sub
  27.  
  28. Sub ScrnCap (Frm As Control, Cursor)
  29.     DC = CreateDC("DISPLAY", 0, 0, 0)
  30.     BitBlt Frm.hDC, 0, 0, ScrnW, ScrnH, DC, 0, 0, &HCC0020
  31.     DeleteDC DC
  32.     If Cursor Then
  33.         GetCursorPos RECT(0)
  34.         CursorX = RECT(0): CursorY = RECT(1)
  35.         hCursor = GetCursor()
  36.         lpCursor& = LockResource&(hCursor)
  37.         CopyRect RECT(0), lpCursor&
  38.         UnlockResource hCursor
  39.         CursorX = CursorX - RECT(0)
  40.         CursorY = CursorY - RECT(1)
  41.         DrawIcon Frm.hDC, CursorX, CursorY, hCursor
  42.     End If
  43. End Sub
  44.  
  45.