Option Explicit
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, ByVal outputbuf As Long) 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 GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As Long, Bitmap As Long) As Long
Public 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 = https://www.04ip.com/post/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
d.使用以下代码实现将加好文字水印图片保存为jpg格式图片 。
Private Sub Command3_Click() '保存为.jpg图片
' 设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "JPEG Files""(*.jpg)|*.jpg"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
' 显示“打开”对话框
CommonDialog1.ShowSave
' 显示选定文件的名字
'MsgBox CommonDialog1.fileName
Set Picture2.Picture = Picture1.Image '转移Picture1所绘图为Picture2.Picture赋值
Dim ret As Boolean
ret = PictureBoxSaveJPG(Picture2, CommonDialog1.fileName) '保存压缩后的图片
If ret = False Then
MsgBox "保存失败"
End If
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub
vb.net中,如何像下图一样 , 用很简单的办法 , 导入1000张图片 。很简单的方法,貌似没有 。这个需要自己写很多代码:
用一个ListView控件 。
判断滚动条当前所显示的图片集合,获取它们的物理路径 。
推荐阅读
- ChatGPT概念股全线下挫,chpt股票
- oracle给数据文件改名,oracle 数据文件改名
- 包含postgresql修改数据目录的词条
- 恋爱养成游戏关于合租的,合租恋爱小游戏
- vb.net去掉空行 用vba如何去掉单元格空格
- 苹果转ios下载,转到ios下载
- 显卡驱动怎么安装鸿蒙,显卡驱动程序安装方法
- 用go语言注册登录网页 go语言可以开发网站吗
- 怎么检测显卡cmos,怎么检测显卡是不是全新的