VB 控制picturebox内容适应A4纸张大小,横向纵向调整,适合打印输出和图形输出一致!

如题:给出代码,分数好说!

推荐答案 2011-11-09

设置打印机的默认纸张是a4，在vb中就可以通过printer对象可以取得a4纸张大小，可以记录下来，供以后使用；
下边是我写的一段利用picturebox做的打印预览程序，仅供参考！

Set flg = Oform.mOform.flg
iNowPage = 1
iRows = flg.Rows - 1
'1 获取用户的设置
sngMargin(0) = CDbl(Oform.txtM(0)) * mCcmToTwips '将厘米换算成缇
sngMargin(1) = CDbl(Oform.txtM(1)) * mCcmToTwips '将厘米换算成缇
sngFontSize = gaUserfont(1).Size * mCPointToTwips * mntimes
sngTblM = gaUserfont(0).Size * mntimes * mCPointToTwips + sngMargin(0) '页眉高度

s_getColIndex '取出全部打印列（flg中的col）
s_GetMergeCols '取出合并列的合并次数
s_CalcColsWidth '计算列的打印宽度
'2 判断纸张大小是否足以打下报表

'If sngTblWid > Printer.ScaleWidth Then

If sngTblWid > Printer.ScaleWidth Then
Screen.MousePointer = 0
If MsgBox("部分内容已超出页面范围。是否继续?", vbQuestion + vbYesNo, "万能打印") = vbNo Then Exit Sub
End If
'3 计算每页最多可打印的行数（（页高—上下空白）/行高—1）
iMaxRecsPerPage = Int((Printer.ScaleHeight - sngTblM - sngMargin(1)) / (1.5 * sngFontSize) - 1)
If CInt(iRows / iMaxRecsPerPage) - Int(iRows / iMaxRecsPerPage) = 1 Then
iPages = CInt(iRows / iMaxRecsPerPage)
Else
iPages = CInt(iRows / iMaxRecsPerPage) + 1
End If
UpDown1.Max = iPages

'4.开始打印
With Pic1
'.ScaleHeight = Printer.ScaleHeight
' .ScaleWidth = Printer.ScaleWidth
Frame1.Width = Me.ScaleWidth + 500
.Height = Printer.ScaleHeight * mntimes
.Width = Printer.ScaleWidth * mntimes
.ScaleHeight = Printer.ScaleHeight
.ScaleWidth = Printer.ScaleWidth
.Left = 0
.Top = 600
Hsb.Min = 0
If .Width <= Hsb.Width Then

Hsb.Visible = False
Else
Hsb.Visible = True
Hsb.Max = .Width - Hsb.Width
Hsb.Value = (.Width - Hsb.Width) / 2
End If
Vsb.Min = 540
If .Height + 600 <= Me.ScaleHeight Then

Vsb.Visible = False
Else
Vsb.Visible = True
Vsb.Max = .Height - Vsb.Height
End If
' Me.Height = Me.ScaleHeight * 0.75
' Me.Width = Me.ScaleWidth * 0.75

For iC = 1 To Val(Oform.txtCopies) '对份数循环
For iNowPage = miPages To iPages '对页范围循环
'4-1 打印表头
' 不能用Set Printer.Font = gaUserfont(0)，打印机字体可能被某些隐含过程改变，从而影响到userfont
With .Font
.name = gaUserfont(0).name
.Size = gaUserfont(0).Size * mntimes
.Bold = gaUserfont(0).Bold
.Italic = gaUserfont(0).Italic
.Underline = gaUserfont(0).Underline
.Strikethrough = False
End With
sTmp = Oform.txtTitle & "(" & Trim(Oform.mOform.Tag) & ")"
.CurrentX = sngLMargin + (sngTblWid - Pic1.TextWidth(sTmp)) / 2
.CurrentY = sngMargin(0) - sngFontSize * 2
Pic1.Print sTmp

'4-2 在表格的右上部打印＂打印日期＂
With .Font
.name = gaUserfont(1).name
.Size = gaUserfont(1).Size * mntimes
.Bold = gaUserfont(1).Bold
.Italic = gaUserfont(1).Italic
.Underline = gaUserfont(1).Underline
.Strikethrough = False
End With
sStr = "打印时间： " & Now()
.CurrentX = sngLMargin + sngTblWid - Pic1.TextWidth(sStr) - 200
.CurrentY = sngTblM - sngFontSize * 1.5

