Create bitmap from stdpicture

Create bitmap from stdpicture

Post by Mike D Sut » Fri, 27 May 2005 15:58:25


> I'm trying to create a bitmap from a vb stdpicture by doing the following:
<code snipped>

An EMF file is stored as a HENHMETAFILE internally within the StdPicture rather than an HBITMAP which is what the code
you're using is expecting. Instead try using GetEnhMetaFileHeader() on the handle to retrieve the size of the EMF,
create a new Bitmap at the correct aspect ratio and use PlayEnhMetaFile() to draw the EMF to it. Of course this assumes
you actually want a Bitmap, if not then post back with some more information about what you're trying to accomplish.
Hope this helps,

Mike


- Microsoft Visual Basic MVP -
E-Mail: XXXX@XXXXX.COM
WWW: http://www.yqcomputer.com/
 
 
 

Create bitmap from stdpicture

Post by Ivan Debon » Fri, 27 May 2005 16:07:42

Basically, I just want to create a DIB section (using Steve's
(vbAccelerator)) great dibsection class and then use intel's jpg library
(also from Steve) to save the bitmap of a hwnd.

Originally I had code to get the dc of a handle and saves it as an emf. this
works fine and I wanted to enhance it so that I save as jpg to reduce the
file size (10k instead of 1.5MB).

So alternatively, I can skip the whole emf stuff and create a dib section
from the handle and save that to jpg, like this:

Public Function CreateFromHWnd( _
ByRef lhWnd As Long _
)
Dim lDC As Long
Dim hDC As Long
Dim hBmp As Long
Dim lhBmpOld As Long
Dim tR As RECT

lDC = GetDC(lhWnd)
GetClientRect lhWnd, tR

hDC = CreateCompatibleDC(lDC)
hBmp = CreateCompatibleBitmap(hDC, tR.Right - tR.Left, tR.Bottom -
tR.Top)
lhBmpOld = SelectObject(hDC, hBmp)
BitBlt hDC, 0, 0, (tR.Right - tR.Left), (tR.Bottom - tR.Top), lDC, 0, 0,
vbSrcCopy
CreateFromHBitmap hBmp
If lhBmpOld <> 0 Then
SelectObject lDC, lhBmpOld
End If
If hBmp <> 0 Then
DeleteObject hBmp
End If
DeleteDC hDC
End Function

The CreateFromHBitmap function is from Steve. The problem is that I get a
blackened pic.

Any ideas?

Thanks,
Ivan

"Mike D Sutton" < XXXX@XXXXX.COM > schrieb im Newsbeitrag

 
 
 

Create bitmap from stdpicture

Post by Marti » Fri, 27 May 2005 17:53:43

ou can use GDI+ API to save picture from stdPicture object in jpeg file
format.
You can find GDI+ on microsoft web site
http://www.microsoft.com/downloads/details.aspx?FamilyID=6a63ab9c-df12-4d41-933c-be590feaa05a&DisplayLang=en

Place the code below in standard module.
For example you can create a form with PictureBox.
Load bitmap into PictureBox and use SaveJPG function to save picture as jpg.

Option Explicit

' ----==== API Declarations ====----

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
Type As Long
Value As Long
End Type

Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" ( _
token As Long, _
inputbuf As GdiplusStartupInput, _
Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
ByVal hbm As Long, _
ByVal hPal As Long, _
Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
ByVal Image As Long, _
ByVal filename As Long, _
clsidEncoder As GUID, _
encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" ( _
ByVal str As Long, _
id As GUID) As Long

' ----==== SaveJPG ====----

Public Sub SaveJPG( _
ByVal pict As StdPicture, _
ByVal filename As String, _
Optional ByVal quality As Byte = 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



"Ivan Debono" < XXXX@XXXXX.COM > wrote in message
news: XXXX@XXXXX.COM ...
this
0,
PlayEnhMetaFile()


 
 
 

Create bitmap from stdpicture

Post by Ivan Debon » Fri, 27 May 2005 17:57:31

nd how do I save a DC to a JPG?

Ivan

"Martin" < XXXX@XXXXX.COM > schrieb im Newsbeitrag
news:d742ku$p65$ XXXX@XXXXX.COM ...


 
 
 

Create bitmap from stdpicture

Post by Marti » Fri, 27 May 2005 19:11:00

f you have memory DC look this code.
maybe it can help you to save yor dc into picturebox and then use
function form first post to save in jpg.
Add PictureBox on Form named Picture1

Option Explicit

Const RC_PALETTE As Long = &H100
Const SIZEPALETTE As Long = 104
Const RASTERCAPS As Long = 38
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll"
(PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic
As IPicture) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long)
As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As
Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As
Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries
As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As
LOGPALETTE) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal
hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As
Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x
As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As
Picture
Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID

