Solved

Copy contents from one Device Context to another

Posted on 2001-06-07
21
240 Views
Last Modified: 2012-05-04
I want to draw a picture on a Device context (picture box for example) and then transfer all the contents of that DC to the form's DC in oreder to prevent flickering.

Could someone tell me how I can copy the contents of one DC to another?
0
Comment
Question by:SADiver
  • 10
  • 10
21 Comments
 
LVL 10

Expert Comment

by:caraf_g
ID: 6162877
www.carobit.com/rubik/rubik.html

A small excerpt of code from the Graphics module. It should contain more or less the stuff you want


Option Explicit
Private msngOldX As Single
Private msngOldY As Single

Global gblnTurning As Boolean

Private Const BLACKNESS = &H42 ' (DWORD) dest = BLACK
Private Const DSTINVERT = &H550009       ' (DWORD) dest = (NOT dest)
Private Const MERGECOPY = &HC000CA       ' (DWORD) dest = (source AND pattern)
Private Const MERGEPAINT = &HBB0226      ' (DWORD) dest = (NOT source) OR dest
Private Const NOTSRCCOPY = &H330008      ' (DWORD) dest = (NOT source)
Private Const NOTSRCERASE = &H1100A6     ' (DWORD) dest = (NOT src) AND (NOT dest)
Private Const PATCOPY = &HF00021 ' (DWORD) dest = pattern
Private Const PATINVERT = &H5A0049       ' (DWORD) dest = pattern XOR dest
Private Const PATPAINT = &HFB0A09        ' (DWORD) dest = DPSnoo
Private Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const SRCERASE = &H440328        ' (DWORD) dest = source AND (NOT dest )
Private Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
Private Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
Private Const WHITENESS = &HFF0062       ' (DWORD) dest = WHITE

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Private Const IMAGE_BITMAP As Long = 0
Private Const IMAGE_ICON As Long = 1
Private Const IMAGE_CURSOR As Long = 2
Private Const LR_DEFAULTCOLOR      As Long = &H0
Private Const LR_MONOCHROME        As Long = &H1
Private Const LR_COLOR             As Long = &H2
Private Const LR_COPYRETURNORG     As Long = &H4
Private Const LR_COPYDELETEORG     As Long = &H8
Private Const LR_LOADFROMFILE      As Long = &H10
Private Const LR_LOADTRANSPARENT   As Long = &H20
Private Const LR_DEFAULTSIZE       As Long = &H40
Private Const LR_VGACOLOR          As Long = &H80
Private Const LR_LOADMAP3DCOLORS   As Long = &H1000
Private Const LR_CREATEDIBSECTION  As Long = &H2000
Private Const LR_COPYFROMRESOURCE  As Long = &H4000
Private Const LR_SHARED            As Long = &H8000
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Const pNull As Long = 0
Private Declare Function GetDIBColorTable Lib "gdi32" (ByVal hdc As Long, _
                                                       ByVal un1 As Long, _
                                                       ByVal un2 As Long, _
                                                       pRGBQuad As PALETTEENTRY) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, _
                                                                      ByVal nCount As Long, _
                                                                      lpObject As Any) As Long
Private Declare Function CreateHalftonePalette Lib "gdi32" (ByVal hdc As Long) As Long

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 Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

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 Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" ( _
    ByVal hWnd As Long) 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 Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104
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 hDCDest As Long, ByVal XDest As Long, _
    ByVal YDest As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hDCSrc As Long, _
    ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _
    As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hWnd As Long, ByVal hdc As Long) As Long
Type POINTAPI
        X As Long
        Y As Long
End Type
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Const WINDING As Long = 2

Public Function DrawACube(colDrawCollection As Collection) As Picture

Dim dblvSub As Double
Dim dblhSub As Double

Dim hEndResultDCSrc As Long
Dim hEndResultDC As Long
Dim hEndResultBmp As Long
Dim hEndResultBmpPrev As Long
Dim hEndResultPal As Long
Dim hEndResultPalPrev As Long

Dim lngReturnCode As Long

Dim holdBackgroundBitmap As Long
Dim holdBackgroundPalette As Long
Dim hBackgroundDC As Long
Dim bmBackground As BITMAP

Dim RasterCapsScrn As Long
Dim HasPaletteScrn As Long
Dim PaletteSizeScrn As Long
Dim LogPal As LOGPALETTE

