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,229 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
Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

 
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
 

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

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

832 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