'Fill GUID info
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'Fill picture info
With Pic
.Size = Len(Pic) ' Length of structure
.Type = vbPicTypeBitmap ' Type of Picture (bitmap)
.hBmp = hBmp ' Handle to bitmap
.hPal = hPal ' Handle to palette (may be null)
End With

'Create the picture
R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

'Return the new picture
Set CreateBitmapPicture = IPic
End Function
Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal
TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long,
HasPaletteScrn As Long
Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE

'Create a compatible device context
hDCMemory = CreateCompatibleDC(hDCSrc)
'Create a compatible
 
 
 

Create bitmap from stdpicture

Post by Ivan Debon » Sat, 28 May 2005 00:12:12

'm doing the following and have achieved saving to JPG through the DC but
I've got gray vertical lines and the contents of the jpg seem double the
size. Do I need a palette?

Public Function CreateFromhWnd( _
ByVal lhWnd As Long _
) As Long

' Copy the bitmap in lHDC:
Dim lhDC As Long
Dim lhDCCopy As Long
Dim lhBmpCopy As Long
Dim lhBmpCopyOld As Long
Dim lhDCC As Long
Dim tBM As BITMAP
Dim tR As RECT
Dim lWidth As Long
Dim lHeight As Long

lhDC = GetDC(lhWnd)
GetClientRect lhWnd, tR
lWidth = tR.Right - tR.Left
lHeight = tR.Bottom - tR.Top

lhDCC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
lhDCCopy = CreateCompatibleDC(lhDCC)
lhBmpCopy = CreateCompatibleBitmap(lhDCC, lWidth, lHeight)
lhBmpCopyOld = SelectObject(lhDCCopy, lhBmpCopy)

BitBlt lhDCCopy, 0, 0, lWidth, lHeight, lhDC, 0, 0, vbSrcCopy

If Not (lhDCC = 0) Then
DeleteDC lhDCC
End If
If Not (lhBmpCopyOld = 0) Then
SelectObject lhDCCopy, lhBmpCopyOld
End If
If Not (lhDCCopy = 0) Then
DeleteDC lhDCCopy
End If

CreateFromHBitmap lhBmpCopy

End Function

Public Function CreateFromHBitmap( _
ByVal hBmp As Long _
)
Dim lhDC As Long
Dim lhWnd As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBmp As BITMAP
GetObjectAPI hBmp, Len(tBmp), tBmp
If (Create(tBmp.bmWidth, tBmp.bmHeight)) Then
lhWnd = GetDesktopWindow()
lhDCDesktop = GetDC(lhWnd)
If (lhDCDesktop <> 0) Then
lhDC = CreateCompatibleDC(lhDCDesktop)
ReleaseDC lhWnd, lhDCDesktop ' 2003-07-05: Corrected for GDI leak
in Win98
If (lhDC <> 0) Then
lhBmpOld = SelectObject(lhDC, hBmp)
LoadPictureBlt lhDC
SelectObject lhDC, lhBmpOld
DeleteObject lhDC
End If
End If
End If

End Function


"Martin" < XXXX@XXXXX.COM > schrieb im Newsbeitrag
news:d7475q$2dg$ XXXX@XXXXX.COM ...


 
 
 

Create bitmap from stdpicture

Post by Mike D Sut » Sat, 28 May 2005 00:27:08

