2,464
社区成员
发帖
与我相关
我的任务
分享
'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
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
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格式图片文件,可以在网上搜索一下代码。