哈哈,再来一个BMP 转 JPG 的模块,该有的都了。

应朋友需要,把远程屏幕监控需要的核心代码发布 出来,这是最后一个,发送算法自己写咯

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, Optional ByVal outputbuf As Long = 0) 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

'  ----====  SaveJPG  ====----

Public Sub SaveJPG(ByVal pict As StdPicture, ByVal FileName As String, Optional ByVal quality As Byte = 80)
    Dim tSI   As GdiplusStartupInput
    Dim lRes   As Long
    Dim lGDIP   As Long
    Dim lBitmap   As Long
    '  Initialize  GDI+
    tSI.GdiplusVersion = 1
    lRes = GdiplusStartup(lGDIP, tSI)
    If lRes = 0 Then
        '  Create  the  GDI+  bitmap
        '  from  the  image  handle
        lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
        If lRes = 0 Then
            Dim tJpgEncoder   As GUID
            Dim tParams   As EncoderParameters
            '  Initialize  the  encoder  GUID
            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
            '  Initialize  the  encoder  parameters
            tParams.Count = 1
            With tParams.Parameter   '  Quality
                '  Set  the  Quality  GUID
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .GUID
                .NumberOfvalues = 1
                .type = 1
                .value = VarPtr(quality)
            End With
            '  Save  the  image
            lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, tParams)
            '  Destroy  the  bitmap
            GdipDisposeImage lBitmap
        End If
        '  Shutdown  GDI+
        GdiplusShutdown lGDIP
    End If
    If lRes Then
      'Err.Raise 5, , "Cannot  save  the  image.  GDI+  Error:" & lRes
      GdiplusShutdown lGDIP
      lRes = GdiplusStartup(lGDIP, tSI)

  End If
End Sub

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值