为了账号安全,请及时绑定邮箱和手机立即绑定

求问这个dll是咋用的啊???

求问这个dll是咋用的啊???

米琪卡哇伊 2023-04-20 19:15:20
vb我截屏的图大了,每一个都3m多,有没有啥函数可以转化一下截屏文件的格式,将图片变的小一点啊。几十k这样的。还有就是咋办把图片制作成gif的动态文件,vb是不是用一个wsAniGIF的dll
查看完整描述

2 回答

?
吃鸡游戏

TA贡献1829条经验 获得超7个赞

SavePicture 语句

从对象或控件(如果有一个与其相关)的 Picture 或 Image 属性中将图形保存到文件中。

SavePicture 语句示例

本例使用 SavePicture 语句保存画在 Form 对象的 Picture 
属性中的图形。要试用此例,可将以下代码粘贴到 Form 对象的声明部分,然后运行此例,单击 Form 对象。


Private Sub Form_Click ()   ' 声明变量。   Dim CX, CY, Limit, Radius   as Integer, Msg as String   ScaleMode = vbPixels   ' 设置比例模型为像素。   AutoRedraw = True ' 打开 AutoRedraw。   Width = Height   ' 改变宽度以便和高度匹配。   CX = ScaleWidth / 2   ' 设置 X 位置。   CY = ScaleHeight / 2   ' 设置 Y 位置。   Limit = CX   ' 圆的尺寸限制。   For Radius = 0 To Limit   ' 设置半径。      Circle (CX, CY), Radius, RGB(Rnd * 255, Rnd * 255, Rnd * 255)      DoEvents   ' 转移到其它操作。   Next Radius   Msg = "Choose OK to save the graphics from this form "   Msg = Msg & "to a bitmap file."   MsgBox Msg   SavePicture Image, "TEST.BMP"   ' 将图片保存到文件。End Sub

 


查看完整回答
反对 回复 2023-04-23
?
猛跑小猪

TA贡献1858条经验 获得超8个赞

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
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 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 Sub Form_click()
Me.Hide
Me.AutoRedraw = True
Picture1.Width = Screen.Width + 30
Picture1.Height = Screen.Height + 30
BitBlt Picture1.hDC, 0, 0, Screen.Width + 30, Screen.Height + 30, GetDC(0), 0, 0, vbSrcCopy
Set Picture1.Picture = Picture1.Image
Call PictureBoxSaveJPG(Picture1.Picture, Replace(App.Path & "\" & "test.JPG", "\\", "\")) '保存压缩后的图片
End
End Sub

Private Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 70) As Boolean

'直接修改quality参数 即可缩小图片保存大小
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


查看完整回答
反对 回复 2023-04-23
  • 2 回答
  • 0 关注
  • 115 浏览
慕课专栏
更多

添加回答

举报

0/150
提交
取消
意见反馈 帮助中心 APP下载
官方微信