Pic1.Print sStr
'在页底边中间打印页码
.Font.Size = gaUserfont(1).Size * mntimes
.CurrentX = .ScaleWidth / 2
.CurrentY = .ScaleHeight - sngMargin(1)
Pic1.Print "第" & CStr(iNowPage) & "页"
'4-3 打印列标题
.DrawWidth = 1
'4-3-1划上边线
.CurrentX = sngLMargin
.CurrentY = sngTblM - sngFontSize / 4
Pic1.Line -Step(sngTblWid, 0) '划上边线
'4-3-2划左边线
.CurrentX = sngLMargin
.CurrentY = sngTblM - sngFontSize / 4
Pic1.Line -Step(0, 1.5 * sngFontSize) '划左边线

tmpX = sngLMargin
tmpY = sngTblM
.CurrentY = tmpY
With .Font
.name = gaUserfont(1).name
.Size = gaUserfont(1).Size * mntimes
.Bold = gaUserfont(1).Bold
.Italic = gaUserfont(1).Italic
.Underline = gaUserfont(1).Underline
.Strikethrough = False
End With
For iA = 0 To miCols - 1
.CurrentY = tmpY
If miMergeTimes(iA) = 1 Then
' If miAlignment(iA) = flexAlignLeftCenter Then
' .CurrentX = tmpX + sngFontSize / 4
' Else
' .CurrentX = tmpX + sngColWid(iA) - Pic1.TextWidth(Oform.lstChosenFlds.List(iA)) - sngFontSize / 4
' If .CurrentX < tmpX Then .CurrentX = tmpX + sngFontSize / 4
' End If
Else
.CurrentX = tmpX + (sngColWid(iA) * miMergeTimes(iA) - Pic1.TextWidth(Oform.lstChosenFlds.List(iA))) / 2 - sngFontSize / 4
End If
'输出数据
sStr = Trim(Oform.lstChosenFlds.List(iA))
'截取尾部的数字
If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)
If IsNumeric(Right(sStr, 1)) Then sStr = Left(sStr, Len(sStr) - 1)
.CurrentX = tmpX + (sngColWid(iA) * miMergeTimes(iA) - Printer.TextWidth(sStr)) / 2 - sngFontSize / 4
If .CurrentX < tmpX Then .CurrentX = tmpX
Pic1.Print sStr
'确定位置
.CurrentX = tmpX
.CurrentY = tmpY + sngFontSize * 1.25
'划下边线
Pic1.Line -Step(sngColWid(iA) * miMergeTimes(iA), 0)
tmpX = tmpX + sngColWid(iA) * miMergeTimes(iA)
.CurrentX = tmpX
.CurrentY = tmpY - sngFontSize / 4
'划右边线
Pic1.Line -Step(0, sngFontSize * 1.5)
Next

'4－4打印数据
tmpY = tmpY + sngFontSize * 1.25
tmpX = sngLMargin
.CurrentX = tmpX
.CurrentY = tmpY
iFRow = (iNowPage - 1) * iMaxRecsPerPage + 1 '第一行的行数
iLRow = iNowPage * iMaxRecsPerPage '最后一行的行数
'如果最后行数大于最大行取最大行为最后行
iLRow = IIf(iLRow > iRows, iRows, iLRow)
For iNowRow = iFRow To iLRow
tmpX = sngLMargin
.CurrentX = tmpX
.CurrentY = tmpY
For iCycle = 0 To miCols - 1
iNowcol = miColIndex(iCycle)
.CurrentX = tmpX
.CurrentY = tmpY
For iMerge = 1 To miMergeTimes(iCycle)
'划左边线
.CurrentX = tmpX
.CurrentY = tmpY
Pic1.Line -Step(0, 1.5 * sngFontSize)
'打印数据

If flg.ColAlignment(iNowcol) = flexAlignRightCenter Then
.CurrentX = tmpX + sngColWid(iCycle) * iMerge - .TextWidth(flg.TextMatrix(iNowRow, iNowcol))
If .CurrentX < tmpX Then .CurrentX = tmpX
Else
.CurrentX = tmpX + sngFontSize / 4
End If
.CurrentY = tmpY + sngFontSize * 0.25
sStr = flg.TextMatrix(iNowRow, iNowcol)
If IsNumeric(sStr) Then If Left(sStr, 1) = "." Then sStr = "0" & sStr
If sStr = "0" Then sStr = ""
If iNowRow < 4 Then
If IsNumeric(sStr) Then
Pic1.Print sStr
Else
If sStr <> sTmp Then Pic1.Print sStr
End If
Else
Pic1.Print sStr
End If
sTmp = sStr
'划下边线
.CurrentY = tmpY + sngFontSize * 1.5
.CurrentX = tmpX
Pic1.Line -Step(sngColWid(iCycle), 0)
'划右边线
tmpX = tmpX + sngColWid(iCycle)
.CurrentX = tmpX
.CurrentY = tmpY
'划右边线
Pic1.Line -Step(0, sngFontSize * 1.5)
iNowcol = iNowcol + 1
Next

