Prev: Are PDB files used by VB6
Next: Get Selected Path From Explorer
From: se on 2 Aug 2010 10:31

"Shotgun Thom" <tmoran4511(a)gmail.com> skrev i meddelelsen
news:ec98930c-1768-4419-8b51-2ab6a77baaa7(a)t5g2000prd.googlegroups.com...
> Nando...
>
> There are plenty of free resources out there for saving an image in
> the PNG format.
>
> One is the Free Image open source DLL. It even has VB6 examples.
> It's open source and available at:
>
> http://freeimage.sourceforge.net/sourcecode.html
>
> Even Microsoft provides that ability with the Windows Image
> Acquisition Library (WIA) found here:
>
> http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=a332a77a-01b8-4de6-91c2-b7ea32537e29
>
> Mike Williams also gave you a good resource at vbAcclerator.
>
> And, btw, Mike.... one man's waffle is another man's treasure. I
> usually learn something with your "waffles". Don't stop now!
>
> Tom
>

It constitutes a long chain to trace back:

* From: "senn" <senn(a)homeplace&.fix>
* Date: Sun, 18 May 2008 19:34:26 +0200

"Mike Williams" <mikea(a)xxxxxxxxxxxxxxxxx> skrev i en meddelelse
news:ucj7kpPuIHA.3968(a)xxxxxxxxxxxxxxxxxxxxxxx

Okay, Senn. I'll give it a whirl later. What do I need to download and
install in order to make it work? Can you post a link?

Mike


GDI+ TypeLib TLB
-Unicode Logo
Generator
http://www.planet-source-code.com/upload_PSC/ftp/GDI+_TypeL154059272003.zip

/senn

And Karls answer to this back then:

None of that nonsense. And, even if you're stuck using that other lib, you
can
still use FreeImage_GetFileType to tell you what sort of file you're dealing
with.
:-)
--
...NET: It's About Trust!

http://vfred.mvps.org

/se

From: Nando on 2 Aug 2010 16:08
senn wrote:
>
> GDI+ TypeLib TLB
> -Unicode Logo
> Generator
> http://www.planet-source-code.com/upload_PSC/ftp/GDI+_TypeL154059272003.zip
>
> /senn
>
> And Karls answer to this back then:
>
> None of that nonsense. And, even if you're stuck using that other lib,
> you can
> still use FreeImage_GetFileType to tell you what sort of file you're
> dealing with.
> :-)

