VB如何修改图片?~~~~~~~~~~~~~~~~~~~~~~~~

[Snoworld]

如何把下面这张图片

修改为


修改内容如下:
在原图片下面增加一个宽度相同,高度为30像素的黑色长条,并加上"风雨无阻　拍摄"几个字,谢谢...　...

[Snoworld]

已经达到想要的效果,
但是编辑之后的图片很大,以前的只有100多K,现在达到了1.95M,
如何压缩成以前的大小...

[zdingyun]

[Quote=引用 9 楼 hank212 的回复:]
已经达到想要的效果,
但是编辑之后的图片很大,以前的只有100多K,现在达到了1.95M,
如何压缩成以前的大小...
[/Quote]
LZ：给出的代码是保存为*.bmp位图的代码。

[Snoworld]

能不能把他保存成JPG格式的图片...

[zdingyun]

[Quote=引用 11 楼 hank212 的回复:]
能不能把他保存成JPG格式的图片...
[/Quote]
LZ:目前未找到VB用代码解决的方法。只能用WINDOWS的画图板打开*.Bmp图片另存为
*.JPG图片

[东方之珠]

[Quote=引用 11 楼 hank212 的回复:]
能不能把他保存成JPG格式的图片...
[/Quote]

图片保为JPG文件，可以用GDI+。
看看这里(VB源码):
http://www.cnblogs.com/wangminbai/archive/2008/03/23/1118638.html

[zdingyun]

[Quote=引用 13 楼 chenjl1031 的回复:]
引用 11 楼 hank212 的回复:
能不能把他保存成JPG格式的图片...


图片保为JPG文件，可以用GDI+。
看看这里(VB源码):
http://www.cnblogs.com/wangminbai/archive/2008/03/23/1118638.html
[/Quote]
感谢13 楼 chenjl1031提供链接

[Snoworld]

谢谢大家,问题已经解决.
特别感谢zdingyun ,
发现CSDN的好人越来越多了...

[laviewpbt]

Private Sub Command1_Click()
Dim str As String
str = "风雨无阻 拍摄"
With Picture1
.AutoSize = True
.ScaleMode = 3
.AutoRedraw = True
.Picture = LoadPicture("c:\1.bmp")
Picture1.Line (0, .ScaleHeight - 30)-(.ScaleWidth, .ScaleHeight), vbBlack, BF
.CurrentX = (.ScaleWidth - .TextWidth(str)) / 2
.CurrentY = .ScaleHeight - 30 + (30 - .TextHeight(str)) / 2
.ForeColor = vbWhite
Picture1.Print str
End With

SavePicture Picture1.Image, "c:\2.bmp"
End Sub

要改变 字体的话可以 直接更改Picture1的font属性

[zdingyun]

Option Explicit
    Private Const BI_RGB = 0&
    Private Const DIB_RGB_COLORS = 0
    Private Const BITMAPTYPE = &H4D42
    Private Const INVALID_HANDLE_VALUE = (-1)
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
    End Type
    Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
    End Type
    Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
    End Type
    Private Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
    End Type
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Sub CmdOpen_Click()
    '打开文件并显示在Picture1中
    On Error GoTo Err_handle
    CmnDlg1.DialogTitle = "打开"
    CmnDlg1.ShowOpen
    Picture1.Picture = LoadPicture(CmnDlg1.FileName)
    Picture1.Height = Picture1.Height + 30
    Exit Sub
Err_handle:
    Exit Sub
End Sub