Next
tmpY = tmpY + sngFontSize * 1.5
.CurrentY = tmpY
Next
.Top = 600

Exit For

Next
Exit For
Next

End With

温馨提示：答案为网友推荐，仅供参考

当前网址：http://55.wendadaohang.com/zd/eeG8GGLGe.html

其他回答

第1个回答 2011-11-08

Private Sub Command1_Click()
Dim i As Integer
i = Me.ScaleMode
Me.ScaleMode = 7 '厘米作为单位
Picture1.Move 0, 0, 21, 29.7 'A4纸的尺寸
Me.ScaleMode = i
End Sub追问

打印机是Microsoft Office Document Image Writer
Picture1.CurrentX = 1400 '这里不能用厘米
Picture1.CurrentY = 1000 '这里不能用厘米
Picture1.FontSize = 26
Picture1.Print " TEST REPORT"
Printer.Orientation = 2 会报错打印机默认1
Printer.PaintPicture Picture1.Image, 0, 0
Printer.EndDoc

追答

下面代码，我测试过了，可以打印...

Option Explicit

Private Sub Form_Load()
Me.Show
Me.WindowState = 2

Dim i As Integer
i = Me.ScaleMode
Me.ScaleMode = 7 '厘米作为单位
Picture1.ScaleMode = 7 '厘米作为单位注意注意注意
Picture1.Move 0, 0, 29.7, 21 'A4纸的尺寸
Me.ScaleMode = i
End Sub

Private Sub Command1_Click()
With Picture1
.FontSize = 26
.CurrentX = .ScaleX(1400, 1, 7) '将Twip数值转化为cm数值注意注意注意
.CurrentY = .ScaleY(1000, 1, 7) '将Twip数值转化为cm数值注意注意注意
Picture1.Print "TEST REPORT"
End With
End Sub

Private Sub Command2_Click()
With Printer
.PaperSize = vbPRPSA4 '设置打印机纸张类型
.Orientation = vbPRORLandscape '设置打印方向
.PaintPicture Picture1.Image, 0, 0
.EndDoc
End With
End Sub

追问

还是有问题呀(如图),能不能直接调用修改打印机的属性参数?谢谢!

您如果方便的话给我做个,一个form加picturebox仿A4纸,定义它们的坐标范围(以后我可以在这个范围内作图写字),可以横向纵向转换,打印输出后和显示的一致(打印机是Microsoft Office Document Image Writer
) +200分

追答

'设置Pic1的A4纸规格不同方向
'Pic1控件在Pic0控件上，如果是放在Form1里，将Pic0改为Me就行了...
Private Sub SetPaper(Flag As Integer)
With Pic1
'在改变纸张时设置ScaleMode
Pic0.ScaleMode = 7
.Width = IIf(Flag = 0, 21, 29.7) '纵向规格
.Height = IIf(Flag = 0, 29.7, 21) '横向规格
Pic0.ScaleMode = 1
End With
End Sub

'打印
'Prt为选定的打印机
'img为PictureBox的Image属性
'Orientation为打印方向，vbPRORPortrait和vbPRORLandscape
Private Function PrintPic(Prt As Printer, img As IPictureDisp, Optional Orientation = vbPRORPortrait) As Long
On Error Resume Next
Set Printer = Prt
On Error GoTo PErr
With Printer
.PaperSize = vbPRPSA4
.Orientation = Orientation
.PaintPicture img, 0, 0
.EndDoc
End With
PrintPic = 1
Exit Function
PErr:
'PrintPic = 0
'我在使用“Microsoft Office Document Image Writer”打印时跟你一样，
'设置Orientation= vbPRORLandscape时也出现了错误
'我测试过，如果先将“Microsoft Office Document Image Writer”的打印首选项改为横向，
'那么设置Orientation为vbPRORPortrait、或vbPRORLandscape都没问题。
'至于如何用代码去控制，我还没找到方法的
End Function

本回答被提问者采纳

第2个回答 2011-11-08

下载csximage.ocx

相似回答

大家正在搜