Hi guys! I must share that I spent a great deal of time yesterday and
today understanding and implementing the GDI+ TypeLib routines within my
app. I just couldn't resist the temptation of having more than one file
type to save to (I only needed .PNG but I got greedy). GDI+ seemed to
offer so many other file types. Unfortunately after so much work and
troubleshooting I found I can only generate 32-bit transparent PNG files
and never 24-bit ones (just the very ones I need, since the 24-bit PNGs
do not support transparency and I cannot have transparency :-( Oh
well... can somebody just confirm this? Thanks!

-Nando

P.S.: Seems like the parameter "EncoderColorDepth" can only be set for
..JPG and .TIF. Seems like the GDI+ PNG codec just ignore any parameter.
From: Nando on 2 Aug 2010 16:24
Shotgun Thom wrote:
>
> There are plenty of free resources out there for saving an image in
> the PNG format.
>
> One is the Free Image open source DLL. It even has VB6 examples.
> It's open source and available at:
>
> http://freeimage.sourceforge.net/sourcecode.html

That is great Tom! I'll definetly look into that free image library. I
like the fact that you say they have VB6 examples! Awesome!

> Even Microsoft provides that ability with the Windows Image
> Acquisition Library (WIA) found here:
>
> http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=a332a77a-01b8-4de6-91c2-b7ea32537e29

Interesting, I would like to try that (WIA Lib). Although I'm quite
scare now, since I spent too much time already with another Microsoft
library (GDI+) just to find out that it does not really do what I
wanted. I'll look into WIA Lib, but with reserves.

I'm not doing too much image manipulation in my app, just need to save a
bitmap file to a 24-bit PNG file. I also needed to read the bitmap and
create a new one setting DPI and resize it using basic
"Nearest-Neighbor" interpolation. I had all that figured out and set up
in my app using GDI+ (which until yesterday I never worked with). Now I
have to start from scratch. Hopefully the Free Image Library will be
more helpful.

-Nando
From: Shotgun Thom on 2 Aug 2010 17:11
Hi Nando...

An even easier solution is to add the code included in this post to
your project in a Module:

It allows you to save your Picture Box as a 24bit PNG, JPG or BMP.

Once you have the picture displayed in your picture box you just call
the Sub as follows:

SaveImageAs "c:\mypicture.png", Picture1.hdc, Picture1.Width /
Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY,
CLng(100)

Open a new module in your project. Copy the following code and paste
into the module. Use the syntax above to call saving the image,
replacing, obviously, the file name with your own and with whatever
you named your Picture Box.

Option Explicit
'///////////////////////////////////////////////////
'// SaveImageAs - Save hDC to Bitmap or Jpeg file //
'// Ed Wilk/Edgemeal - last updated Feb.06,2010 //
'///////////////////////////////////////////////////

Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0

Private Type BitmapFileHeader
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Private Type BitmapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biDataSize As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Private Type BITMAPINFO
bmiHeader As BitmapInfoHeader
bmiColors As RGBQUAD
End Type

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As
Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As
Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long,
ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As
Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As
Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long,
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As
Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage 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

' gdi+
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




Public Sub SaveImageAs(ByVal sFileName As String, ByVal Source_hDC As
Long, ByVal Width As Long, ByVal Height As Long, Optional ByVal
Quality As Long = 80)
Dim sFileExt As String
Dim myDIB As Long, myDC As Long, fNum As Long
Dim bi24BitInfo As BITMAPINFO
Dim fileheader As BitmapFileHeader
Dim bitmapData() As Byte
' gdi
Dim tSI As GdiplusStartupInput
Dim lRes As Long, lGDIP As Long, lBitmap As Long
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters

' source hDC to DIB
With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = Width
.biHeight = Height
.biDataSize = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
ReDim bitmapData(0 To .biDataSize - 1)
End With
myDC = CreateCompatibleDC(0)
myDIB = CreateDIBSection(myDC, bi24BitInfo, DIB_RGB_COLORS, ByVal
0&, ByVal 0&, ByVal 0&)
SelectObject myDC, myDIB
BitBlt myDC, 0, 0, bi24BitInfo.bmiHeader.biWidth,
bi24BitInfo.bmiHeader.biHeight, Source_hDC, 0, 0, vbSrcCopy
Call GetDIBits(myDC, myDIB, 0, bi24BitInfo.bmiHeader.biHeight,
bitmapData(0), bi24BitInfo, DIB_RGB_COLORS)

' get file extension of filename to save as lower case.
sFileExt = LCase$(GetFileExt(sFileName))
' Save image to file....
Select Case sFileExt
Case ".bmp" ' save as bmp....
With fileheader
.bfType = &H4D42
.bfOffBits = Len(fileheader) +
Len(bi24BitInfo.bmiHeader)
.bfSize = bi24BitInfo.bmiHeader.biDataSize
+ .bfOffBits
End With
fNum = FreeFile
On Error GoTo BadFileName
Open sFileName For Output As fNum
Close fNum
Open sFileName For Binary As fNum
Put fNum, , fileheader
Put fNum, , bi24BitInfo.bmiHeader
Put fNum, , bitmapData()
Close fNum
Case ".jpg", ".png"
tSI.GdiplusVersion = 1 ' Initialize GDI+
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
lRes = GdipCreateBitmapFromHBITMAP(myDIB, 0, lBitmap)
' Create the GDI+ bitmap from the image handle
If lRes = 0 Then
If sFileExt = ".jpg" Then ' JPG
CLSIDFromString
StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
' Initialize the encoder parameters
tParams.Count = 1
With tParams.Parameter ' jpeg Quality
CLSIDFromString StrPtr("{1D5BE4B5-
FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.Type = 4
.Value = VarPtr(Quality)
End With
ElseIf sFileExt = ".png" Then ' PNG
CLSIDFromString
StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
End If
' Save the image
lRes = GdipSaveImageToFile(lBitmap,
StrPtr(sFileName), tJpgEncoder, tParams)
' Destroy the bitmap
GdipDisposeImage lBitmap
End If
' Shutdown GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Can not save image(GDI+ Error).:" &
lRes
End If
End Select
Fini:
DeleteObject myDIB
DeleteDC myDC
Exit Sub

BadFileName:
Close fNum
Err.Raise 5, , "Can not save BMP image.:" & lRes
Resume Fini
End Sub
Private Function GetFileExt(sFile As String) As String
' example" returns ".exe"
Dim I As Integer
I = InStrRev(sFile, ".")
If I Then
GetFileExt = Mid$(sFile, I)
Else
GetFileExt = sFile ' if not found then just return the whole
string
End If
End Function



Thanks to Ed Wilk for this code I downloaded from somewhere but can't
remember.

Tom
From: Nando on 12 Aug 2010 23:39
Shotgun Thom wrote:
> Hi Nando...
>
> An even easier solution is to add the code included in this post to
> your project in a Module:
>
> It allows you to save your Picture Box as a 24bit PNG, JPG or BMP.
>
> Once you have the picture displayed in your picture box you just call
> the Sub as follows:
>
> SaveImageAs "c:\mypicture.png", Picture1.hdc, Picture1.Width /
> Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY,
> CLng(100)
>
> Open a new module in your project. Copy the following code and paste
> into the module. Use the syntax above to call saving the image,
> replacing, obviously, the file name with your own and with whatever
> you named your Picture Box.
>
><Snipped>
>
> Thanks to Ed Wilk for this code I downloaded from somewhere but can't
> remember.
>
> Tom

Thanks a billion Tom!!! I'm now able to create 24-bit PNG files!!!

I'm multitasking a lot of stuff on my side, but one thing I'm still
experiment (just for curiosity) is why (for a specific BMP image sample)
I get different file sizes of 18KB and 23KB.

The sample image: A snapshot of the calculator of Windows XP as a BMP
file (446KB).

The PNG version of the file is 23KB (using the API code). I also get the
same result if I save the file manually as a PNG from MS Paint.

However, I get a smaller PNG version of 18KB saving the sample file as
PNG using Microsoft Photo Editor 3 (which shipped with Office XP or
2003). This was a smaller size without any loss in quality since I
checked by re-saving the PNG as a BMP and comparing with the sample, and
they matched bit by bit (SourceForge's WinMerge).

Just wondering how Photo Editor was able to produce a file 78% smaller
under the same PNG format. The quality specified using the API was set
to 100, so I'm quite intrigued.

-Nando
First  |  Prev  |  Next  |  Last
Pages: 1 2 3
Prev: Are PDB files used by VB6
Next: Get Selected Path From Explorer