干货！ 用StretchBlt处理图片，保存后的图片有黑边？

Question

用 StretchBlt 处理图像有后黑边，
原图如下：处理后保存的图片如下（处理后的图片超过2M 论坛上传不了，故对图片进行了QQ截图，展示效果如下）：
代码如下：
思路：以制作宽长比为： 102/152 的 的图像尺寸，             picture2控件加载原始图片，获取原始图片长宽像素值， 对此原始像素值按照102/152的比例进行计算，计算出长度或者宽度上需要增补的尺寸，以达到102/152这一比例。然后将picture1控件的长宽尺寸设置为 通过计算后的目标尺寸，然后用StretchBlt 函数将picture2控件的图像 加载打 picture1控件，然后再保存picture1控件上的目标图片，即为保存到C盘的123.jpg  如源码。   奇怪的是 保存后的图片，下面有黑边，实在是不知道怎么处理了，求教各位高手！
'Form1上添加1个图片框picture1
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor 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
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function GetDC Lib "user32 " (ByVal hWND As Long) As Long
Private Const HALFTONE = 4
Private Const SRCCOPY = &HCC0020 Dim fs
 Dim wScreen As Long
 Dim hScreen As Long
 Dim w As Long
 Dim h As Long
 Dim cw As Long
 Dim ch As Long
 Dim Dw As Long
 Dim Dh As Long
 Dim DifferenceH As Long
 Dim DifferenceW As Long
 Dim PIC As PictureBox
 Dim rtn As Boolean
 Dim rtm As Long
 Dim Hdc1 As Long, Hdc2 As LongPrivate Sub Form_Load()
Picture2.Picture = LoadPicture("C:\1.jpg")
    Printer.ScaleMode = 3
    Printer.ScaleWidth = 1181
    Printer.ScaleHeight = 1772
    Printer.ScaleLeft = 0
    Printer.ScaleTop = 0
AllPrint
End Sub
Sub AllPrint() '此函数用来对图片进行裁切打印        w = Picture2.Width
        h = Picture2.Height
        
If w <= h Then '此判断用来打印宽带小于等等高度的图片
        Printer.Orientation = 1 '打印机纵向
        ch = w * 152 \ 102
        cw = 102 * h \ 152
        DifferenceW = w - cw
        DifferenceH = h - ch
        Debug.Print DifferenceW
        Debug.Print DifferenceH
        If DifferenceW >= 0 And DifferenceH <= 0 Then
            Picture1.Width = w
            Picture1.Height = ch
            Call SetStretchBltMode(Picture1.hDC, HALFTONE)
            rtm = StretchBlt(Picture1.hDC, 0, Abs(DifferenceH / 2), w, ch, Picture2.hDC, 0, 0, w, ch, vbSrcCopy)
            Picture1.Refresh
            SavePicture Picture1.Image, "c:\123.jpg "
        End If
End If
 End Sub

Answer 1

建议楼主还是用 PictureBox 的 PaintPicture方法来处理吧。参考下面这个代码。但你要注意的是，
在设计窗口时，对 PictureBox 的几个属性进行如下设置（在 Form_Load()开头加代码也可）：
Picture1.Appearance = 0
Picture1.BorderStyle = 0
Picture1.AutoRedraw = True
Picture2.AutoSize = True图片缩放代码：
Sub AllPrint()
   w = Picture2.ScaleWidth
   h = Picture2.ScaleHeight
   If w <= h Then
      ch = w * 152 / 102
      cw = h * 102 / 152
      ' 这是原始高度不变，调整宽度适应比例
      Picture1.Width = cw
      Picture1.Height = h
      Picture1.PaintPicture Picture2.Image, 0, 0, cw, h, 0, 0, w, h, vbSrcCopy
      
      ' 下面这个是宽度不变，调整高度来适应比例
      'Picture1.Width = w
      'Picture1.Height = ch
      'Picture1.PaintPicture Picture2.Image, 0, 0, w, ch, 0, 0, w, h, vbSrcCopy
      SavePicture Picture1.Image, "E:\Temp\123.bmp"
   End If
End Sub
SavePicture 保存的格式是Bmp的。
你把扩展名写成 .jpg 并没有实际作用，如果要保存jpg格式图片文件，可以在网上搜索一下代码。

Answer 2

用API函数通过 PictureBox 的HDC操作，
如果 PictureBox 被遮住（全部，或部分），往往会出现类似“花屏”的结果。

Answer 3

