VB改变图片大小的函数

小歆13年前软件源码04839
   Public Function ResizePicture(ByVal sourceImage As Bitmap, _
                ByVal newSize As Size) As Bitmap '调整图片大小(图片源,新尺寸)

        Dim Result_image As New Bitmap(sourceImage, newSize.Width, newSize.Height)
        Dim Gr As Graphics

        Gr = Graphics.FromImage(Result_image)
        Gr.DrawImage(Result_image, 0, 0, newSize.Width, newSize.Height)
        Gr.Save()

        Return Result_image
    End Function

    Public Function CropBitmap(ByVal inputBmp As Bitmap, _
                ByVal cropRectangle As Rectangle) As Bitmap '裁剪位图(输出,矩形)
        '创建一个新的位图对象根据输入的
        Dim newBmp As New Bitmap(cropRectangle.Width, _
                 cropRectangle.Height, _
                 System.Drawing.Imaging.PixelFormat.Format24bppRgb) 'Graphics.FromImage 
                                                'doesn't like Indexed pixel format

        '创建一个图形对象,并将其附加的位图
        Dim newBmpGraphics As Graphics = Graphics.FromImage(newBmp)

        '对输入图像中裁剪矩形绘制的部分
        '图形对象
        newBmpGraphics.DrawImage(inputBmp, _
              New Rectangle(0, 0, cropRectangle.Width, cropRectangle.Height), _
                cropRectangle, _
                GraphicsUnit.Pixel)

        'Return the bitmap
        newBmpGraphics.Dispose()

        'newBmp will have a RawFormat of MemoryBmp because it was created
        'from scratch instead of being based on inputBmp.  Since it is inconvenient
        'for the returned version of a bitmap to be of a different format, now convert
        'the scaled bitmap to the format of the source bitmap
        Return newBmp
    End Function        

相关文章

用VB快速读取TextBox第N行的数据

TextBox 是以 vbCr+vbLf 为分行符号, 如果我们要逐一读取 TextBox 每一行, 无非是寻找 vbCr+vbLf 的所在位置, 然后取出每一行的字串, 不过这个方法不快,而且...

Discuz附件下载权限绕过工具.png

[小歆][Discuz附件下载权限绕过工具][V1.1][2014.03.13]

Discuz附件下载权限绕过工具V1.1 本软件利用Discuz论坛的漏洞来下载论坛的附件。 【Discuz3.X的有部分好像已经失效了,自测,我刚刚测试了一个3.X论坛还是...

[VB函数]将资源文件输出到指定目录下

Private Function UnRes(ByVal ResID As Integer, ByVal ResName As String, ByVal UnResPath As String)...

VB键盘代码真值表

VB键盘代码常量 值 (0x...

小歆专用挂机锁V1.5测试1.jpg

[全新动态]小歆专用挂机锁项目开始启动!!!

小歆专用挂机锁V1.5升级项目 目前1.0版本项目已经结束,接下来是我们加强版1.5版本的升级日志,欢迎下载使用...    项目日志:...

VB UTC+8校正 源码

Function HttpGet(url) With CreateObject("Msxml2.ServerXMLHTTP") .open "GET", url,...

发表评论    

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。