-
July 9th, 2010, 06:45 AM
#1
[RESOLVED] VBA: copy part of image
Hi,
For some more automatisation of some tasks at work I'm currently working on some code that should do the following:
I take a print screen of the active window and paste it in an image control "Image1" (not a picture control since these aren't available in VBA)? With a mouse_down, _move and _up event I can draw a 2nd image control (Image2) over the first one like a selection rectangle.
All this part is working. Now comes the part that I can't figure it out. When I push a command button "Cut" it should copy the part of Image1 where I drew the 2nd image over. Something like the "snipping tool" of windows vista.
I searched the web and already tried for some days to get it to work, but without succes.
I have read about paintpicture and what I can understand of it is that with paintpicture it should work and my issue should be solved. Unfortunately this isn't available with the Image control.
Can you help me?
note: My knowledge of vb and VBA is basic to moderate.
Thanks in advance..
-
July 12th, 2010, 01:46 AM
#2
Re: VBA: copy part of image
-
July 12th, 2010, 06:05 AM
#3
Re: VBA: copy part of image
I used the render method (somewhere I found omcode), but I can't get it to work. I tried the call .render method and the "with ... end with" method. Going step by step in the debugger, in both cases it passes the lines but Image2.picture is still empty
Declarations
Code:
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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any)
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicArray As Any, RefIID As Any, ByVal OwnsHandle As Long, IPic As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Type PictDesc
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type
Private Const StdPicGUID As String = "{00020400-0000-0000-C000-000000000046}"
The sub:
Code:
Sub Snipping
Dim myDC As Long
Dim OldBMP As Long
Dim myBMP As Long
Dim srcIPicture As IPicture
Dim Result As IPicture
Dim pd As PictDesc
Dim IPic(15) As Byte
myDC = CreateCompatibleDC(GetDC(0&))
myBMP = CreateCompatibleBitmap(GetDC(0&), Image1.Width, Image1.Height)
OldBMP = SelectObject(myDC, myBMP)
Set srcIPicture = Image1.Picture
With srcIPicture
.Render myDC, 0, 0, (Image2.Width / 15), (Image2.Height/ 15), _
SelXImg2 / 2540 * 1440, SelYImg2 / 2540 * 1440, _
(SelXImg2 + Image2.Width) / 2540 * 1440, -(SelYImg2 + Image2.Height) / 2540 * 1440, _
ByVal 0&
End With
'SelXImg2 and SelYImg2are are the points where I started the selection on Image1.
pd.cbSizeofStruct = Len(pd)
pd.picType = 1
pd.hImage = myBMP
CLSIDFromString StrPtr(StdPicGUID), IPic(0)
OleCreatePictureIndirect pd, IPic(0), True, Result
Set Image2.Picture = Result
DeleteObject SelectObject(myDC, OldBMP)
DeleteDC myDC
End sub
As in vba the scaleX and scaleY aren't available I tried to convert the units myself with some"most common" values.
Can someone help me?
Last edited by Error13; July 13th, 2010 at 07:57 AM.
-
July 12th, 2010, 10:46 AM
#4
Re: VBA: copy part of image
Seems it should work.
Only OleCreatePictureIndirect wants its fourth paramater to be of type IPicture.
Your Result variable is of type Image, which is a control. So maybe this function failed.
You could check if it fails like:
Code:
dim res as long
res = OleCreatePictureIndirect(pd, IPic(0), True, Result)
'instead of
'OleCreatePictureIndirect pd, IPic(0), True, Result
If res is zero the function was successful. A nonzero return value indicates an error.
I'd try
Dim Result as IPicture
instead of an Image.
-
July 13th, 2010, 03:53 AM
#5
Re: VBA: copy part of image
WoF,
thanks for your reply. I tried the line you suggested and indeed the res = 0. Meaning the function is succesful. However it still does not work my "Image2" is still empty and not filled with the part of Image1 I have "selected".
Any more suggestions please?
-
July 13th, 2010, 06:20 AM
#6
Re: VBA: copy part of image
Have you tried Image2.Refresh?
-
July 13th, 2010, 07:29 AM
#7
Re: VBA: copy part of image
I would like to try but the Image2.refresh isn't available nor does the .repaint.
Since the code I got is somewhere from the net I'm trying to understand what it exactly does. I don't know why we need the line of the "OldBMP = Selectobject ...." because when I delete this line my Image2 becomes a whole black box.
What I understand of the code so far is, first it takes a memory bitmap of image1.
Then with the .render it takes a part of image1 (= to the dimensions and start point of Image2) .
1) What I don't understand is, where is the render stored. It should be somewhere telling that x is the rendered part of image1.
Then the pd.... is creating the parameters for the new picture (PictDesc), the clsIDfromString converts the GUID string into the original Class ID (a picture, I think).
The olecreatePicture is actually creating the picture taking into account the picture parameters (pictdesc), the converted GUID string and put it into "result".
2) What I don't understand is, where is the link between the rendered picture and the new created picture?
3) the StdGuid (a private const declaration) is this correct?
Thanks for all your help so far.
Last edited by Error13; July 13th, 2010 at 07:32 AM.
-
July 13th, 2010, 08:00 AM
#8
Re: VBA: copy part of image
First a blank Bitmap with the same Size as Image1 is created and assigned to myDC
The Image1 redering has myDC as target -> store the rendered Picture in myDC (myBMP)
Then the BMP is converted to the iPicture Format
I have a similar function, but the GUID is diffrent
Code:
Function BitmapToPicture(hBitmap as Long)
Dim IPic As IPicture, picdes As PICTDESC, iidIPicture As GUID
' Fill picture description
picdes.cbSizeofstruct = Len(picdes)
picdes.picType = vbPicTypeBitmap '// = 1
picdes.hGDIObj = hBitmap
' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
iidIPicture.Data1 = &H7BF80980
iidIPicture.Data2 = &HBF32
iidIPicture.Data3 = &H101A
iidIPicture.Data4(0) = &H8B
iidIPicture.Data4(1) = &HBB
iidIPicture.Data4(2) = &H0
iidIPicture.Data4(3) = &HAA
iidIPicture.Data4(4) = &H0
iidIPicture.Data4(5) = &H30
iidIPicture.Data4(6) = &HC
iidIPicture.Data4(7) = &HAB
' Create picture from icon handle
OleCreatePictureIndirect picdes, iidIPicture, True, IPic
' Result will be valid Picture or Nothing--either way set it
Set BitmapToPicture = IPic
-
July 14th, 2010, 09:23 AM
#9
Re: VBA: copy part of image
Ok thanks alot for your support. Now I understand.
I think I might know why it is not working. Could it be due to an incorrect GUID string?
Code:
Private Const StdPicGUID As String = "{00020400-0000-0000-C000-000000000046}"
I saw that the one I use is different from the one you use (Dagnarus).
Can you help me on how do I determine which GUID to use?
Thanks in advance.
-
July 15th, 2010, 05:06 AM
#10
Re: VBA: copy part of image
I found some code to get the GUID from the references I use in this project.
I tried every GUID from the list. None is giving me the result in Image2.Picture.
Only the GUID posted in my code above is giving a 0 for "res" as WoF described. Also the GUID from Dagnarus code is giving me a 0 for "res". Meaning there is no error for the "OleCreatePictureIndirect" line with both GUID's however none is giving me the partial picture of image1 into Image2.
Can some CodeGuru's helpme please?
-
July 16th, 2010, 04:35 AM
#11
Re: VBA: copy part of image
Ok I tried some more and when I add the following code after the line
"set Image2.picture = Result"
Code:
Dim FileName as string
Filename = "C:\test.bmp"
SavePicture Result, FileName
and check if it worked. Well there is a bmp at C:\ called "test.bmp". When I open this image in any program it is just a black box with the correct size. The size of the selection box (Image2).
It only does not contain the part of the picture of Image1.
Does anyone know why it is a black box?
And the set Image2.picture = result has no result. Meaning the Image2 doesn't even show a black box.
All help is appreciated
-
July 20th, 2010, 07:37 AM
#12
Re: VBA: copy part of image
It seems to work, only some wrong X ad Y coordination which I can't solve (all the src ... part seems to be modified).
Code:
Set srcIPicture = Image1.Picture
tgtX = 0
tgtY = 0
tgtWidth = Image2.Width
tgtHeight = Image2.Height
srcX = SelXImg2 / 1440 * 2540 * TwipsPerPixelX
srcY = SelYImg2 / 1440 * 2540 * TwipsPerPixelY
srcWidth = (SelXImg2 + Image2.Width) / 1440 * 2540 * TwipsPerPixelX
srcHeight = -(SelYImg2 + Image2.Height) / 1440 * 2540 * TwipsPerPixelY
With srcIPicture
.Render myDC, tgtX, tgtY, tgtWidth, tgtHeight, srcX, srcY, srcWidth, srcHeight, ByVal 0&
End With
'SelXImg2 and SelYImg2 are the points where I started the selection of Image2 on Image1.
Just a question, in the render function the srcX and srcY are those seen of Image1 or of the form? Because the Image2.left and .top is different from the X and Y coordinates selected on Image1.
-
July 22nd, 2010, 08:36 AM
#13
Re: VBA: copy part of image
The render part is working, finaly. I had to put a correction factor to it. Why I don't know yet.
So my render function is looking like this:
Code:
Dim tgtX As Long
Dim tgtY As Long
Dim tgtWidth As Long
Dim tgtHeight As Long
Dim srcX As Long
Dim srcY As Long
Dim srcHeight As Long
Dim srcWidth As Long
tgtX = 0
tgtY = 0
tgtWidth = Image2.Width
tgtHeight = Image2.Height
srcX = SelXImg2 / 1440 * 2540 * TwipsPerPixelX * 1.333
srcY = Image1.Picture.Height - SelYImg2 / 1440 * 2540 * TwipsPerPixelY * 1.333
srcWidth = (Image2.Width) / 1440 * 2540 * TwipsPerPixelX * 1.333
srcHeight = -(Image2.Height) / 1440 * 2540 * TwipsPerPixelY * 1.333
With srcIPicture
.Render myDC, tgtX, tgtY, tgtWidth, tgtHeight, srcX, srcY, srcWidth, srcHeight, ByVal 0&
End With
When I save the rendered picture to a test.bmp and when I open it afterwards, it shows the renderd picture. Code is as follows:
Code:
pd.cbSizeofStruct = Len(pd)
pd.picType = 1
pd.hImage = myBMP
Dim res As Long
CLSIDFromString StrPtr(StdPicGUID), IPics(0)
'If res = 0 then function was succesful
res = OleCreatePictureIndirect(pd, IPics(0), True, Result)
Dim FileName as string
FileName = "C:\....." 'entered path and full filename as test.bmp
SavePicture Result, FileName
But when I try to set this result to another image box (Image3) it does not work.
I tried this:
Code:
pd.cbSizeofStruct = Len(pd)
pd.picType = 1
pd.hImage = myBMP
Dim res As Long
CLSIDFromString StrPtr(StdPicGUID), IPics(0)
'If res = 0 then function was succesful
res = OleCreatePictureIndirect(pd, IPics(0), True, Result)
Set Image3.Picture = Result
The result is an IPicture.
Can ayone advise me please?
-
November 22nd, 2010, 07:03 PM
#14
Re: VBA: copy part of image
Ah bless you. I must have searched long and hard throughout what seemed to be the entire internet only to find this topic which has exactly the implementation I was looking for.
I did note the same problem -- I was able to call SaveFile and the resulting image looked fine, but setting the .Picture property of an Image had no effect.
I did manage to find a resolution by plugging away at my code... I see the first edition of the code had the SelectObject call, and tried to release the objects -- I'm not sure if this was ommitted in later versions, or left out for brevity ..... if the former, this might do it:
Code:
myDC = CreateCompatibleDC(GetDC(0&))
myBMP = CreateCompatibleBitmap(GetDC(0&), newWidth, newHeight)
OldBMP = SelectObject(myDC, myBMP)
... etc.....
DeleteObject OldBMP
DeleteDC myDC
That got it working for me. Also, this page (http://www.vbforums.com/showthread.php?t=610000) has a pretty good description of the Render sub... I didn't use any of the code, but it does detail destination inputs are in pixels, while source parameters are in himetrics. Getting the source parameters can be done like so:
Code:
dim iPic as IPicture
set iPic = image1.picture
debug.print iPic.Height & "x" & iPic.Width
-
November 22nd, 2010, 09:47 PM
#15
Re: VBA: copy part of image
Great! Please pull down the thread tools at the top of the thread, and MARK IT AS RESOLVED!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|