Dim brush As Long
Dim old_brush As Long

Dim ptX As POINTAPI

Dim lngCount1 As Long
Dim objSquare As clsShape

Dim lngCollectionCounter As Long
Dim colDrawSquares As Collection

Dim hpen As Long
Dim old_pen As Long

Dim dblX21 As Double
Dim dblX41 As Double
Dim dblY21 As Double
Dim dblY41 As Double
Dim dblZ21 As Double
Dim dblZ41 As Double

Dim dblX0 As Double
Dim dblX1 As Double
Dim dblY0 As Double
Dim dblY1 As Double

Dim dblXStart As Double
Dim dblYStart As Double
Dim dblZStart As Double
Dim dblXNew As Double
Dim dblYNew As Double
Dim dblZNew As Double

Dim objPoint As clsPoint

'Get device context for client area.
hEndResultDCSrc = GetDC(GetDesktopWindow)

'Create a memory device context for the image.
hEndResultDC = CreateCompatibleDC(hEndResultDCSrc)

' Create a bitmap and place it in the memory DC.
hEndResultBmp = CreateCompatibleBitmap(hEndResultDCSrc, 550, 360)

'I don't know why this is done...
hEndResultBmpPrev = SelectObject(hEndResultDC, hEndResultBmp)

' Get screen properties.
RasterCapsScrn = GetDeviceCaps(hEndResultDCSrc, RASTERCAPS) ' Raster
                                                   ' capabilities.
HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette
                                                     ' support.
