Solved

in VB6 I need to save Picture1.picture as a PNG using modFreeImage.bas without saving to BMP first.

Posted on 2004-10-18
9
3,163 Views
Last Modified: 2008-01-09

I need to save a screencapture as a PNG file.   I am able to take the capture using modScreenCapture.bas, save the screen as a BMP, then convert it to PNG using modFreeImage.bas and FreeImage.dll, but I'd like to save the PNG directly without first saving to a BMP file.

This works but is clunky:


     Set Picture1.Picture = CaptureScreen()

     ScreenFileName = "screencap_" & format(Date, "yyyymmdd") & "_" & format(Time, "hhmmss")
   
     SavePicture Picture1.Picture, "C:tmp\" & ScreenFileName & ".bmp"
     
     Dim dib As Long
     Dim bOK As Long
 
     ' Load a bmp image
     dib = FreeImage_Load(FIF_BMP, "C:\tmp\" & ScreenFileName & ".bmp", 0)
 
 
     ' Save this image as PNG
     bOK = FreeImage_Save(FIF_PNG, dib, "C:\tmp\" & ScreenFileName & ".png", 0)
 
     ' Unload the dib
     FreeImage_Unload (dib)
 
but what I'd like to do is something more like:

     ' Load a bmp image  - this produces png files size 0   :-(
     dib = FreeImage_Load(FIF_BMP, Picture1.Picture, 0)
 
     ' Save this image as PNG
     bOK = FreeImage_Save(FIF_PNG, dib, "C:\tmp\" & ScreenFileName & ".png", 0)
 

Can someone provide the proper way to reference Picture1.Picture and save it directly to PNG using FreeImage.dll  ?

Thanks,

Mike

0
Comment
Question by:mikesimon345
  • 4
  • 3
  • 2
9 Comments
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12338787
Not familiar with FreeImage.dll.

Does that dll support that method? if not, then you cannot do it.

One thing I want to point out is not evevy computer nas c:\tmp\ directory

Just use

environ("TEMP") & "\"

instead of

"C:\tmp\"
0
 

Author Comment

by:mikesimon345
ID: 12338858

As I mentioned,  the http://freeimage.sourceforge.net/  DLL can save PNGs, this works (I do have a tmp dir but thank you for the suggestion):

SavePicture Picture1.Picture, "C:tmp\" & ScreenFileName & ".bmp"
Dim dib As Long
Dim bOK As Long
' Load a bmp image
dib = FreeImage_Load(FIF_BMP, "C:\tmp\" & ScreenFileName & ".bmp", 0)
' Save this image as PNG
bOK = FreeImage_Save(FIF_PNG, dib, "C:\tmp\" & ScreenFileName & ".png", 0)

The two Load functions I see in modFreeImage.bas are:

Public Declare Function FreeImage_Load Lib "FreeImage.dll" Alias "_FreeImage_Load@12" (ByVal fif As FREE_IMAGE_FORMAT, ByVal filename As String, Optional ByVal flags As Long = 0) As Long

and

Public Declare Function FreeImage_LoadFromHandle Lib "FreeImage.dll" Alias "_FreeImage_LoadFromHandle@16" (ByVal fif As FREE_IMAGE_FORMAT, ByVal io As Long, ByVal handle As Long, Optional ByVal flags As Long = 0) As Long

but how I use one of these to reference the Picture1.Picture directly to save it as a PNG is what I am looking for.

0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12338930
Have you tried to use image?


dib = FreeImage_Load(FIF_BMP, Picture1.Image, 0)
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12339002
Or use this


Get Picture2Array from here
http://www.sql.ru/forum/actualthread.aspx?bid=1&tid=29463

Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
(Var() as Any) As Long

dim d() as byte
Call Picture2Array(Picture1.Picture, d())
dib = FreeImage_Load(FIF_BMP, VarPtrArray(d), 0)
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:mikesimon345
ID: 12339010

I tried  

     dib = FreeImage_Load(FIF_BMP, Picture1.Image, 0)

per your suggestion but it produces a 0 size png just like

     dib = FreeImage_Load(FIF_BMP, Picture1.Picture, 0)
 

My VB6 keeps changing the Image to image but doubt that is the problem:

     dib = FreeImage_Load(FIF_BMP, Picture1.image, 0)


Good suggestion worth trying but still looking for a solution....


0
 

Author Comment

by:mikesimon345
ID: 12339034

 EDDYKT - Picture2Array looks promising - I will be able to test after lunch today (EST).



0
 
LVL 32

Expert Comment

by:Erick37
ID: 12339621
Hi mikesimon345

Looking at the documentation for FreeImage, it does not look like they have a function to create a dib directly from memory.  The LoadFromHandle function expects pointers to user specified functions to read and write to streams or other files.

If you are not locked into using FreeImage, you may consider using GDI+ to save your bitmap as a PNG.  You can call the flat GDI+ API's directly from VB.  Here is an example of how to do this:

' Using GDI+ to save a VB Picture to a PNG file
' Requires GDIPlus API.bas for the GDI+ declarations
' This file along with comprehensive examples can be found here:
' http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=37541&lngWId=1
'
' Requires gdiplus.dll to be installed on target system.
'


Option Explicit

Dim token As Long ' Needed to close GDI+

Private Sub Command1_Click()
   
    Dim img As Long, encoderCLSID As CLSID
    Dim stat As GpStatus
   
    ' Initializations
    ' Create an GDI+ img from the picture.handle
    stat = GdipCreateBitmapFromHBITMAP(Picture1.Picture.Handle, Picture1.Picture.hpal, img)
   
    ' Get the CLSID of the PNG encoder
    stat = GetEncoderClsid("image/png", encoderCLSID)
   
    ' Save as a PNG file. There are no encoder parameters for PNG images, so we pass a NULL.
    ' NOTE: The NULL (aka 0) must be passed byval, as the function declaration would get a pointer to the number 0.
    stat = GdipSaveImageToFile(img, StrConv("c:\test123.png", vbUnicode), encoderCLSID, ByVal 0)
   
    ' See if it was created
    If stat = Ok Then
       MsgBox "PNG Saved", vbInformation
    Else
       MsgBox "Error saving file! Status Code: " & stat, vbCritical
    End If
   
    ' Cleanup
    Call GdipDisposeImage(img)
   

End Sub

Private Sub Form_Load()
    '**Important**
    ' Load the GDI+ Dll
    Dim GpInput As GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(token, GpInput) <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Unload Me
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    ' Clean up
    ' Unload the GDI+ Dll
    Call GdiplusShutdown(token)
   
End Sub
0
 
LVL 32

Accepted Solution

by:
Erick37 earned 200 total points
ID: 12340955
I stand corrected...

There is a way to do this via FreeImage.  Here is the sample code modified to save the picture in Picture1 to a PNG file:

Option Explicit

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 Any, ByVal wUsage As Long) As Long

Private Sub btnTest_Click()
   
    Dim dib As Long
    Dim bOK As Long
   
    Dim ret As Long, h As Long, w As Long
   
    'Get picture dimensions in pixels
    h = ScaleY(Picture1.Picture.Height, vbHimetric, vbPixels)
    w = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
   
    'Allocate memory for the image
    'Must hardcode 24 bits/pixel for this to work
    dib = FreeImage_Allocate(w, h, 24)
   
    'Copy the bitmap bits to dib
    ret = GetDIBits(Picture1.hdc, Picture1.Picture.handle, 0, FreeImage_GetHeight(dib), ByVal FreeImage_GetBits(dib), ByVal FreeImage_GetInfo(dib), 0)
   
    ' Save this image as PNG
    bOK = FreeImage_Save(FIF_PNG, dib, "c:\test.png", 0)
   
    ' Unload the dib
    FreeImage_Unload dib

End Sub
0
 

Author Comment

by:mikesimon345
ID: 12341512

Erick37 - your solution worked!   The png files are created and they are perfect!

0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now