导航:首页 > 文件处理 > vb压缩jpg

vb压缩jpg

发布时间:2022-07-10 07:16:46

Ⅰ 如何用VB把JPG格式的"大图片"压缩成视频,谢谢!

Private Sub Command1_Click() '搜索
Dim strtemp As String '定义变量为字符串型,
Dim a As String '定义变量为字符串型
Dim i As Integer '定义变量为整值
strtemp = Trim(Text1.Text) ' 初始变量Strtemp 等于文本框中的内容 ,也就是要搜索的内容
For i = 0 To List1.ListCount - 1 '循环 列表框里的内容
a = List1.List(i) '把每项内容赋值给变量A
If InStr(a, strtemp) > 0 Then '判断,当在列表项中找到搜索的关键字,那么
List1.Selected(i) = True '该项被选中

Ⅱ 请问怎么vb压缩图片,内详

'图片压缩处理程序,可以实现高压缩!
'注JPG压缩比值为1-255
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type
Public Type EncoderParameters
count As Long
Parameter As EncoderParameter
End Type

Public Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long
Public Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long

'*************************************************************************
'** 作 者 : laviewpbt
'** 函 数 名 : SavePic
'** 输 入 : pic(StdPicture) - 图象句柄
'** : FileName(String) - 保存路径
'** : Quality(Byte) - JPG图象质量
'** : TIFF_ColorDepth(Long) - TTF格式的颜色深度
'** : TIFF_Compression(Long) - TTF格式的压缩比
'** 输 出 : 无
'** 功能描述 : 把图象保存为JPG、TIFF、PNG、GIF、BMP格式
'** 日 期 :
'** 修 改 人 : laviewpbt
'** 日 期 : 2005-10-23 14.43.52
'** 版 本 : Version 1.2.1
'*************************************************************************
Public Sub SavePic(ByVal pict As StdPicture, ByVal FileName As String, PicType As String, _
Optional ByVal Quality As Byte = 80, _
Optional ByVal TIFF_ColorDepth As Long = 24, _
Optional ByVal TIFF_Compression As Long = 6)
Screen.MousePointer = vbHourglass
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim aEncParams() As Byte
On Error GoTo ErrHandle:
tSI.GdiplusVersion = 1 ' 初始化 GDI+
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then ' 从句柄创建 GDI+ 图像
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters '初始化解码器的GUID标识
Select Case PicType
Case ".jpg"
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 1 ' 设置解码器参数
With tParams.Parameter ' Quality
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识
.NumberOfValues = 1
.type = 4
.Value = VarPtr(Quality)
End With
ReDim aEncParams(1 To Len(tParams))
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
Case ".png"
CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".gif"
CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".tiff"
CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 2
ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识
.Value = VarPtr(TIFF_Compression)
End With
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识
.Value = VarPtr(TIFF_ColorDepth)
End With
Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter))
Case ".bmp" '可以提前写保存为BMP的代码,因为并没有用GDI+
SavePicture pict, FileName
Screen.MousePointer = vbDefault
Exit Sub
End Select
lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像
GdipDisposeImage lBitmap ' 销毁GDI+图像
End If
GdiplusShutdown lGDIP '销毁 GDI+
End If
Screen.MousePointer = vbDefault
Erase aEncParams
Exit Sub
ErrHandle:
Screen.MousePointer = vbDefault
MsgBox "在保存图片的过程中发生错误:" & vbCrLf & vbCrLf & "错误号: " & Err.Number & vbCrLf & "错误描述: " & Err.Description, vbInformation Or vbOKOnly, "错误"
End Sub

把以上的代码复制到模块

Ⅲ vb 对图片进行压缩

用photoshop打开图片,另存为JPG格式就会小很多啦,JPG是一种有损压缩格式...

Ⅳ VB压缩图片的问题!

不管原格式是什么,vb 读取、截图后,保存的图片都是 bmp 格式。
可以这样转变为 JPG 格式:用 windows 自带的画图程序打开文件,然后单击文件菜单的“另存为”,保存类型选 JPEG ,最后单击保存就可以了。

Ⅳ vb.net如何将JPG文件缩放至不大于指定的字节数

1.我有个思路可以尝试一下:把一张字节数在280-300K的图片用PS打开看看像素大小;
2.定义一个新的位图,指定像素大小为上面得到的数据;
3.读取你需要修改大小的JPG文件,然后按指定大小复制到上面新建的位图,并保存为JPG格式

阅读全文

与vb压缩jpg相关的资料

热点内容
keil分段编译 浏览:26
app有了用户后怎么赚钱 浏览:306
程序员那么可爱20观看 浏览:999
一个数除以二的算法 浏览:403
如何选择php培训机构 浏览:982
app被移除管理了怎么弄 浏览:934
phpredis消息推送 浏览:804
剪贴板里怎么加密码 浏览:153
51单片机入门自学 浏览:548
如何看步数有同步服务器 浏览:10
单片机扫描实验代码 浏览:721
惠州抖音app推广平台怎么引流 浏览:758
如何再网络设置里面添加服务器 浏览:191
陶瓷pdf 浏览:672
选股指标源码最新 浏览:577
arm嵌入式linuxpdf 浏览:477
本田裂行的压缩比 浏览:24
ps色彩调色命令 浏览:592
宽带的服务器地址怎么看 浏览:423
vb如何给文件加密 浏览:215