[Resolved]hDC Picturebox Autoredraw

[Slyke]

This maybe just noobness, but i'm confused.

I thought that when the Autoredraw was set to true that if the picture box was moved off the screen, had something moved over it, or any thing such as that. The Autoredraw will allow the picture to stay intact.

Picture_.AutoRedraw = False
r = StretchBlt(Picture_.hDC, 0, 0, w, h, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy)
Picture_.AutoRedraw = True

This is how the image is being drawn onto the picturebox.

The picture box automatically resizes to fit the image (such as the screen width and height). The Problem is that when i move the picturebox around the form (so that bits of it leave the form) it goes to the default background color (white in my case).

How does this happen? I have autoredraw on (Debug.Print Picture_.Autoredraw). If i cause a msgbox to come up over the image, the image stays intact until i move the msgbox (Pressing OK wil keep it intact even though it was over the top of the image).

Can anyone tell me a solution to this problem? This is the image that is going to be saved to a file. So the form won't come up all the time to the user, however the image will still be stored there and if they want to see a preview , only then will the image form show up.

So in other words, the picturebox and the form it's located on will be hidden for most of the time.

Does the hDC stop the autoredraw from working?

[Merri]

You must keep AutoRedraw = True at all times. AutoRedraw creates a new buffer that will automatically keep all drawn data in memory. This consumes memory and is slower than living without it, but in the other hand you don't need to constantly redraw picture in the Picture1_Paint event (which is where you probably would like to have your drawing code, but where you can't have it if you use AutoRedraw).


So: you either keep AutoRedraw = True all the time or not at all.

[Slyke]

If i keep it on all the time and the user takes another screen shot, it comes up with an error saying that it can't draw onto an image that has autoredraw set to true, or somthign like that.

"Can't Create Autoredraw image"

[Merri]

It's been so long time since I've been using AutoRedraw that I can't remember what caused that problem. But the other option that I could suggest would be to use API to create a new Device Context and store the picture there and then draw that to the picturebox only on request. You probably get started off by searching for CreateCompatibleDC, which makes it easier to create a new DC. I don't have VB on this computer so you're probably better off searching for that

[Slyke]

Oh Damm...

Well i'll do my best. www.allapi.com is a good help too!

If any one else knows how to do this or another way to fix this please let me know.

[Slyke]

Const RC_PALETTE As Long = &H100
Const SIZEPALETTE As Long = 104
Const RASTERCAPS As Long = 38
Private Type PALETTEENTRY
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
End Type
Private Type LOGPALETTE
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
End Type
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleDC 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
    Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
 
    'Fill GUID info
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
 
    'Fill picture info
    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 the picture
    R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
 
    'Return the new picture
    Set CreateBitmapPicture = IPic
End Function
Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
    Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
    Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long
    Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE
 
    'Create a compatible device context
    hDCMemory = CreateCompatibleDC(hDCSrc)
    'Create a compatible bitmap
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    'Select the compatible bitmap into our compatible device context
    hBmpPrev = SelectObject(hDCMemory, hBmp)
 
    'Raster capabilities?
    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
    'Does our picture use a palette?
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
    'What's the size of that palette?
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
 
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
        'Set the palette version
        LogPal.palVersion = &H300
        'Number of palette entries
        LogPal.palNumEntries = 256
        'Retrieve the system palette entries
        R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
        'Create the palette
        hPal = CreatePalette(LogPal)
        'Select the palette
        hPalPrev = SelectPalette(hDCMemory, hPal, 0)
        'Realize the palette
        R = RealizePalette(hDCMemory)
    End If
 
    'Copy the source image to our compatible device context
    R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
 
    'Restore the old bitmap
    hBmp = SelectObject(hDCMemory, hBmpPrev)
 
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
        'Select the palette
        hPal = SelectPalette(hDCMemory, hPalPrev, 0)
    End If
 
    'Delete our memory DC
    R = DeleteDC(hDCMemory)
 
    Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
End Function
 
 
Public Sub Screen_Shot_Event(Picture_ As PictureBox, Optional Active_Window As Boolean = False, Optional Draw_Cursor As Boolean = False)
Dim wScreen As Long
Dim hScreen As Long
Dim hdcScreen As Long
Dim w As Long
Dim h As Long
 
Dim TmpPic As PictureBox
Set TmpPic = Picture_
TmpPic.AutoRedraw = False
Dim lWnd As Long
Dim R
lWnd = GetForegroundWindow()
 
Picture_.Cls
wScreen = Screen.Width \ Screen.TwipsPerPixelX
hScreen = Screen.Height \ Screen.TwipsPerPixelY
Picture_.ScaleMode = vbPixels
w = Screen.Width / Screen.TwipsPerPixelX
h = Screen.Height / Screen.TwipsPerPixelY
hdcScreen = GetDC(0)
 
If Draw_Cursor = True Then DrawCursor hdcScreen
 
If Active_Window = False Then
Picture_.Width = (Screen.Width * Screen.TwipsPerPixelX)
Picture_.Height = (Screen.Height * Screen.TwipsPerPixelY)
'Picture_.AutoRedraw = False
R = StretchBlt(TmpPic.hdc, 0, 0, w, h, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy)
'Picture_.AutoRedraw = True
Else
If Active_Window = True Then
Dim rct As RECT
GetWindowRect lWnd, rct
'Picture_.AutoRedraw = False
R = StretchBlt(TmpPic.hdc, rct.Left * -1, rct.Top * -1, rct.Right, rct.Bottom, hdcScreen, 0, 0, rct.Right, rct.Bottom, vbSrcCopy)
Picture_.Width = (rct.Right * Screen.TwipsPerPixelX) - (rct.Left * Screen.TwipsPerPixelX) + 70
Picture_.Height = (rct.Bottom * Screen.TwipsPerPixelY) - (rct.Top * Screen.TwipsPerPixelY) + 70
'Picture_.AutoRedraw = True
End If
End If
 
Set Picture_.Picture = hDCToPicture(TmpPic.hdc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
 
End Sub

This code works, thanks for your help!