谢谢Chen8013 的回复，可能是我表达的问题把，我现在再把我的意思说一下： 裁切图片来满足比例，这种我已经解决了，但问题是这种裁切会导致图片信息丢失，所以现在打算采用补偿的方法来实现，这样就不至于导致图片信息被裁切掉。就是用原始图片的像素尺寸 按照 一定的比例来进行计算，计算出 长度方向 或者 宽度方向需要补偿的的像素宽度，如我1楼我发的帖子的第二幅图，处理完后，是需要在高度方向进行尺寸补偿，这样一来，图片上方和下发就应该有留白，但我现在处理的结果是 上边留白正常， 下面就变成黑色的了。（上下补偿都是白色就满足需求了）希望大侠给多指教！

Answer 4

Sub x()
    '假定原始图片 1000 * 1000'
    w = 1000
    h = 1000    ch = w * 152 \ 102
    cw = 102 * h \ 152    DifferenceW = w - cw
    DifferenceH = h - ch    'StretchBlt(Picture1.hDC, 0, Abs(DifferenceH / 2), w, ch, Picture2.hDC, 0, 0, w, ch, vbSrcCopy)'
    Debug.Print "目标", 0, Abs(DifferenceH / 2), w, ch
    Debug.Print "源", 0, 0, w, ch
End Sub
目标           0             245           1000          1490 
源             0             0             1000          1490 
你从 1000*1000 上切 1000*1490，下面的 490 有什么内容？

Answer 5

@ Chen8013 ，你的回答是通过图片缩放 我试了你的代码 图片会有压缩或者拉伸，造成了失真@ Tiger_Zhao ，你的回答虽然没解决问题，但是却提醒了哦，对于 'Picture1.PaintPicture Picture2.Image, 0, 0, w, ch, 0, 0, w, h, vbSrcCopy
         StretchBlt(Picture1.hDC, 0, Abs(DifferenceH / 2), w, ch, Picture2.hDC, 0, 0, w, ch, vbSrcCopy)  paintpicture 和 stretchebit 这两个函数 里面主要的八个参数 我的理解有误，所以造成了黑边问题。
   可恨的是 我对这两个函数里面的参数所代表的意义，一字一句的读了不下10遍，还是没理解对，这次算是理解了！！！
如下图 ，已经可以得到想要的图片了！         

Answer 6

在任意位置绘制图形
使用 PaintPicture 方法，可以在窗体、图片框和 Printer 对象上的任何地方，绘制图形。PaintPicture 方法的语法是：[object.]PaintPicture pic, destX, destY[, destWidth[, destHeight[, srcX _[, srcY[, srcWidth[, srcHeight[, Op]]]]]]]目标 object 指的是窗体、图片框或 Printer 对象，这些地方都是 pic 图片表现的处所。如果 object 被忽略了，则认为指定的就是当前的窗体。pic 参数必须是一个图片对象，它是由窗体或控件的 Picture 属性决定。destX 和 destY 参数，是按照 objec 的 ScaleMode，该图象将出现的水平和垂直位置。destWidth 和 destHeight 参数是可选项，用来设置在 object 目标中该图象的宽度和高度。srcX 和 srcY 参数是可选项，用来定义 pic 中裁剪区左上角的 x 和 y 坐标。可选的 Op 参数用来定义当在目标 object 上绘图时，在图片上执行的光栅操作（例如，AND 和 XOR）。PaintPicture 方法可代替 BitBlt Windows API 函数，在将矩形图形块从一个地方移到任意另一地方时，它可执行广泛的各种操作。例如，可以使用 PaintPicture 方法生成同一位图的多份副本，并将它们平铺在窗体上。使用这种方法，比在窗体上移动图片控件要快。下列代码是用来平铺图片控件的 100 份拷贝，并且通过给 destWidth 设置一个负值，可以使每张图片进行水平翻转。For i = 0 To 10
   For j = 0 To 10
      Form1.PaintPicture picF.Picture, j * _
         picF.Width, i * picF.Height, _
         picF.Width, -picF.Height
Next j, i详细信息 请参阅《语言参考》的“PaintPicture 方法”。

Answer 7

@赵4老师，谢谢你的回复，不过在你回复之前问题已经解决了！下面我对 paintpicture 函数 说说我的理解
object.PaintPicturepicture, x1, y1, width1, height1, x2, y2, width2, height2, opcode

Answer 8

我没理解你的目的是“留白”来实现等比缩放。
当然如果用PaintPicture实现也是可以的。
如果你要实现“留白”部分真正的为白色，应该明确指定Picture1的BackColor为白色。
否则，留白部分有可能是黑色，或者为系统的“窗口背景”或“按钮表面”的颜色，不一定是白色。