Question

vb图片转换问题

比如C盘下有个叫0.bmp的图片大小大概2.5M。我想按一个按钮就就能将0.bmp这个图片变小然后覆盖保存。可以转换格式，也可以不转换。只要图片变小就可以了。就算变成黑白也可以。请问VB怎麽写。最好是有源码。回答好的我另外加分，谢谢。

Answer 1

oaita - 江湖新秀 五级 呵呵~你干脆直接删除图片得了
~添加一个按钮 一个picture控件
Option Explicit
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, ByVal outputbuf As Long) 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
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As Long

Private Sub Command1_Click()
Dim ret As Boolean

Picture1.Picture = LoadPicture("z:\1.bmp") '打开要压缩的图片

ret = PictureBoxSaveJPG(Picture1, "z:\2.jpg") '保存压缩后的图片
If ret = False Then
MsgBox "保存失败"
End If
End Sub

Private Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As Boolean
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long

'初始化 GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI, 0)

If lRes = 0 Then
'从句柄创建 GDI+ 图像
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters

'初始化解码器的GUID标识
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

'设置解码器参数
tParams.Count = 1
With tParams.Parameter ' Quality
'得到Quality参数的GUID标识
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.type = 4
.Value = VarPtr(quality)
End With

'保存图像
lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)

'销毁GDI+图像
GdipDisposeImage lBitmap
End If

'销毁 GDI+
GdiplusShutdown lGDIP
End If

If lRes Then
PictureBoxSaveJPG = False
Else
PictureBoxSaveJPG = True
End If
End Function

Answer 2

‘两行语句搞定
'将图片以图片框大小画到图片框上
Picture1.PaintPicture LoadPicture("c:\0.bmp"), 0, 0, Picture1.Width, Picture1.Height
'Picture1.AutoSize = True
'保存图片框里的图片，图片框越小，图片越小
SavePicture Picture1.Image, "c:\0.bmp"

Answer 3

看看这段代码你就明白了。
图片格式转换 BMP转JPG
转换为JPG格式后图片自然变小了

代码如下:
模块:
Option Explicit

' 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

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

窗体中:

Private Sub Command1_Click()
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"

quality = 75
' Get info on the file we're to load
rcode = bmpinfo(bmp_fname, bdat)
If (rcode <> NO_ERROR) Then
MsgBox "Cannot find file", 0, "Error encountered!"
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 "Not enough memory", 0, "Error encountered!"
Exit Sub
End If

Load image
rcode = loadbmp(bmp_fname, tmpimage)
If (rcode <> NO_ERROR) Then
freeimage tmpimage ' Free image on error
MsgBox "Cannot load file", 0, "Error encountered!"
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
End Sub

Answer 4

转成jpg格式

Answer 5

bu