'In a Form
SaveJPG Picture1.Picture, App.Path & "\MyJpegPicture.jpg", 80 ' range is 0 to 100
'In a BAS file
Option Explicit
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Type EncoderParameter
GUID As GUID
NumberOfValues As Long
Type As Long
Value As Long
End Type
Public Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type
Public Declare Function GdiplusStartup Lib "GDIPlus" _
(token As Long, _
inputbuf As GdiplusStartupInput, _
Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" _
(ByVal hbm As Long, _
ByVal hPal As Long, _
Bitmap As Long) As Long
Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "GDIPlus" _
(ByVal Image As Long, _
ByVal filename As Long, _
clsidEncoder As GUID, _
encoderParams As Any) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Public Sub SaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Long) '= 80
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
' Initialize GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
' Create the GDI+ bitmap
' from the image handle
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
' Initialize the encoder GUID
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
' Initialize the encoder parameters
tParams.Count = 1
With tParams.Parameter ' Quality
' Set the Quality GUID
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.Type = 4
.Value = VarPtr(quality)
End With
' Save the image
lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
' Destroy the bitmap
GdipDisposeImage lBitmap
End If
' Shutdown GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
End If
End Sub
I have been using that code for some time, but recently I have been having problems with this line -
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
When the problem occurs the error code is 7
It used to run on a desktop PC (W7 Pro), and eventually it failed all the time.
We installed my program into a server (2008), and it ran fairly well there for a few weeks.
It is starting to have intermittent problems again.
It is only today I have narrowed the error down to that call.
Rob
PS The logic prior to using that Sub, is my program showing a form and taking screenshot of the form, and saving the screenshot into the picturebox, then doing the above call.
The code for saving the Form uses the clipboard, so I don't rule out that it could have a problem, and may be passing an empty picture box.
I would appreciate it, If anyone could point me to an alternate solution that does the following -
Screenshot of the active form, and saves it as a JPG file.
Last edited by Bobbles; Mar 26th, 2017 at 03:06 AM.
Reason: PS
I am no image expert, but I have been using the attached code without a single problem for a couple of years now. I use it for extracting/displaying coverart in metadata tags.
The code was written by Eric Weiss, I hope it is as useful to you as it has been to me.
You can try to find any errors by checking the return value of Err.LastDllError after each API call. Any error codes returned by it can be converted into a description using the FormatMessage API function. Hope this helps.
It will paint the current image of any hWnd (e.g. Form.hWnd) to any hDC of your choosing (e.g. PictureBox.hDC). If you could rework your code around this, it would remove a ton of potential problem areas (like the clipboard, PrintScreen, etc). Might be worth the trouble versus troubleshooting your existing solution.
I doubt this is related to the problem. But I do know that screen captures placed on the clipboard can create 32bpp bitmaps where the alpha channel is filled with garbage. VB's Clipboard.GetData happily brings that alpha channel in. Since VB doesn't recognize the alpha channel, no issues with VB. Unless GDI+ has an updated version of GdipCreateBitmapFromHBITMAP that honors the alpha channel, I wouldn't think that would be cause of problem either. I only bring this up because the scenario does exist and could be something to look into as a last resort. I have experienced these dirty alpha channels when I was developing my alpha image control which attempts to auto-interpret the alpha channel of 32bpp bitmaps.
Only other scenario I could possibly imagine is a 8 bit desktop? Not sure if would have an issue since you are passing 0 for the palette
Insomnia is just a byproduct of, "It can't be done"
You mention possibility of an empty picturebox? You should also probably ensure the stdPicture handle is not zero.
Thanks LaVolpe, that greatly helps narrow down the problem
I have added that test to my Debug text file.
When I get a problem the picturebox handle is 0
The next good run it is not 0
So that narrows the potential problem area to my capturing of the form into a picturebox
This is similar to what I originally found (probably the same author) -
'20170323 Author has tweaked it a bit EG Clipboard.clear now at beginning
'http://www.developerfusion.com/thread/26911/how-can-i-save-a-vb-form-as-image/
I may have added more DoEvents than the author (Desperate men do desperate things)
Code:
Public Function SaveFormPic() As Picture
Dim pic As StdPicture
Clipboard.Clear
Set pic = Clipboard.GetData(vbCFBitmap)
keybd_event vbKeyMenu, 0, 0, 0
keybd_event vbKeySnapshot, 0, 0, 0
DoEvents
keybd_event vbKeySnapshot, 0, KEYEVENTF_KEYUP, 0
keybd_event vbKeyMenu, 0, KEYEVENTF_KEYUP, 0
DoEvents
Set SaveFormPic = Clipboard.GetData(vbCFBitmap)
DoEvents
End Function
Here is one based on MS KB 161299: "How To Capture and Print the Screen, a Form, or Any Window."
Sample data included. It captures a secondary Form to a StdPicture object. Then it displays this in the primary Form (optional) and then saves as a JPEG file.
Here is one based on MS KB 161299: "How To Capture and Print the Screen, a Form, or Any Window."
Sample data included. It captures a secondary Form to a StdPicture object. Then it displays this in the primary Form (optional) and then saves as a JPEG file.
No PictureBox, no Clipboard, etc.
Should be ready to unzip, open in VB6, and run.
Thanks dilettante,
You beat me to it.
Tanner_H's post got me to change my Google search string.
I came across a beauty (does all sorts of captures to Picture box)
I don't think it uses Tanner_H's API, but thanks for making me look wider
I changed my main program to use the new capture approach, and it runs great.
I don't know what the CodeBank's rules are for pointing to another web site's sample code ?
If we are allowed to do that, I was just adding the 'Save To JPG' logic to it, and was going to post it all a separate thread, with the suggestion the moderator move it to the Codebank.
I will finish blending that together and testing, and will check out your post before posting anything.
Thanks for posting a solution
dillettante,
I will post this briefly here for you to peruse/consider.
It comes from http://www.thescarms.com/VBasic/capture.aspx
I have blended in the ability to save the Captured Form, to a JPG file. See attached
OOPs
No one noticed the slight bug, that my stressed frazzled brain overlooked.
I had built up the module, but forgot to call SaveJPG, instead of the SavePicture line
Code:
Private Sub cmdCaptureFormToJPG_Click()
Dim sPathAndFile As String
' Get the whole form inclusing borders, caption,...'
Set Picture1.Picture = CaptureForm(Me)
sPathAndFile = App.Path & "\" & "CapturedForm.jpg"
'SavePicture Picture1, sPathAndFile
SaveJPG Picture1, sPathAndFile, 100
End Sub
Also make the SaveJPG Sub Public in the bas file.
If I get brave enough, I will work out how to delete the attachment, and attach the fresh file
Last edited by Bobbles; Mar 31st, 2017 at 11:25 PM.
Reason: One code line change (had wrong call)
The old MS KB approach has issues with Form borders in post-Win7 OSs and I'm sure it has High DPI issues.
FWIW, I believe PrintWindow has the same problem(s). (Although you can avoid it by using the PW_CLIENTONLY flag, if you don't care about non-client areas.)
I have bad news.
The changed code has got rid of the problem 'picturebox handle is 0' (It has happened once since)
However the place where the code is to be used is a program running on a Server.
The program runs non stop all day, with no user logging in (to my program).
At midnight it automatically sends out emails of To Do Lists.
During working hours, other users can from their running copy of my program (installed on their PC), can request a Job Run.
They choose the day, and one of two options. Their program communicates to the 24 hour copy running on the server, and tell it to do the emailing of the Job Runs.
The server 24 hour program navigates to the appropriate Job Schedule, and captures it to JPG, and continues to open Job Dockets, and captures them to JPGs, then sends emails (with attachments) to each of the workers.
That is now working again provided I have a RDS session open to that Server login.
If I disconnect (not log off), then the images are all black
That never happened with the old logic.
I have installed (placed - as no install needed) the simple example I attached above with a timer to capture an image of itself every 20 secs.
If I am logged in, but RDS disconnected, we get black JPGs
If I am logged in and connected, it works
If I am logged in and connected, and I have minimized the RDS session, I get black JPGs
If I am logged in and connected, and I have mediumized the RDS session, it works
I trimmed dilettante's a bit (no modeless form, no RTF, and it captures it's own form every 20 secs)
I get the same results as above
(dilettante mentioned they both use similar capture logic)
Looks like I need to find another approach for Capture of a Form to a JPG
Rob
PS I am no server expert. In the next few days they are going to get a bigger license (to allow more sessions). Also they will THEN be getting Terminal Services. Will that shine any friendlier light on my situation ?
PPS Mediumized is a term I have trademarked/copyrighted. It is the state of a form between Minimized and maximized
I'm not sure a disconnected RDP session has access to any display driver resources, so hDC values may all be INVALID_HANDLE (-1) or something.
So to reliably render graphics in a program running in such a state you may not be able to use GDI or GDI+ at all, or perhaps just GDI calls against DIBs.
Yes, I think that's the problem. It seems that you CAN render into a memory DC though.
Probably not what you want to hear, since that means you have to draw what you want instead of just doing Form "capture" though.
Note that this isn't a grid control on a form, but an image I drew within an instance of my Drawing class.
Thanks dilettante,
That does exactly what you said.
I ran it on the server, and disconnected before 10secs. It rendered properly.
I doubt that I am capable of drawing the Job Schedules, and Job Dockets.
If I 'printed' them (presumably to a Form), is that a possible solution ?
You can probably print to a printer hDC, but I'm not sure what "printing" to a Form means except making GDI calls - which it already does.
I'm not saying there is no possible workaround, I'm just out of ideas how to do it under these circumstances. It is probably effectively the same as a non-interactive Windows Service at that point.
Here is another version of the same thing, doing more "printing" much as you might to a printer but printing into a bitmap graphic. The program saves as PNG images but you can save as JPEGs if you wanted to.
This version makes a random list of "tasks" from a custom text resources just to have some data to use.
Then it has a Timer that ticks every 2 seconds, generates a "task checklist" image from a random set of the "tasks" and writes it to disk. It does this 5 times, so after 10 seconds it completes.
Copy the compiled EXE to your server, RDP into it and run the program, disconnect, wait for the 10 seconds. Then reconnect and it should be complete. The 5 images should be in a created folder there.
I have been scouring high/low/wide and old posts, and came across this from jcis (in POST 2) - http://www.vbforums.com/showthread.p...Off-The-Screen
I figured if it could capture what was off the screen, it might solve my current problem of black images, when I don't have an active desktop (remote desktop must be running)
And it does work, even when I have my remote session disconnected.
There is one glitch - One of the forms has a SGrid2 on it, and it cannot see (capture) it. The background of the form shows instead.
Anyone got any thoughts on how to fix that ?
I notice the last post had someone with a similar complaint for his richtextbox.
I recall (not much these days) reading somewhere that some controls have their own window (or whatever). Perhaps that is the problem ?
In this particular case, i think I could live with just capturing the SGrid2 (without the containing form).
Anyone got thoughts on that ?
vbaccelerator created the free SGrid, and later released SGrid 2
No longer supported, but there are some people who use it exclusively (like me) on this forum http://www.vbaccelerator.com/home/VB..._2/article.asp