> Basically, I just want to create a DIB section (using Steve's

With you so far, the next line lost me though..


Wha?? It was my understanding from your original post that you had an EMF
handle that you wanted to save as a .JPG?


An EMF will usually be a lot smaller than an EMF file if small file sizes is
your goal.. JPEG will be a lot better than Bitmap for example but EMF is a
different type of media format.

<code snipped>

So you currently have a raster image embedded within an EMF file? If so
then why use an EMF file at all, please post a little more information about
exactly what you're trying to accomplish..

Mike


- Microsoft Visual Basic MVP -
E-Mail: XXXX@XXXXX.COM
WWW: http://www.yqcomputer.com/
 
 
 

Create bitmap from stdpicture

Post by Ivan Debon » Sat, 28 May 2005 00:48:43

eah it's a little complicated.

I need to capture the dc of a picturebox (in a client app). The whole
capture process happens in the server dll, and I pass the hwnd of the
picturebox to the server function. This function resizes the bitmap and
saves the jpg in a database.

I managed to get rid of the EMF stuff now, so I don't need that anymore. Now
I do the following, but the I get gray vertical lines in the jpg. The other
functions not included here are those of Steve's cDIBSection class.

Public Function CreateFromhWnd( _
ByVal lhWnd As Long _
) As Long

' Copy the bitmap in lHDC:
Dim lhDC As Long
Dim lhDCCopy As Long
Dim lhBmpCopy As Long
Dim lhBmpCopyOld As Long
Dim lhDCC As Long
Dim tBM As BITMAP
Dim tR As RECT
Dim lWidth As Long
Dim lHeight As Long
Dim lOldMode As Long

lhDC = GetDC(lhWnd)
GetClientRect lhWnd, tR
lWidth = tR.Right - tR.Left
lHeight = tR.Bottom - tR.Top

lhDCC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
lhDCCopy = CreateCompatibleDC(lhDCC)
lhBmpCopy = CreateCompatibleBitmap(lhDCC, lWidth, lHeight)
lhBmpCopyOld = SelectObject(lhDCCopy, lhBmpCopy)

lOldMode = SetStretchBltMode(lhDCCopy, STRETCH_HALFTONE)

BitBlt lhDCCopy, 0, 0, lWidth, lHeight, lhDC, 0, 0, vbSrcCopy

SetStretchBltMode lhDCCopy, lOldMode

If Not (lhDCC = 0) Then
DeleteDC lhDCC
End If
If Not (lhBmpCopyOld = 0) Then
SelectObject lhDCCopy, lhBmpCopyOld
End If
If Not (lhDCCopy = 0) Then
DeleteDC lhDCCopy
End If

CreateFromHBitmap lhBmpCopy

End Function

Public Function CreateFromHBitmap( _
ByVal hBmp As Long _
)
Dim lhDC As Long
Dim lhWnd As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBmp As BITMAP
GetObjectAPI hBmp, Len(tBmp), tBmp
If (Create(tBmp.bmWidth, tBmp.bmHeight)) Then
lhWnd = GetDesktopWindow()
lhDCDesktop = GetDC(lhWnd)
If (lhDCDesktop <> 0) Then
lhDC = CreateCompatibleDC(lhDCDesktop)
ReleaseDC lhWnd, lhDCDesktop ' 2003-07-05: Corrected for GDI leak
in Win98
If (lhDC <> 0) Then
lhBmpOld = SelectObject(lhDC, hBmp)
LoadPictureBlt lhDC
SelectObject lhDC, lhBmpOld
DeleteObject lhDC
End If
End If
End If

End Function


"Mike D Sutton" < XXXX@XXXXX.COM > schrieb im Newsbeitrag
news: XXXX@XXXXX.COM ...


 
 
 

Create bitmap from stdpicture

Post by Mike D Sut » Sat, 28 May 2005 03:21:12

> I need to capture the dc of a picturebox (in a client app). The whole

Try drawing the image to a DC before you save it to the JPEG and see if the grey vertical lines are sill there, if so
then it's part of the image data itself otherwise it's something to do with the JPEG saving code.
Hope this helps,

Mike


- Microsoft Visual Basic MVP -
E-Mail: XXXX@XXXXX.COM
WWW: http://www.yqcomputer.com/
 
 
 

Create bitmap from stdpicture

Post by Ivan Debon » Sat, 28 May 2005 13:38:32

How can I get the bitmap of an existing dc?

"Mike D Sutton" < XXXX@XXXXX.COM > schrieb im Newsbeitrag
 
 
 

Create bitmap from stdpicture

Post by Mike D Sut » Sat, 28 May 2005 17:14:53

> How can I get the bitmap of an existing dc?

Use the GetCurrentObject() API call with the OBJ_BITMAP flag. Be aware though that many GDI functions that operate on a
Bitmap (Particularly those that use DDB's) require exclusive access to it and if it's already selected into a DC they
will fail. In these situations you may need to temporarily de-select the Bitmap from the DC before trying to use it, it
really depends on what you're trying to do though and where you're trying to do it.
Hope this helps,

Mike


- Microsoft Visual Basic MVP -
E-Mail: XXXX@XXXXX.COM
WWW: http://www.yqcomputer.com/