| Pregunta: | 32935 - GUARDAR ARCHIVOS EN FORMATO .JPG O .GIF |
| Autor: | Francisco López |
| Tengo una imagen cargada en un control Image pero quiesera guardarla en el disco en un formato .JPG o .GIF de tal forma que no consuma mucho espacio, puesto que existe una función SavePicture() que guarda los archivos pero en formato .BMP y quiesiera que desde mi aplicación se guarde en un formato pequeño... Gracias. | |
| Respuesta: | Francisco López |
| Con el siguiente código se soluciona el problema: En un formulario: Private Sub Commad1_Click() ConvertToJPEG Archivo.BMP, Archivo.JPG End Sub En un Módulo: 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 Public 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 vbitcount As Long Dim NO_ERROR Dim bdat As BITMAPINFOHEADER ' Reserve space for BMP struct NO_ERROR = 0 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: en el archivo de Origen" Exit Sub End If vbitcount = bdat.biBitCount If (vbitcount >= 16) Then vbitcount = 24 ' 16-, 24-, or 32-bit image is loaded into 24-bit buffer ' Allocate space for an image rcode = allocimage(tmpimage, bdat.biWidth, bdat.biHeight, vbitcount) If (rcode <> NO_ERROR) Then MsgBox "Error: Memoria insuficiente" Exit Sub End If ' Load image rcode = loadbmp(bmp_fname, tmpimage) If (rcode <> NO_ERROR) Then freeimage tmpimage ' Free image on error MsgBox "Error: No se pudo cargar el archivo" 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 ' Guardar la imagen en Formato JPG rcode = savejpg(jpg_fname, tmpimage, quality) freeimage tmpimage Kill bmp_fname End Sub | |
| Respuesta: | Juan Véliz |
| La verdad con VB no lo puedes hacer, ademas JPG y GIF son formatos propietarios y si hicieras una aplicacion tendrias que pagar por hacerlo.. Lo mejor que puedes hacer es comprar o bajar algun componente gratuito que te permita hacerlo, dejame decirte que si lo compras no es nada barato. Si no tienes dinero lo mejor es dejarlo como BMP Si tienes aqui hay una direccion www.leadtools.com O sino busca por "Imaging Components" Bueno mi respuesta no soluciona tu problema Saludos | |