Private Sub CmdSave_Click()
    '保存转换后的图像
    Dim hmemDC As Long
    Dim hmemBMP As Long
    Dim lpmemBits As Long
    Dim bmp_info As BITMAPINFO
    Dim hFile As Long
    Dim bmpfile_info As BITMAPFILEHEADER
    Dim lpBytesWritten As Long
    Picture1.ScaleMode = vbPixels
    With bmp_info.bmiHeader
        .biSize = LenB(bmp_info.bmiHeader)
        .biWidth = Picture1.ScaleWidth
        .biHeight = Picture1.ScaleHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
        .biSizeImage = .biHeight * (((.biWidth * .biBitCount + 31) And &HFFFFFFE0) \ 8)
    End With
    hmemDC = CreateCompatibleDC(Picture1.hdc)
    hmemBMP = CreateDIBSection(Picture1.hdc, bmp_info, DIB_RGB_COLORS, lpmemBits, 0, 0)
    SelectObject hmemDC, hmemBMP
    BitBlt hmemDC, 0, 0, bmp_info.bmiHeader.biWidth, bmp_info.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy
    '保存图片
    hFile = CreateFile(App.Path & "\test.bmp", GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile <> INVALID_HANDLE_VALUE Then
        With bmpfile_info
            .bfType = BITMAPTYPE
            .bfOffBits = 14 + bmp_info.bmiHeader.biSize
            .bfSize = .bfOffBits + bmp_info.bmiHeader.biSizeImage
        End With
        WriteFile hFile, bmpfile_info.bfType, 2, lpBytesWritten, 0
        WriteFile hFile, bmpfile_info.bfSize, 12, lpBytesWritten, 0
        WriteFile hFile, bmp_info.bmiHeader, bmp_info.bmiHeader.biSize, lpBytesWritten, 0
        WriteFile hFile, ByVal lpmemBits, bmp_info.bmiHeader.biSizeImage, lpBytesWritten, 0
        CloseHandle hFile
    End If
    DeleteObject hmemBMP
    DeleteDC hmemDC
End Sub

Private Sub Command1_Click() '修改
    Dim strTxt As String
    strTxt = "风雨无阻 拍摄"
    Picture1.Line (0, Picture1.Height - 34)-(Picture1.Width, Picture1.Height), vbBlack, BF
    Picture1.CurrentY = Picture1.Height - 32
    Picture1.CurrentX = Picture1.ScaleWidth / 2 - Picture1.TextWidth(strTxt) ') / 2 - Picture1.TextWidth(strTxt)
    Picture1.ForeColor = vbWhite
    Picture1.FontSize = 18
    Picture1.Print strTxt
End Sub


Private Sub Form_Load()
    Picture1.AutoSize = True
    Picture1.AutoRedraw = True
End Sub

[zdingyun]

修改部分代码:

Private Sub Command1_Click() '修改
    Dim strTxt As String
    strTxt = "风雨无阻 拍摄"
    Picture1.Line (0, Picture1.ScaleHeight - 30)-(Picture1.ScaleWidth, Picture1.ScaleHeight), vbBlack, BF
    Picture1.CurrentY = Picture1.ScaleHeight - 30
    Picture1.CurrentX = Picture1.ScaleWidth / 2 - Picture1.TextWidth(strTxt) ') / 2 - Picture1.TextWidth(strTxt)
    Picture1.ForeColor = vbWhite
    Picture1.FontSize = 18
    Picture1.Print strTxt
End Sub

[zdingyun]

[zdingyun]

http://album.hi.csdn.net/app_uploads/zdingyun/20081029/105546761.p.jpg?d=20081029105751636

[zdingyun]

http://album.hi.csdn.net/app_uploads/zdingyun/20081029/105546761.p.jpg?d=20081029105751636

[zdingyun]

[zdingyun]

修改部分代码:

Private Sub CmdEdit_Click() '修改
    Dim strTxt As String
    strTxt = "风雨无阻 拍摄"
    Picture1.FontSize = 18
    Picture1.Height = Picture1.Height + 30
    Picture1.Line (0, Picture1.ScaleHeight - 30)-(Picture1.ScaleWidth, Picture1.ScaleHeight), vbBlack, BF
    Picture1.CurrentY = Picture1.ScaleHeight - 30
    Picture1.CurrentX = Picture1.ScaleWidth / 2 - Picture1.TextWidth(strTxt) / 2
    Picture1.ForeColor = vbWhite
    Picture1.FontItalic = True
    Picture1.Print strTxt
End Sub