还是那个问题，把100*100的图片改成120*120的图片，但是，不能让用户看到这个过程。

Question

前些天有个高手告诉我说Private Sub Command2_Click()
    Dim w As Integer, h As Integer
    Picture1.Picture = LoadPicture("g:\gg-manhuabao.jpg")
    w = Picture1.Width
    h = Picture1.Height
    
    
     Picture2.Width = w * 1.2
     Picture2.Height = h * 1.2     StretchBlt Picture2.hdc, 0, 0, w * 1.2, h * 1.2, Picture1.hdc, 0, 0, w, h, vbSrcCopy
    
    
    SavePicture Picture2.Image, "g:\gg-manhuabao41.jpg"End Sub用这个方法，确实不错但是有一个问题，里面用到几个可视化控件，我的应用中，要把一张图片改变成很多不同的规格，而这个过程是不要用户看到的。
我曾经想过把FORM隐藏起来，但是试过之后发现上面的方法是基于屏幕COPY的
 
如果隐藏，就得不到想要的效果了。不知道哪位高手有什么好的建议，在后台就能完成这种转化呢？

Answer 1

办法是有，但不是好办法，你不是只要放大图片么，有很多种放大的算法，直接基于BMP文件格式的。你要不要试试，我可以提供相关资料

Answer 2

将picture2的可见属性设为false，autoredraw属性设为true（或者用内存设备场景）
Private Sub Command2_Click()
    Dim w As Integer, h As Integer'最好定义为long，加快速度
    Picture1.Picture = LoadPicture("g:\gg-manhuabao.jpg")
    w = Picture1.Width
    h = Picture1.Height
    
    
     Picture2.Width = w * 1.2
     Picture2.Height = h * 1.2     StretchBlt Picture2.hdc, 0, 0, w * 1.2, h * 1.2, Picture1.hdc, 0, 0, w, h, vbSrcCopy
    
    
    SavePicture Picture2.Image, "g:\gg-manhuabao41.jpg"'注意这局，尽管扩展名为jpg，可实际是bmp文件格式的End Sub

Answer 3

二楼这方面的资料吗？
[email protected]
三楼的方法可以解决 PIC2看不见，但是 pic1还是必须得显示出来啊而且我的窗口特别小，可能就只有pic1那么小，根本没地方放PIC2

Answer 4

这个和pic2的位置有关系吗，你的pic1是显示还是不显示？

Answer 5

经测试，即使pic2把pic1完全覆盖，也可以保存成功

Answer 6

楼上的谢谢啊
不过我连PIC1也不想看到

Answer 7

明白了，那就根据bmp的文件格式写

Answer 8

办法是有滴：放置一个隐藏的pic或image控件作为临时存放地，变幻在这里进行，然后将图片赋给你的picture显示

Answer 9

'窗体上一个按钮
'保存图象部分是周跃林的代码
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0
Private Type BITMAPFILEHEADER
        bfType(0 To 1) As Byte
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
        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 Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
 Const SRCCOPY = &HCC0020
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Const OBJ_BITMAP = 7
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type 
Public Function SaveBMP(ByVal hdc As Long, FileName As String) As Boolean
    Dim hBitmap As Long
    hBitmap = GetCurrentObject(hdc, OBJ_BITMAP) '取得位图
    If hBitmap = 0 Then Exit Function
    Dim bm As BITMAP
    If GetObject(hBitmap, Len(bm), bm) = 0 Then Exit Function '得到位图信息
    Dim bmih As BITMAPINFOHEADER
    bmih.biSize = Len(bmih)
    bmih.biWidth = bm.bmWidth
    bmih.biHeight = bm.bmHeight
    bmih.biBitCount = 24
    bmih.biPlanes = 1
    bmih.biSizeImage = ((bmih.biWidth * 3 + 3) And &H7FFFFFFC) * bmih.biHeight '计算大小
    ReDim MapData(1 To bmih.biSizeImage) As Byte
    If GetDIBits(hdc, hBitmap, 0, bmih.biHeight, MapData(1), bmih, DIB_RGB_COLORS) = 0 Then Exit Function '取得位图数据
    Dim hF As Integer
    hF = FreeFile(1)
    On Error Resume Next
    Open FileName For Binary As hF
    If Err.Number Then hF = -1
    On Error GoTo 0
    If hF = -1 Then Exit Function
    Dim bmfh As BITMAPFILEHEADER
    bmfh.bfType(0) = Asc("B")
    bmfh.bfType(1) = Asc("M")
    bmfh.bfOffBits = Len(bmfh) + Len(bmih)
    Put hF, , bmfh
    Put hF, , bmih
    Put hF, , MapData
    Close hF
    SaveBMP = True
End FunctionPublic Sub mSavePic(ByVal infile As String, ByVal FileName As String, ByVal bs As Double)
    On Error Resume Next
    Dim dstWidth As Long, dstHeight As Long
    Dim srcWidth As Long, srcHeight As Long
    Dim x As Long, y As Long
    Dim pic As New StdPicture
    Dim hDc5 As Long, i As Long
    Dim hBitmap As Long
    Dim hDstDc As Long
    Set pic = LoadPicture(infile) '读取图形档
    hDc5 = CreateCompatibleDC(0) '建立Memory DC
    i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图
    Dim mbm As BITMAP
    Call GetObject(pic.Handle, Len(mbm), mbm)
    'i = GetMenuCheckMarkDimensions '取得SetMenuItemBitmaps 所需Bitmap大小
    dstWidth = mbm.bmWidth * bs
    dstHeight = mbm.bmHeight * bs
    '建一个大小为dstWidh * dstHeight大小的Bitmap
    hBitmap = CreateCompatibleBitmap(Me.hdc, dstWidth, dstHeight)
    hDstDc = CreateCompatibleDC(Me.hdc) '建memory dc
    '设该memory dc的绘图区大小=该bitmap大小，且在该memory dc上的绘图便是在
    '该bitmap图上画图
    SelectObject hDstDc, hBitmap
    srcHeight = Me.ScaleY(pic.Height, vbHimetric, vbPixels)
    srcWidth = Me.ScaleX(pic.Width, vbHimetric, vbPixels)
    Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
    SaveBMP hDstDc, FileName
    Call DeleteDC(hDc5)
    Call DeleteDC(hDstDc)
End SubPrivate Sub Command1_Click()
    '将图片"d:\mc\mmc1.jpg"放大0.9倍后另存为"d:\mc\mc22.bmp"
    mSavePic "d:\mc\mmc1.jpg", "d:\mc\mc22.bmp", 0.9
End Sub

Answer 10

我试一下 FIRST再次感谢楼上的大哥