Results 1 to 6 of 6

Thread: [Project Dropped]Get Picture Of Form

Threaded View

  1. #1

    Thread Starter
    Hyperactive Member wiccaan's Avatar
    Join Date
    Apr 2004
    Location
    127.0.0.1
    Posts
    475

    Resolved [Project Dropped]Get Picture Of Form

    Hello again everyone. This time Im trying to get a picture of the form in my project and display in in a picture box. Right now Im using this:

    Code:
    Public Function CaptureForm(frmSrc As Form) As Picture
       Set CaptureForm = CaptureWindow(frmSrc.hwnd, False, 0, 0, frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
    End Function
    
    Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
    
      Dim hDCMemory As Long
      Dim hBmp As Long
      Dim hBmpPrev As Long
      Dim r As Long
      Dim hDCSrc As Long
      Dim hPal As Long
      Dim hPalPrev As Long
      Dim RasterCapsScrn As Long
      Dim HasPaletteScrn As Long
      Dim PaletteSizeScrn As Long
      Dim LogPal As LOGPALETTE
    
       ' Depending on the value of Client get the proper device context.
       If Client Then
          hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
       Else
          hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire
                                        ' window.
       End If
    
       ' Create a memory device context for the copy process.
       hDCMemory = CreateCompatibleDC(hDCSrc)
       ' Create a bitmap and place it in the memory DC.
       hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
       hBmpPrev = SelectObject(hDCMemory, hBmp)
    
       ' Get screen properties.
       RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
                                                          ' capabilities.
       HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette
                                                            ' support.
       PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
                                                            ' palette.
    
       ' If the screen has a palette make a copy and realize it.
       If HasPaletteScrn And (PaletteSizeScrn = 256) Then
          ' Create a copy of the system palette.
          LogPal.palVersion = &H300
          LogPal.palNumEntries = 256
          r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
          hPal = CreatePalette(LogPal)
          ' Select the new palette into the memory DC and realize it.
          hPalPrev = SelectPalette(hDCMemory, hPal, 0)
          r = RealizePalette(hDCMemory)
       End If
    
       ' Copy the on-screen image into the memory DC.
       r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
    
    ' Remove the new copy of the  on-screen image.
       hBmp = SelectObject(hDCMemory, hBmpPrev)
    
       ' If the screen has a palette get back the palette that was
       ' selected in previously.
       If HasPaletteScrn And (PaletteSizeScrn = 256) Then
          hPal = SelectPalette(hDCMemory, hPalPrev, 0)
       End If
    
       ' Release the device context resources back to the system.
       r = DeleteDC(hDCMemory)
       r = ReleaseDC(hWndSrc, hDCSrc)
    
       ' Call CreateBitmapPicture to create a picture object from the
       ' bitmap and palette handles. Then return the resulting picture
       ' object.
       Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
    End Function
    
    Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
      Dim r As Long
    
       Dim Pic As PicBmp
       ' IPicture requires a reference to "Standard OLE Types."
       Dim IPic As IPicture
       Dim IID_IDispatch As GUID
    
       ' Fill in with IDispatch Interface ID.
       With IID_IDispatch
          .Data1 = &H20400
          .Data4(0) = &HC0
          .Data4(7) = &H46
       End With
    
       ' Fill Pic with necessary parts.
       With Pic
          .Size = Len(Pic)          ' Length of structure.
          .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
          .hBmp = hBmp              ' Handle to bitmap.
          .hPal = hPal              ' Handle to palette (may be null).
       End With
    
       ' Create Picture object.
       r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
    
       ' Return the new Picture object.
       Set CreateBitmapPicture = IPic
    End Function
    Which does the job like I want it to, but it will also get a picture of anything thats over top of the form. So if you have something like My Computer open and its corner is over top of the form in my project, it will also have that corner in the picture. Im trying to make it only get a picture of my form and nothing else.

    Also would this be able to be done if the form is minimized to the tray? As in getting a picture of it if its inivisible at the time? Im making a dynamic image uploader like SigX and trying diffrent ways to get it to work. This is probably the third one Im working on now.

    Thanks in advance.
    Last edited by wiccaan; Apr 1st, 2005 at 07:53 PM.
    If my post was helpful please rate it

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width