PaletteSizeScrn = GetDeviceCaps(hEndResultDCSrc, 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
    lngReturnCode = GetSystemPaletteEntries(hEndResultDCSrc, _
                                            0, _
                                            256, _
                                            LogPal.palPalEntry(0))
    hEndResultPal = CreatePalette(LogPal)
    ' Select the new palette into the memory DC and realize it.
    hEndResultPalPrev = SelectPalette(hEndResultDC, hEndResultPal, 0)
    lngReturnCode = RealizePalette(hEndResultDC)
End If

'Draw the background image
Dim lngSomeObject As Long
lngSomeObject = GetObjectAPI(hBackgroundBmp, 24, bmBackground)
hBackgroundDC = CreateCompatibleDC(hEndResultDC)
holdBackgroundBitmap = SelectObject(hBackgroundDC, hBackgroundBmp)
holdBackgroundPalette = SelectPalette(hEndResultDC, hBackgroundPalette, False)
RealizePalette hEndResultDC
BitBlt hEndResultDC, _
       0, _
       0, _
       550, _
       360, _
       hBackgroundDC, _
       100, _
       100, _
       SRCCOPY
SelectObject hBackgroundDC, holdBackgroundBitmap
SelectPalette hEndResultDC, holdBackgroundPalette, False
DeleteDC hBackgroundDC

Set objPoint = New clsPoint
For lngCollectionCounter = colDrawCollection.Count To 1 Step -1
    Set colDrawSquares = colDrawCollection(lngCollectionCounter)
    'Blank out cutout
    Dim PolyGonPoints(0 To 3) As POINTAPI
    hpen = CreatePen(0, 3, vbBlack)
    old_pen = SelectObject(hEndResultDC, hpen)
    For lngCount1 = 1 To colDrawSquares.Count
        Set objSquare = colDrawSquares(lngCount1)
        With objSquare
            PolyGonPoints(0).X = .Point(1).XDraw
            PolyGonPoints(0).Y = .Point(1).YDraw
            PolyGonPoints(1).X = .Point(2).XDraw
            PolyGonPoints(1).Y = .Point(2).YDraw
            PolyGonPoints(2).X = .Point(3).XDraw
            PolyGonPoints(2).Y = .Point(3).YDraw
            PolyGonPoints(3).X = .Point(4).XDraw
            PolyGonPoints(3).Y = .Point(4).YDraw
            If .FaceNumber = 0 Then
                brush = CreateSolidBrush(vbGreen)
            Else
                brush = CreateSolidBrush(vbGreen)
            End If
            old_brush = SelectObject(hEndResultDC, brush)
            Polygon hEndResultDC, PolyGonPoints(0), 4
            brush = SelectObject(hEndResultDC, old_brush)
            DeleteObject brush
            dblX21 = .Point(2).NewX3d - .Point(1).NewX3d
            dblX41 = .Point(4).NewX3d - .Point(1).NewX3d
            dblY21 = .Point(2).NewY3d - .Point(1).NewY3d
            dblY41 = .Point(4).NewY3d - .Point(1).NewY3d
            dblZ21 = .Point(2).NewZ3d - .Point(1).NewZ3d
            dblZ41 = .Point(4).NewZ3d - .Point(1).NewZ3d
            dblXStart = .Point(1).NewX3d
            dblYStart = .Point(1).NewY3d
            dblZStart = .Point(1).NewZ3d
            For dblhSub = 1 To objSquare.hCount
                For dblvSub = 1 To objSquare.vCount
                    If .FaceNumber = 0 Then
                        brush = CreateSolidBrush(.Colour)
                    Else
                        brush = CreateSolidBrush(gobjRubik.SquareColour(.FaceNumber, .SquareNumber(dblhSub, dblvSub)))
                    End If
                    old_brush = SelectObject(hEndResultDC, brush)
                    dblX0 = (dblhSub - 1) / .hCount
                    dblX1 = dblhSub / .hCount
                    dblY0 = (dblvSub - 1) / .vCount
                    dblY1 = dblvSub / .vCount
                    With objPoint
                        .OrgX3d = dblXStart + dblX0 * dblX21 + dblY0 * dblX41
                        .OrgY3d = dblYStart + dblX0 * dblY21 + dblY0 * dblY41
                        .OrgZ3d = dblZStart + dblX0 * dblZ21 + dblY0 * dblZ41
                        PolyGonPoints(0).X = .XDraw
                        PolyGonPoints(0).Y = .YDraw
                        .OrgX3d = dblXStart + dblX1 * dblX21 + dblY0 * dblX41
                        .OrgY3d = dblYStart + dblX1 * dblY21 + dblY0 * dblY41
                        .OrgZ3d = dblZStart + dblX1 * dblZ21 + dblY0 * dblZ41
                        PolyGonPoints(1).X = .XDraw
                        PolyGonPoints(1).Y = .YDraw
                        .OrgX3d = dblXStart + dblX1 * dblX21 + dblY1 * dblX41
                        .OrgY3d = dblYStart + dblX1 * dblY21 + dblY1 * dblY41
                        .OrgZ3d = dblZStart + dblX1 * dblZ21 + dblY1 * dblZ41
                        PolyGonPoints(2).X = .XDraw
                        PolyGonPoints(2).Y = .YDraw
                        .OrgX3d = dblXStart + dblX0 * dblX21 + dblY1 * dblX41
                        .OrgY3d = dblYStart + dblX0 * dblY21 + dblY1 * dblY41
                        .OrgZ3d = dblZStart + dblX0 * dblZ21 + dblY1 * dblZ41
                        PolyGonPoints(3).X = .XDraw
                        PolyGonPoints(3).Y = .YDraw
                    End With
                    Polygon hEndResultDC, PolyGonPoints(0), 4
                    brush = SelectObject(hEndResultDC, old_brush)
                    DeleteObject brush
                Next
            Next
        End With
    Next
    hpen = SelectObject(hEndResultDC, old_pen)
    DeleteObject hpen
Next
Set objPoint = Nothing

' Remove the new copies of the  on-screen image. <-why is this done?
hEndResultBmp = SelectObject(hEndResultDC, hEndResultBmpPrev)

' If the screen has a palette get back the palette that was
' selected in previously.
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    hEndResultPal = SelectPalette(hEndResultDC, hEndResultPalPrev, 0)
End If

' Release the device context resources back to the system.
lngReturnCode = DeleteDC(hEndResultDC)
lngReturnCode = ReleaseDC(GetDesktopWindow, hEndResultDCSrc)

'_______________________________________________________________________

' Call CreateBitmapPicture to create a picture object from the
' bitmap and palette handles. Then return the resulting picture
' object.
Set DrawACube = CreateBitmapPicture(hEndResultBmp, hEndResultPal)

End Function
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6162882
Also.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CreateBitmapPicture
'    - Creates a bitmap type Picture object from a bitmap and
'      palette.
'
' hBmp
'    - Handle to a bitmap.
'
' hPal
'    - Handle to a Palette.
'    - Can be null if the bitmap doesn't use a palette.
'
' Returns
'    - Returns a Picture object containing the bitmap.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
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
0
 

Author Comment

by:SADiver
ID: 6162962
quite large exerpt.... ;o)
Ill have a look, thanks caraf_q.
At this stage I'm having a closer look at the "BitBlt" function of GDI32.DLL

