470,586 Members | 1,338 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 470,586 developers. It's quick & easy.

Picturedata to image

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
Expand|Select|Wrap|Line Numbers
  1. Function FPictureDataToClipBoard(ctl As Variant) As Boolean
  2. ' Memory Vars
  3. Dim hGlobalMemory As Long
  4. Dim lpGlobalMemory As Long
  5. Dim hClipMemory As Long
  6.  
  7. ' Cf_metafilepict structure
  8. Dim cfm As METAFILEPICT
  9.  
  10. ' Handle to a Memory Metafile
  11. Dim hMetafile As Long
  12.  
  13. ' Which ClipBoard format is contained in the PictureData prop
  14. Dim CBFormat As Long
  15.  
  16. ' Byte array to hold the PictureData prop
  17. Dim bArray() As Byte
  18.  
  19. ' Temp var
  20. Dim lngRet As Long
  21.  
  22. On Error GoTo Err_PtoC
  23.  
  24. ' Resize to hold entire PictureData prop
  25. ReDim bArray(LenB(ctl) - 1)
  26.  
  27. ' Copy to our array
  28. bArray = ctl
  29.  
  30. ' Determine which ClipBoard format we are using
  31. Select Case bArray(0)
  32.  
  33.  
  34. Case 40
  35. ' This is a straight DIB.
  36. CBFormat = CF_DIB
  37. ' MSDN states to Allocate moveable|Shared Global memory
  38. ' for ClipBoard operations.
  39. hGlobalMemory = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE Or GMEM_ZEROINIT, UBound(bArray) + 1)
  40. If hGlobalMemory = 0 Then _
  41. Err.Raise vbObjectError + 515, "ImageToClipBoard.modImageToClipBoard", _
  42.    "GlobalAlloc Failed..not enough memory"
  43.  
  44. ' Lock this block to get a pointer we can use to this memory.
  45. lpGlobalMemory = GlobalLock(hGlobalMemory)
  46. If lpGlobalMemory = 0 Then _
  47. Err.Raise vbObjectError + 516, "ImageToClipBoard.modImageToClipBoard", _
  48.    "GlobalLock Failed"
  49.  
  50. ' Copy DIB as is in its entirety
  51. apiCopyMemory ByVal lpGlobalMemory, bArray(0), UBound(bArray) + 1
  52.  
  53. ' Unlock the memory in preparation to copy to the clipboard
  54. If GlobalUnlock(hGlobalMemory) <> 0 Then _
  55. Err.Raise vbObjectError + 517, "ImageToClipBoard.modImageToClipBoard", _
  56.    "GlobalUnLock Failed"
  57.  
  58.  
  59. Case CF_ENHMETAFILE
  60. ' New Enhanced Metafile(EMF)
  61. CBFormat = CF_ENHMETAFILE
  62. ' Create a Memory based Metafile we can pass to the ClipBoard
  63. hMetafile = SetEnhMetaFileBits(UBound(bArray) + 1 - 8, bArray(8))
  64.  
  65.  
  66. Case CF_METAFILEPICT
  67. ' Old Metafile format(WMF)
  68. CBFormat = CF_METAFILEPICT
  69. ' Create a Memory based Metafile we can pass to the ClipBoard
  70. ' We need to convert from the older WMF to the new EMF format
  71. ' Copy the Metafile Header over to our Local Structure
  72. apiCopyMemory cfm, bArray(8), Len(cfm)
  73. ' By converting the older WMF to EMF this
  74. ' allows us to have a single solution for Metafiles.
  75. ' 24 is the number of bytes in the sum of the
  76. ' METAFILEPICT structure and the 8 byte ClipBoard Format struct.
  77. hMetafile = SetWinMetaFileBits(UBound(bArray) + 24 + 1 - 8, bArray(24), 0&, cfm)
  78.  
  79.  
  80. Case Else
  81. 'Should not happen
  82. Err.Raise vbObjectError + 514, "ImageToClipBoard.modImageToClipBoard", _
  83.    "Unrecognized PictureData ClipBoard format"
  84.  
  85. End Select
  86.  
  87.  ' Can we open the ClipBoard.
  88. If OpenClipboard(0&) = 0 Then _
  89. Err.Raise vbObjectError + 518, "ImageToClipBoard.modImageToClipBoard", _
  90. "OpenClipBoard Failed"
  91.  
  92. ' Always empty the ClipBoard First. Not the friendliest thing
  93. ' to do if you have several programs interacting!
  94. Call EmptyClipboard
  95.  
  96. ' Now set the Image to the ClipBoard
  97. If CBFormat = CF_ENHMETAFILE Or CBFormat = CF_METAFILEPICT Then
  98.  
  99.     ' Remember we can use this logic for both types of Metafiles
  100.     ' because we converted the older WMF to the newer EMF.
  101.     hClipMemory = SetClipboardData(CF_ENHMETAFILE, hMetafile)
  102.  
  103. Else
  104. ' We are dealing with a standard DIB.
  105. hClipMemory = SetClipboardData(CBFormat, hGlobalMemory)
  106.  
  107. End If
  108.  
  109. If hClipMemory = 0 Then _
  110.     Err.Raise vbObjectError + 519, "ImageToClipBoard.modImageToClipBoard", _
  111.     "SetClipBoardData Failed"
  112.  
  113. ' Close the ClipBoard
  114. lngRet = CloseClipboard
  115. If lngRet = 0 Then _
  116.     Err.Raise vbObjectError + 520, "ImageToClipBoard.modImageToClipBoard", _
  117.     "CloseClipBoard Failed"
  118.  
  119.   ' Signal Success!
  120. FPictureDataToClipBoard = True
  121.  
  122.  
  123. Exit_PtoC:
  124. Exit Function
  125.  
  126.  
  127. Err_PtoC:
  128. FPictureDataToClipBoard = False
  129. MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
  130. Resume Exit_PtoC
  131.  
  132. 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
Oct 22 '09 #1
1 6660
maxamis4
295 Expert 100+
My friend here you go. This is an unbound object way of doing pictures.

http://www.databasedev.co.uk/image-form.html

As far as the buttons go, what you need to do is name the controls in a table based on the names. Reference the names in the table with the controls in the form, while looping through the form controls and find the image associated with the name. I hope i am making sense.
Oct 30 '09 #2

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

3 posts views Thread by trojacek | last post: by
15 posts views Thread by Anand Ganesh | last post: by
7 posts views Thread by lgbjr | last post: by
reply views Thread by Frank Schlüter | last post: by
2 posts views Thread by Dominic Vella | last post: by
5 posts views Thread by Dominic Vella | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.