VB Bmp图片转换Jpg压缩处理模块:

 

VB Bmp图片转换压缩处理模块:
Option Explicit
                                                                 '图片转换压缩处理模块
'PictureBoxSaveJPG:
'1. = LoadPicture("C:\test.bmp") '载入图片
'If PictureBoxSaveJPG(1, "c:\test.", 100) = True Then MsgBox "操作成功!" 'PictureBox,文件路径,图片质量:100(默认:80)
'BmpFileToJpg:
'If BmpFileToJpg("C:\test.bmp", "C:\test.", 100) = True Then MsgBox "操作成功!" 'Bmp文件路径,文件路径,图片质量:100(默认:80)
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 用到
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long 'PictureBoxSaveJPG 用到
Public Function PictureBoxSaveJPG(ByVal Pict As StdPicture, ByVal OutFile As String, Optional ByVal Quality As Byte = 80) As Boolean 'PictureBox保存为文件:PictureBox,文件路径,图片质量(默认: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 = GdipCreateBitmapFromHBITMAP(Pict.Handle, 0, 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 PictureBoxSaveJPG = False Else PictureBoxSaveJPG = True        '判断执行成功还是失败
    Exit Function                                                               '退出过程
Over:
    PictureBoxSaveJPG = False                                                   '执行失败
End Function
Public Function BmpFileToJpg(ByVal BmpFile As String, ByVal OutFile As String, Optional ByVal Quality As Byte = 80) As Boolean 'Bmp文件转换为文件:Bmp文件路径,文件路径,图片质量(默认: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

Microsoft.XMLHTTP对象详解

 一、数据库远程管理技术  基于互联网的广域网现代应用中的一个重要环节是数据库远程监控。首先简单回顾一下互联网上的数据库远程管理技术的发展过程和方式:  早期通过编写CGI-BIN程序模块进行数据库远程管理。但CGI-BIN的运行速度慢,维护很不方便,现在已经基本被弃用。 这几年使用组件对象模型(Component Object Model, COM

regsvr32不是内部或外部命令,也不是可运行的程序[解决方法]

在CMD输入这个for %1 in (%windir%system32*.dll) do regsvr32.exe /s %1代码,结果说regsvr32.exe不是内部或外部命令,也不是可运行程序和批处理文件; 安装某些绿色软件的时候,系统有时候会提示“regsvr32不是内部或外部命令,也不是可运行的程序……”;

国家气象局提供的天气预报接口(完整Json接口)

国家气象局提供的天气预报接口主要有三个,分别是:
http://www.weather.com.cn/data/sk/101010100.html
...

115网盘华语APE下载。

115网盘的高品音乐下载。

http://115.com/folder/fdo4bxyw  

...

用QQ获得来访者的IP和省市

今天偶然发现,QQ居然有个地址

http://fw.qq.com/ipaddress

可以获得来访的用户的IP地址和省,市,因此转一下笔记下

...

固话/小灵通常用呼叫转移使用办法

固话/小灵通常用呼叫转移使用办法
无条件呼叫转移:对来话全部转移到其他电话上接听。
登记:*57*电话号码# :
撤消:#57#

无应答呼叫转移:对来话6秒钟内没有接听时,自动转到其他电话上接听。
登记: * 41 *电话号码#
撤消: # 41 #
 
遇忙呼叫转移:当您正在通话时又有来话,可自动转到其他电话上接听。
登记: *40* 电话号码#
撤消:# 40 #

...

分页:[«]1[»]