I'll lett you know what the verdict is!
tnx again.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6162988
Yeah. If you look under

'Draw the background image

You'll see me doing some BitBlt'ing myself

:o)
0
 

Author Comment

by:SADiver
ID: 6162989
IT WORKS!!!!!
Here is the easiest way man:

Private Declare Function BitBlt Lib "GDI32" ( _
      ByVal hDCDest As Long, ByVal XDest As Long, _
      ByVal YDest As Long, ByVal nWidth As Long, _
      ByVal nHeight As Long, ByVal hDCSrc As Long, _
      ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _
      As Long

BitBlt Form1.hDC, 0, 0, Picture1.Width, Picture1.Height, Picture1.hDC, 0, 0, vbSrcCopy

->
Hows that!!?
I'll be fine tuning it and then post the final code segment for reference purposes.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6163028
Yes. If you're simply copying from one visible control to another, that will do fine.

But it's better to create a memory device context, as you can mess around with that as much as you like, without anyone seeing anything, and finally placing the result in your picture box. That will minimise flickering to an absolute minimum, and that's what I'm using in the Rubik's Cube
0
 

Author Comment

by:SADiver
ID: 6163062
100% caraf_q!
I tested my birblt with a visible control.As soon as I made it invisible it would not print what I have drawn on it. It would however draw anything that was displayed on the screen at that location...

I will be Copy&Pasting your code and try it just now.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6163077
Cheers. Good luck
<fingers crossed>
0
 

Author Comment

by:SADiver
ID: 6163161
could I be a real dumn-nut
and ask you simplify that code so that us mortals can understand it?...

something like draw a rectangle on a memoryDC and copy the memory DC to the form..?
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6163188
I'm very busy at the moment but if I get a chance I'll do it later today. In the mean time, keep working at it. I find that if I'm stuck like that it sometimes suddenly "comes to me"....
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6163688
hearing...
0
 
LVL 10

Accepted Solution

by:
caraf_g earned 200 total points
ID: 6163830
What's most important to you is the code where I set up a memory Device Context:

'Get device context for client area.
hEndResultDCSrc = GetDC(GetDesktopWindow)

'Create a memory device context for the image.
hEndResultDC = CreateCompatibleDC(hEndResultDCSrc)

' Create a bitmap and place it in the memory DC.
hEndResultBmp = CreateCompatibleBitmap(hEndResultDCSrc, 550, 360)

'I don't know why this is done...
hEndResultBmpPrev = SelectObject(hEndResultDC, hEndResultBmp)

' Get screen properties.
RasterCapsScrn = GetDeviceCaps(hEndResultDCSrc, RASTERCAPS) ' Raster
                                                  ' capabilities.
HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette
                                                    ' support.
PaletteSizeScrn = GetDeviceCaps(hEndResultDCSrc, 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
   lngReturnCode = GetSystemPaletteEntries(hEndResultDCSrc, _
                                           0, _
                                           256, _
                                           LogPal.palPalEntry(0))
   hEndResultPal = CreatePalette(LogPal)
   ' Select the new palette into the memory DC and realize it.
   hEndResultPalPrev = SelectPalette(hEndResultDC, hEndResultPal, 0)
   lngReturnCode = RealizePalette(hEndResultDC)
End If
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6163851
To actually draw into that device context, I use some of the Brush and Pen APIs:

brush = CreateSolidBrush(vbGreen)
old_brush = SelectObject(hEndResultDC, brush)

hpen = CreatePen(0, 3, vbBlack)
old_pen = SelectObject(hEndResultDC, hpen)

once you have brush and pen you can draw things, e.g. by using the Polygon function:
Polygon hEndResultDC, PolyGonPoints(0), 4

You don't necessarily need BitBlt. You could use the above to draw something into a memory device context, and finally use the code at the end to create a "Picture" object

' Remove the new copies of the  on-screen image. <-why is this done?
hEndResultBmp = SelectObject(hEndResultDC, hEndResultBmpPrev)

' If the screen has a palette get back the palette that was
' selected in previously.
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
   hEndResultPal = SelectPalette(hEndResultDC, hEndResultPalPrev, 0)
End If

' Release the device context resources back to the system.
lngReturnCode = DeleteDC(hEndResultDC)
lngReturnCode = ReleaseDC(GetDesktopWindow, hEndResultDCSrc)

'_______________________________________________________________________

' Call CreateBitmapPicture to create a picture object from the
' bitmap and palette handles. Then return the resulting picture
' object.
Set objYourPictureObject = CreateBitmapPicture(hEndResultBmp, hEndResultPal)



And you can then simply set your picture box:
set YourPictureBox.Picture = objYourPictureObject
0
 

Author Comment

by:SADiver
ID: 6166550
Thanks so long!
I have been working on the following MSDN article:

ID: Q94961 How to Create a Transparent Bitmap Using Visual Basic

I had to translate a bit to get it working on GDI32, but so far things seems to be working.

When all is done I will post a complete project for reference purposes.

Thanks caraf_g ! You earned them points allready..
Just give me a while to nicely put everything into a package.
0
 

Author Comment

by:SADiver
ID: 6166821
hmm...OK I got that one working now.
The speed however is not what I had been expecting.

Do you mind if I ask a by-question?
(why)Is it necisary to create a bitmap?

I am actually drawing the face of a "Form"-usercontrol which is rezeable/moveable at runtime.
Instead of using Cls and redrawing (causes flashing) I wanted to draw in a memory DC and bitblt that to the form.

This prooves a bit slow, but at least it is not flashing.
I am trying to get the bear minimum code in my paint procedure to speed it up...Here is my UserControl Module Code:
0
 

Author Comment

by:SADiver
ID: 6166826
Option Explicit
 Dim srcDC As Long
 Dim Success As Long
 Dim hBrush As Long

Private Sub UserControl_Initialize()
    srcDC = CreateCompatibleDC(UserControl.hdc)
    hBrush = CreateSolidBrush(vbRed)
End Sub

Private Sub UserControl_Paint()
 Dim destScale As Long
 Dim hBmp As Long
 Dim awidth As Long
 Dim aheight As Long

     awidth = UserControl.ScaleWidth
     aheight = UserControl.ScaleHeight
     
     hBmp = CreateCompatibleBitmap(UserControl.hdc, _
awidth, aheight)
     SelectObject srcDC, hBmp
     SelectObject srcDC, hBrush
     
     Ellipse srcDC, 0, 0, awidth, aheight
     
     BitBlt UserControl.hdc, 0, 0, awidth, aheight, _
srcDC, 0, 0, RasterOpConstants.vbSrcCopy
     DeleteObject hBmp
End Sub

Private Sub UserControl_Resize()
    UserControl_Paint
End Sub

Private Sub UserControl_Terminate()
    DeleteObject hBrush
    DeleteDC srcDC
End Sub
0
 

Author Comment

by:SADiver
ID: 6166833
of course you would need some declares to get hold of the GDI API functions:

Public Type POINTAPI
        x As Long
        y As Long
End Type


Type bitmap
   bmType As Integer
   bmWidth As Integer
   bmHeight As Integer
   bmWidthBytes As Integer
   bmPlanes As String * 1
   bmBitsPixel As String * 1
   bmBits As Long
End Type

Public 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
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function CreateDIBPatternBrush Lib "gdi32" (ByVal hPackedDIB As Long, ByVal wUsage As Long) As Long
Public Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Const SRCCOPY = &HCC0020
Public Const SRCAND = &H8800C6
Public Const SRCPAINT = &HEE0086
Public Const NOTSRCCOPY = &H330008

0
 

Author Comment

by:SADiver
ID: 6166842
Thanks for pointing me in the right direction caraf_q!
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6166860
>Is it necisary to create a bitmap?

Don't know. Like yourself I got the basic APIs from elsewhere, and with a lot of sweat and tears I finally made it work.

In some cases like the use of brushes and pens I have a fair idea of what is going on, but in other cases I finally got it to work, and just left it at that.

I think I even left a couple of comments in there.... "Don't know why this is done". Indeed. Just found that if you took it out it would all go horribly wrong. But why!? Search me.

:o)
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 6166864
Oh, PS: Thanks a mill for the points!
0
 

Author Comment

by:SADiver
ID: 6166882
By the way...for all who are interested...
This is a nice bit of code to get started with:

ID: Q94961 How to Create a Transparent Bitmap Using Visual Basic

It will draw a bitmap on a control and you can set the color you want to be transparent...very nice!
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now