Link to home
Start Free TrialLog in
Avatar of pl_harish
pl_harish

asked on

save an image in jpg format in a VB app.

i have an image either in the clipboard or in a bmp format..

whichever image the user selects(either from clipboard or the bmp provided), needs to converted to jpg format and saved in a local dir.
Avatar of AzraSound
AzraSound
Flag of United States of America image

please update/close your other open questions and practice maintaining a better grading history.  thank you.
Avatar of Éric Moreau
Avatar of iboutchkine
iboutchkine

Convert BMP to JPG with this easy to use code. (Note: Requires vic32.dll available from
http://www.catenary.com/)

'PLACE ALL THIS IN A NEW MODULE

Declare Function bmpinfo Lib "VIC32.DLL" (ByVal Fname As String, bdat As BITMAPINFOHEADER) As Long
Declare Function allocimage Lib "VIC32.DLL" (image As imgdes, ByVal wid As Long, ByVal leng As Long, ByVal BPPixel As Long) As Long
Declare Function loadbmp Lib "VIC32.DLL" (ByVal Fname As String, desimg As imgdes) As Long
Declare Sub freeimage Lib "VIC32.DLL" (image As imgdes)
Declare Function convert1bitto8bit Lib "VIC32.DLL" (srcimg As imgdes, desimg As imgdes) As Long
Declare Sub copyimgdes Lib "VIC32.DLL" (srcimg As imgdes, desimg As imgdes)
Declare Function savejpg Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal quality As Long) As Long



' Image descriptor
Type imgdes
   ibuff As Long
   stx As Long
   sty As Long
   endx As Long
   endy As Long
   buffwidth As Long
   palette As Long
   colors As Long
   imgtype As Long
   bmh As Long
   hBitmap As Long
End Type

Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

'PLACE THIS IN YOUR FORM DECLERATIONS

Private Sub ConvertToJPEG(bmp_fname As String, jpg_fname As String, Optional quality As Long)
   Dim tmpimage As imgdes    ' Image descriptors
   Dim tmp2image As imgdes
   Dim rcode As Long
   'Dim quality As Long
   Dim vbitcount As Long
   Dim bdat As BITMAPINFOHEADER ' Reserve space for BMP struct
   'Dim bmp_fname As String
   'Dim jpg_fname As String

   'bmp_fname = "test.bmp"
   'jpg_fname = "test.jpg"

   If quality = 0 Then quality = 75
   
   ' Get info on the file we're to load
   rcode = bmpinfo(bmp_fname, bdat)
   If (rcode <> NO_ERROR) Then
      msgbox "error: Unable to get file info"
      Exit Sub
   End If
   
   vbitcount = bdat.biBitCount
   If (vbitcount >= 16) Then  ' 16-, 24-, or 32-bit image is loaded into 24-bit buffer
      vbitcount = 24
   End If
   
   ' Allocate space for an image
   rcode = allocimage(tmpimage, bdat.biWidth, bdat.biHeight, vbitcount)
   If (rcode <> NO_ERROR) Then
     msgbox "error: Not enough memory"
     Exit Sub
   End If
   
   ' Load image
   rcode = loadbmp(bmp_fname, tmpimage)
   If (rcode <> NO_ERROR) Then
      freeimage tmpimage ' Free image on error
      msgbox "error: Cannot load file"
      Exit Sub
   End If

   If (vbitcount = 1) Then ' If we loaded a 1-bit image, convert to 8-bit grayscale
       ' because jpeg only supports 8-bit grayscale or 24-bit color images
     rcode = allocimage(tmp2image, bdat.biWidth, bdat.biHeight, 8)
     If (rcode = NO_ERROR) Then
         rcode = convert1bitto8bit(tmpimage, tmp2image)
         freeimage tmpimage  ' Replace 1-bit image with grayscale image
         copyimgdes tmp2image, tmpimage
     End If
   End If

   ' Save image
   rcode = savejpg(jpg_fname, tmpimage, quality)
   freeimage tmpimage
   Kill bmp_fname
   msgbox "picture saved: " & jpg_fname
     
End Sub
ASKER CERTIFIED SOLUTION
Avatar of dreamvb
dreamvb

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Hi pl_harish,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days.  I will suggest to:

    Accept iboutchkine's comment(s) as an answer.

pl_harish, if you think your question was not answered at all or if you need help, you can simply post a new comment here.  Community Support moderators will followup.

EXPERTS: Please post closing recommendations.
==========
DanRollins -- EE database cleanup volunteer
emoreau, iboutchkine and dreamvb all gives correct comments. The points should be splitted.
Recommended disposition:

 split points between emoreau and iboutchkine and dreamvb

DanRollins -- EE database cleanup volunteer
Per recommendation, force-accepted.

Netminder
CS Moderator

emoreau: points for you at https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=20317595
iboutchkine: points for you at https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=20317594