干货! 用StretchBlt处理图片,保存后的图片有黑边?

tdlthm 2015-06-23 10:25:13
用 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 Long

Private 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
...全文
1321 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
RayHuang09 2017-10-25
  • 打赏
  • 举报
回复
请问楼主是如何解决的,我也 遇到了同样的问题,希望赐教
舉杯邀明月 2015-06-23
  • 打赏
  • 举报
回复
引用 6 楼 tdlthm 的回复:
@ Chen8013 ,你的回答是通过图片缩放 我试了你的代码 图片会有压缩或者拉伸,造成了失真 ...........
我没理解你的目的是“留白”来实现等比缩放。 当然如果用PaintPicture实现也是可以的。 如果你要实现“留白”部分真正的为白色,应该明确指定Picture1的BackColor为白色。 否则,留白部分有可能是黑色,或者为系统的“窗口背景”或“按钮表面”的颜色,不一定是白色。
tdlthm 2015-06-23
  • 打赏
  • 举报
回复
算了,还是不是了,怕说错了让大家见笑!!!!!!
tdlthm 2015-06-23
  • 打赏
  • 举报
回复
@赵4老师,谢谢你的回复,不过在你回复之前问题已经解决了! 下面我对 paintpicture 函数 说说我的理解 object.PaintPicturepicture, x1, y1, width1, height1, x2, y2, width2, height2, opcode
tdlthm 2015-06-23
  • 打赏
  • 举报
回复
@ 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遍,还是没理解对,这次算是理解了!!! 如下图 ,已经可以得到想要的图片了!
赵4老师 2015-06-23
  • 打赏
  • 举报
回复
在任意位置绘制图形


使用 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 方法”。
tdlthm 2015-06-23
  • 打赏
  • 举报
回复
比如说 我的图片像素尺寸是750 * 1000 按照102/152的像素比算下来的话 如果按照750的宽度计算出来满足比例的高度是:750*152/102=1117 大于 1000 如果按照1000的高度计算出来满足比例的宽度是:1000*102/152=671 小于750 这样就需要按照750 的宽度 1117 的高度 来重新生成图片 这样一来的话,重新生成的图片 高度f上半部分留白像素尺寸为: (1117-1000)/2 高度下半部分留白像素尺寸也是: (1117-1000)/2 但是实际效果是 上半部分留白正常 下半部分不正常了, 如上我的第二个截图,不晓得怎么处理了。
Tiger_Zhao 2015-06-23
  • 打赏
  • 举报
回复
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 有什么内容?
tdlthm 2015-06-23
  • 打赏
  • 举报
回复
谢谢Chen8013 的回复,可能是我表达的问题把,我现在再把我的意思说一下: 裁切图片来满足比例,这种我已经解决了,但问题是这种裁切会导致图片信息丢失, 所以现在打算采用补偿的方法来实现,这样就不至于导致图片信息被裁切掉。 就是用原始图片的像素尺寸 按照 一定的比例来进行计算,计算出 长度方向 或者 宽度方向需要补偿的的像素宽度, 如我1楼我发的帖子的第二幅图,处理完后,是需要在高度方向进行尺寸补偿,这样一来,图片上方和下发就应该有留白, 但我现在处理的结果是 上边留白正常, 下面就变成黑色的了。(上下补偿都是白色就满足需求了) 希望大侠给多指教!
舉杯邀明月 2015-06-23
  • 打赏
  • 举报
回复
用API函数通过 PictureBox 的HDC操作, 如果 PictureBox 被遮住(全部,或部分),往往会出现类似“花屏”的结果。
舉杯邀明月 2015-06-23
  • 打赏
  • 举报
回复
建议楼主还是用 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格式图片文件,可以在网上搜索一下代码。

2,464

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