| Newbie | | Join Date: Oct 2009
Posts: 11
| |
i have picturedata and i want to save that to image file how i can do that
i have this function but not working for all images - Function FPictureDataToClipBoard(ctl As Variant) As Boolean
-
' Memory Vars
-
Dim hGlobalMemory As Long
-
Dim lpGlobalMemory As Long
-
Dim hClipMemory As Long
-
-
' Cf_metafilepict structure
-
Dim cfm As METAFILEPICT
-
-
' Handle to a Memory Metafile
-
Dim hMetafile As Long
-
-
' Which ClipBoard format is contained in the PictureData prop
-
Dim CBFormat As Long
-
-
' Byte array to hold the PictureData prop
-
Dim bArray() As Byte
-
-
' Temp var
-
Dim lngRet As Long
-
-
On Error GoTo Err_PtoC
-
-
' Resize to hold entire PictureData prop
-
ReDim bArray(LenB(ctl) - 1)
-
-
' Copy to our array
-
bArray = ctl
-
-
' Determine which ClipBoard format we are using
-
Select Case bArray(0)
-
-
-
Case 40
-
' This is a straight DIB.
-
CBFormat = CF_DIB
-
' MSDN states to Allocate moveable|Shared Global memory
-
' for ClipBoard operations.
-
hGlobalMemory = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE Or GMEM_ZEROINIT, UBound(bArray) + 1)
-
If hGlobalMemory = 0 Then _
-
Err.Raise vbObjectError + 515, "ImageToClipBoard.modImageToClipBoard", _
-
"GlobalAlloc Failed..not enough memory"
-
-
' Lock this block to get a pointer we can use to this memory.
-
lpGlobalMemory = GlobalLock(hGlobalMemory)
-
If lpGlobalMemory = 0 Then _
-
Err.Raise vbObjectError + 516, "ImageToClipBoard.modImageToClipBoard", _
-
"GlobalLock Failed"
-
-
' Copy DIB as is in its entirety
-
apiCopyMemory ByVal lpGlobalMemory, bArray(0), UBound(bArray) + 1
-
-
' Unlock the memory in preparation to copy to the clipboard
-
If GlobalUnlock(hGlobalMemory) <> 0 Then _
-
Err.Raise vbObjectError + 517, "ImageToClipBoard.modImageToClipBoard", _
-
"GlobalUnLock Failed"
-
-
-
Case CF_ENHMETAFILE
-
' New Enhanced Metafile(EMF)
-
CBFormat = CF_ENHMETAFILE
-
' Create a Memory based Metafile we can pass to the ClipBoard
-
hMetafile = SetEnhMetaFileBits(UBound(bArray) + 1 - 8, bArray(8))
-
-
-
Case CF_METAFILEPICT
-
' Old Metafile format(WMF)
-
CBFormat = CF_METAFILEPICT
-
' Create a Memory based Metafile we can pass to the ClipBoard
-
' We need to convert from the older WMF to the new EMF format
-
' Copy the Metafile Header over to our Local Structure
-
apiCopyMemory cfm, bArray(8), Len(cfm)
-
' By converting the older WMF to EMF this
-
' allows us to have a single solution for Metafiles.
-
' 24 is the number of bytes in the sum of the
-
' METAFILEPICT structure and the 8 byte ClipBoard Format struct.
-
hMetafile = SetWinMetaFileBits(UBound(bArray) + 24 + 1 - 8, bArray(24), 0&, cfm)
-
-
-
Case Else
-
'Should not happen
-
Err.Raise vbObjectError + 514, "ImageToClipBoard.modImageToClipBoard", _
-
"Unrecognized PictureData ClipBoard format"
-
-
End Select
-
-
' Can we open the ClipBoard.
-
If OpenClipboard(0&) = 0 Then _
-
Err.Raise vbObjectError + 518, "ImageToClipBoard.modImageToClipBoard", _
-
"OpenClipBoard Failed"
-
-
' Always empty the ClipBoard First. Not the friendliest thing
-
' to do if you have several programs interacting!
-
Call EmptyClipboard
-
-
' Now set the Image to the ClipBoard
-
If CBFormat = CF_ENHMETAFILE Or CBFormat = CF_METAFILEPICT Then
-
-
' Remember we can use this logic for both types of Metafiles
-
' because we converted the older WMF to the newer EMF.
-
hClipMemory = SetClipboardData(CF_ENHMETAFILE, hMetafile)
-
-
Else
-
' We are dealing with a standard DIB.
-
hClipMemory = SetClipboardData(CBFormat, hGlobalMemory)
-
-
End If
-
-
If hClipMemory = 0 Then _
-
Err.Raise vbObjectError + 519, "ImageToClipBoard.modImageToClipBoard", _
-
"SetClipBoardData Failed"
-
-
' Close the ClipBoard
-
lngRet = CloseClipboard
-
If lngRet = 0 Then _
-
Err.Raise vbObjectError + 520, "ImageToClipBoard.modImageToClipBoard", _
-
"CloseClipBoard Failed"
-
-
' Signal Success!
-
FPictureDataToClipBoard = True
-
-
-
Exit_PtoC:
-
Exit Function
-
-
-
Err_PtoC:
-
FPictureDataToClipBoard = False
-
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
-
Resume Exit_PtoC
-
-
End Function
i need a function that work for all type of images like embaded on button image ole log how i can do that
|
