【VB技巧】VB 屏幕截取以及图片压缩模块

  • A+
所属分类:lcx

    VB 屏幕截取以及图片压缩模块,VB 截取屏幕并压缩,VB图片压缩,VB截取屏幕压缩,VB截取当前屏幕并保存为24位Bmp图片,VB截取屏幕并保存为24位Bmp图片,VB截取屏幕保存为24位Bmp图片,VB截取屏幕保存为Bmp图片,VB截取屏幕保存为图片,VB截取屏幕存为24位Bmp图片,VB截取屏幕存为Bmp图片,VB截取屏幕并存为图片,VB截取当前屏幕,VB截取屏幕保存为24位Bmp图片,VB截取屏幕,VB截取屏幕存为24位Bmp,VB GetDC,GetDC,VB BitBlt,BitBlt。

VB 屏幕截取以及图片压缩模块:

Option Explicit
'屏幕截取以及图片压缩模块
'调用方法:If GetScrData("c:a.jpg") = True Then MsgBox "截取并压缩成功!"
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 GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal OutFile 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 OutFile As Long, Bitmap As Long) As Long 'BmpFileToJpg 用到  '图片转换压缩处理
'屏幕截取
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long         '获取句柄
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 '获取图片数据

Public Function GetScrData(P As String) As Boolean                              '获取屏幕数据并保存为图片
    On Error GoTo Over
    Form1.BorderStyle = 2                                                       '窗体风格,否则截取不全
    Form1.AutoRedraw = True                                                     '开启自动重绘
    BitBlt Form1.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy '截取图片
    SavePicture Form1.Image, P & ".B"                                           '保存为图片,覆盖模式
    If BmpFileToJpg(P & ".B", P, 100) = True Then GetScrData = True             'Bmp文件路径,Jpg文件路径,图片质量:100(默认:80)'获取成功
    If Dir(P & ".B", vbHidden + vbReadOnly + vbSystem) "" Then Kill P & ".B" '删除临时文件
    Exit Function                                                               '结束过程
Over:
    GetScrData = False                                                          '获取失败
End Function

Public Function BmpFileToJpg(ByVal BmpFile As String, ByVal OutFile As String, Optional ByVal Quality As Byte = 80) As Boolean 'Bmp文件转换为Jpg文件:Bmp文件路径,Jpg文件路径,图片质量(默认:80)
    On Error GoTo Over
    Dim TSI As GdiplusStartupInput, LRes As Long, lGDIP As Long, lBitmap As Long
    TSI.GdiplusVersion = 1                                                      '初始化 GDI+
    LRes = GdiplusStartup(lGDIP, TSI, 0)
    If LRes = 0 Then
        LRes = GdipCreateBitmapFromFile(StrPtr(BmpFile), lBitmap)               '从句柄创建 GDI+ 图像
        If LRes = 0 Then
            Dim tJpgEncoder As GUID, tParams As EncoderParameters
            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder '初始化解码器的GUID标识
            tParams.Count = 1                                                   '设置解码器参数
            With tParams.Parameter                                              '图片质量
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID '得到Quality参数的GUID标识
                .NumberOfValues = 1
                .type = 4
                .Value = VarPtr(Quality)
            End With
            LRes = GdipSaveImageToFile(lBitmap, StrPtr(OutFile), tJpgEncoder, tParams) '保存图像
            GdipDisposeImage lBitmap                                            '销毁GDI+图像
        End If
        GdiplusShutdown lGDIP                                                   '销毁 GDI+
    End If
    If LRes Then BmpFileToJpg = False Else BmpFileToJpg = True                  '判断执行成功还是失败
    Exit Function                                                               '退出过程
Over:
    BmpFileToJpg = False                                                        '执行失败
End Function

文章来源于lcx.cc:【VB技巧】VB 屏幕截取以及图片压缩模块

相关推荐: 【PHP】PHP 将字符串进行 Html 编码,转义字符

    PHP 将字符串进行 Html 编码,转义字符,PHP 字符串进行 Html 编码,PHP 将字符进行 Html 编码,PHP 将字符串 Html 编码,PHP 字符进行 Html 编码,PHP 字符串 Html 编码,PHP 字符 Html 编码,P…

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: