Not anywhere close to deep-thought-provoking code nor is it any breakthrough. I thought I'd share a workaround I've been using for awhile.
VB's SavePicture uses existing APIs that have the ability to be unicode compatible. If we bypass VB and use those APIs instead, problem solved.
In addition, depending on how the picture was created and assigned in VB, the original data is cached and that data can be saved. For example, if you load a JPG during design-view into a VB picture property, the actual JPG data is preserved, but if you try to call VB's SavePicture, it is saved as a bitmap and not a JPG. We can save the the image as a JPG copy. This does not mean VB or the APIs can convert the image to JPG, it simply means that if the original image format is maintained, it can be saved. This also applies to GIFs and icons that contain multiple sub-icons. Anyone can take the routine provided below and super-size it to allow optional parameters that would be used to identify requests for image conversion to other formats. I'll leave that to you.
Rule of thumb is that VB will cache original data when pictures are loaded during design-time, not runtime.
In the code below, notice the blue-highlighted text? If the blue text were removed, then if the passed tgtPicture parameter contained the original image data for GIF/JPG, then the original image data would be saved.
The above code is compatible with XP and above. The API SHCreateStreamOnFileEx doesn't exist on lower operating systems. If required, that API can be replaced with a custom function that:
- creates a compatible stream object (CreateStreamOnHGlobal API)
- saves the data to that stream (oPicture.SaveAsFile)
- creates a file (CreateFile API)
- reads the data from the stream pointer to the file (ReadFile API)
- close the file and unlock/release the stream
FYI: IUnknown and IPicture are valid objects in VB, they are just hidden by default from intellisense
VB's SavePicture uses existing APIs that have the ability to be unicode compatible. If we bypass VB and use those APIs instead, problem solved.
In addition, depending on how the picture was created and assigned in VB, the original data is cached and that data can be saved. For example, if you load a JPG during design-view into a VB picture property, the actual JPG data is preserved, but if you try to call VB's SavePicture, it is saved as a bitmap and not a JPG. We can save the the image as a JPG copy. This does not mean VB or the APIs can convert the image to JPG, it simply means that if the original image format is maintained, it can be saved. This also applies to GIFs and icons that contain multiple sub-icons. Anyone can take the routine provided below and super-size it to allow optional parameters that would be used to identify requests for image conversion to other formats. I'll leave that to you.
Rule of thumb is that VB will cache original data when pictures are loaded during design-time, not runtime.
In the code below, notice the blue-highlighted text? If the blue text were removed, then if the passed tgtPicture parameter contained the original image data for GIF/JPG, then the original image data would be saved.
Code:
' APIs used
Private Declare Function SHCreateStreamOnFileEx Lib "shlwapi.dll" (ByVal pszFile As Long, ByVal grfMode As Long, ByVal dwAttributes As Long, ByVal fCreate As Long, ByVal reserved As Long, ByRef ppstm As IUnknown) As Long
Private Declare Function GetFileAttributesW Lib "kernel32.dll" (ByVal lpFileName As Long) As LongCode:
Public Sub SavePictureEx(tgtPicture As IPictureDisp, ByVal FileName As String)
Dim oStream As IUnknown, oPicture As IPicture
Dim lRtn As Long, bFlagCreate As Long
Const INVALID_FILE_ATTRIBUTES As Long = -1&
Const STGM_CREATE As Long = &H1000&
Const STGM_WRITE As Long = &H1&
Const FILE_ATTRIBUTE_NORMAL = &H80&
If tgtPicture Is Nothing Then Exit Sub
If tgtPicture.Handle = 0& Then Exit Sub
If GetFileAttributesW(StrPtr(FileName)) = INVALID_FILE_ATTRIBUTES Then bFlagCreate = 1&
lRtn = SHCreateStreamOnFileEx(StrPtr(FileName), STGM_WRITE Or (STGM_CREATE * bFlagCreate), _
FILE_ATTRIBUTE_NORMAL, bFlagCreate, 0&, oStream)
If lRtn = 0& Then
Set oPicture = tgtPicture
If tgtPicture.Type = vbPicTypeBitmap Then
oPicture.SaveAsFile ByVal ObjPtr(oStream), 1&, lRtn ' always save as bitmap
ElseIf oPicture.KeepOriginalFormat Then
oPicture.SaveAsFile ByVal ObjPtr(oStream), 0&, lRtn ' save original data if it exists
Else
oPicture.SaveAsFile ByVal ObjPtr(oStream), 1&, lRtn ' save using VB's default SavePicture logic
End If
Set oStream = Nothing ' closes the file
Else
Err.Raise lRtn, "SavePictureEx"
End If
End Sub- creates a compatible stream object (CreateStreamOnHGlobal API)
- saves the data to that stream (oPicture.SaveAsFile)
- creates a file (CreateFile API)
- reads the data from the stream pointer to the file (ReadFile API)
- close the file and unlock/release the stream
FYI: IUnknown and IPicture are valid objects in VB, they are just hidden by default from intellisense