1 Attachment(s)
Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
The best part is that it will show you the mouse on the picturebox but it won't be there in the saved file lol? what is the problem can a guru check it out please?
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
What is what problem? It would be helpful if you completely describe the problem
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
The code works for me, saving the captured image to a file in to app.path directory.
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Quote:
Originally Posted by
LaVolpe
What is what problem? It would be helpful if you completely describe the problem
The mouse is shown on the picturebox after capture but when you save the file the mouse will not be there in the saved file.
Quote:
Originally Posted by
Nightwalker83
The code works for me, saving the captured image to a file in to app.path directory.
Check your saved picture, is there mouse in the picture?
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Your main problem is you are saving the Picture and not the image.
In your code you are setting the screen capture to as the picture for the picturebox and then you are adding the cursor on top of the picture. Think of this as a layer on top of the picture. This is not merged into the picture. Then when you go to save the picture it only save the main layer.
The image on the other hand contains every thing you see. The problem with the image is if the picture is larger than the picturebox the image property only saves what is visible an crops out the rest. That is why I added a picturebox at runtime to work with.
Anyway, just change the code in your button click and this should work.
Code:
Private Sub Cscreen_Click()
Dim pic As PictureBox
' Dynamically create a picturebox to hold your capture
Set pic = Controls.Add("VB.PictureBox", "pic")
' Allow it to autoresize so it captures the entire screen
pic.AutoSize = True
' Autoredraw needs to be set so the cursor is retained between repaints
pic.AutoRedraw = True
' Do the screen capture
pic.Picture = CaptureScreen
' Add the mouse to the Capture
PaintCursor pic
' Save the image. The image is what you see.
' The picture does not contain the cusor
SavePicture pic.Image, App.Path & "\ScreenShot.bmp"
' optional - display the capture in the app window
Pscreen.Picture = pic.Image
' Remove the dynamically created picturebox
Controls.Remove pic
Set pic = Nothing
End Sub
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
You simply need to do 3 things.
1. Set Pscreen.AutoRedraw equal to True
2. Set Pscreen.Autosize equal to True
3. Add the line: Pscreen.Picture = Pscreen.Image before your SavePicture call
vb Code:
Private Sub Cscreen_Click()
'TakeScreenShot Pscreen, App.Path & "\ScreenShot.bmp"
Pscreen.AutoRedraw = True
Pscreen.AutoSize = True
'Capture the screen
Pscreen.Picture = CaptureScreen
'Capture the mouse
PaintCursor Pscreen
Pscreen.Picture = Pscreen.Image
'Finally Save
SavePicture Pscreen.Picture, App.Path & "\ScreenShot.bmp"
End Sub
Tom
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Quote:
Originally Posted by
ufo973
Check your saved picture, is there mouse in the picture?
No! Is it suppose to be?
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Quote:
Originally Posted by
Tom Moran
You simply need to do 3 things.
1. Set Pscreen.AutoRedraw equal to True
2. Set Pscreen.Autosize equal to True
3. Add the line: Pscreen.Picture = Pscreen.Image before your SavePicture call
vb Code:
Private Sub Cscreen_Click()
'TakeScreenShot Pscreen, App.Path & "\ScreenShot.bmp"
Pscreen.AutoRedraw = True
Pscreen.AutoSize = True
'Capture the screen
Pscreen.Picture = CaptureScreen
'Capture the mouse
PaintCursor Pscreen
Pscreen.Picture = Pscreen.Image
'Finally Save
SavePicture Pscreen, App.Path & "\ScreenShot.bmp"
End Sub
Tom
Thanx it works :thumb:
But there is still one problem the mouse position is not acurate? I couldn't figure it out, can you guys check it plz?
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Quote:
Originally Posted by
ufo973
Thanx it works :thumb:
But there is still one problem the mouse position is not acurate? I couldn't figure it out, can you guys check it plz?
If I use Tom's code then capture an image I compare both the image in the program to that of the image in the file. The mouse pointer seems to be in the same location in both.
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Mouse pointer is in correct location in my tests as well.
1 Attachment(s)
Re: Here is Screen Shot/Capture + Mouse + No clipboard + No dll ocx
Not sure exactly which X,Y coords GetCursorPos returns. If it is the cursor's hotspot, then you cannot use a generic offset of iconSize when painting the cursor because the hotspot can be anywhere between 0,0 and iconsize,iconsize.
Edited: Appears the hotspot is what is being returned. See attached image. When I took the capture, the cursor point was at the far left/bottom of the letter "a" in a WordPad document. You can see that is not where it was painted. Suggest using GetIconInfo API and use the cursor's hotspot as the offset to base painting.
Also, point of accuracy. Your iconSize offset value is incorrect. You are hardcoding it to 9 and I think I know why. If using a standard cursor (arrow pointing northwest), the hotspot for that system cursor is probably 10,10 as it is on my pc. GetIconInfo API will return the cursor's hotspot. So your calculation becomes
Code:
Dim ICI As ICONINFO
...
GetIconInfo hCursor, ICI
If ICI.hbmMask Then DeleteObject ICI.hbmMask ' must delete these if they were created
If ICI.hbmColor Then DeleteObject ICI.hbmColor
DrawIcon PictureBox.hdc, pt.x - ICI.xHotspot, pt.y - ICI.yHotspot, hCursor
...
Here are the declarations
Code:
Private Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As Any) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Attachment 86763