StretchBlt in a OCX

orca999
orca999 used Ask the Experts™
on
I'm having a problem using StretchBlt in an OCX to manipulate an image.

When I’m using the picture.hdc (orginale image) in StrethBlt I don’t get the image but I getting a print of a screen.

This is the code I’m using.

‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
picOriginal.Picture = LoadPicture()
picOutPut.Picture = LoadPicture()
 
picOriginal.Picture = LoadPicture("c:\temp.jpg")
picOriginal.Visible = False
       picOutPut.Visible = True

picOutPut.ScaleMode = vbPixels
picOriginal.ScaleMode = vbPixels
 
Call SetStretchBltMode(picOutPut.hdc, STRETCHMODE)
 
StretchBlt(picOutPut.hdc, 0, 0, picOutPut.ScaleWidth, picOutPut.ScaleHeight, _
picOriginal.hdc, 0, 0, picOriginal.ScaleWidth, picOriginal.ScaleHeight, _   vbSrcCopy)
 
Call picOutPut.Refresh

‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’

Thanks Alfred
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
VK

Commented:
hello orca999,

perhaps you have forgotten to set the autodraw property of the pictureboxes to true.

v.k.
Commented:
If you want permamently change the picture of picOutPut use this (because you have to copy an object rather than painting):

Option Explicit

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject 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 SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Public Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc 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 hSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function IIDFromString Lib "OLE32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (ByRef PicDesc As PicBmp, ByRef RefIID As GUID, ByVal fPictureOwnsHandle As Long, ByRef ipic As IPicture) As Long

Public Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Public Enum CopyPictureStretchModeConstants
    cspDefault
    cspBlackOnWhite = 1
    cspWhiteOnBlack = 2
    cspColorOnColor = 3
    cspHalftone = 4
End Enum

Public 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

Public Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type

Public Function CopyPicture(Picture As StdPicture, ByVal Width As Long, ByVal Height As Long, StretchMode As CopyPictureStretchModeConstants) As StdPicture
    Dim nDCOrigin As Long
    Dim nDC1 As Long
    Dim nObjOrigin As Long
    Dim nObj1 As Long
    Dim nBitmap As BITMAP
    Dim nBmp1 As Long
   
    nDCOrigin = CreateCompatibleDC(0)
    nObjOrigin = SelectObject(nDCOrigin, Picture.Handle)
   
    GetObjectAPI Picture.Handle, Len(nBitmap), nBitmap
    nBmp1 = CreateCompatibleBitmap(nDCOrigin, Width, Height)
   
    nDC1 = CreateCompatibleDC(0)
    nObj1 = SelectObject(nDC1, nBmp1)
   
    Select Case StretchMode
        Case cspBlackOnWhite To cspHalftone
            SetStretchBltMode nDC1, StretchMode
    End Select
    StretchBlt nDC1, 0, 0, Width, Height, nDCOrigin, 0, 0, nBitmap.bmWidth, nBitmap.bmHeight, vbSrcCopy
   
    Set CopyPicture = PictureFromHandle(nBmp1, vbPicTypeBitmap, True)
   
    SelectObject nDC1, nObj1
    DeleteDC nDC1
   
    SelectObject nDCOrigin, nObjOrigin
    DeleteDC nDCOrigin
   
End Function

Public Function PictureFromHandle(ByVal Handle As Long, ByVal PictureType As PictureTypeConstants, Optional ByVal PictureOwnsHandle As Boolean = False) As StdPicture
    Dim nPicture As Picture
    Dim nPictDesc As PicBmp
    Dim nIID As GUID
    Dim nHResult As Long
   
    Const kPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
   
    With nPictDesc
        .Size = Len(nPictDesc)
        .Type = PictureType
        .hBmp = Handle
    End With
    nHResult = IIDFromString(StrConv(kPictureIID, vbUnicode), nIID)
    If nHResult Then
        Err.Raise nHResult
    Else
        nHResult = OleCreatePictureIndirect(nPictDesc, nIID, PictureOwnsHandle, nPicture)
        If nHResult Then
            Err.Raise nHResult
        Else
            Set PictureFromHandle = nPicture
        End If
    End If
End Function

regards

v.k.

Commented:
Quick summary, BitBlt/StretchBlt on an hDC will always copy the visible display of that hDC, which is why you need to use a Memory bitmap.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
Hello VK,

The code is working in a module with a form, but if I using it in my OCX if hvave the same problem again. I don't get the picure but instead a piece of a screen.

I have set the autodraw property to true.

Author

Commented:
Hello Nazdor,

Is a Memory bitmap API Call?

Thanks ALfred.

Commented:
A "memory bitmap" is a bitmap stored in memory, as opposed to stored directly on the screen.  I was summarising your findings and the code supplied by VK which uses a Memory Bitmap
VK

Commented:
Hi orca999 !

I used CopyPicture for an own ocx (Button-Control) and it worked well:

    With picButton(IIf(HasFocus, 1, 0) + IIf(IsPressed, 2, 0))
        'Set UserControl.Picture = CopyPicture(.Picture, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixelY, cspDefault)
        Set UserControl.MaskPicture = CopyPicture(picMask.Picture, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixelY, cspDefault)
        Call StretchBlt(UserControl.hdc, 0, 0, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixelY, .hdc, 0, 0, .Width / Screen.TwipsPerPixelX, .Height / Screen.TwipsPerPixelY, vbSrcCopy)
    End With

Copypicture also does resizing.

You must do something wrong.

v.k.

VK

Commented:
The error has to be in the context.

What type of ocx you have ?
Windowless or not for example is very important.
Picture, MaskPicture and ControlContainer Properties also.

Perhaps you have any other controls like SSTab or other OCX in the UserControl.

Author

Commented:
Hi VK,

I'm using a 2 Picturebox on the usercontrol.
Because of this the usrercontrol is property 'Windowless' False.
VK

Commented:
1. I have started a new usercontrol-project and added 2 pictureboxes with different size. Picture1 holds an image.

2. post the following code:

Private Sub UserControl_Initialize()
    Set Picture2.Picture = CopyPicture(Picture1.Picture, Picture2.Width / Screen.TwipsPerPixelX, Picture2.Height / Screen.TwipsPerPixelY, cspDefault)
End Sub

3. add a new project to the ocx project (normal exe)
4. add an instance of the usercontrol on Form1
5. you will see that the picture is copied to Picture2 and stretched if needed.

It works fine.

v.k.
VK

Commented:
you will get smarter results with:

Private Sub UserControl_Initialize()
    Set Picture2.Picture = CopyPicture(Picture1.Picture, Picture2.Width / Screen.TwipsPerPixelX, Picture2.Height / Screen.TwipsPerPixelY, cspHalftone)
End Sub

:-)

Commented:
I think the error lies in the hDC of the usercontrol..

See this excellent tutorial for graphics programming, focus on Device Contexts

http://edais.earlsoft.co.uk/Tutorials/Programming/DCtut/index.html

hope this helps...

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
- points to VK
Please leave any comments here within the
next seven days.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial