 |
Function gPrintListView(ByRef pobjListView As ListView, pstrHeading As String, Prn As Object) As Boolean
'--------------------------------------------------------------------------
' Name : gPrintListView
' Description : Print List View
' Parameters : Listview control, Printed page heading
' Returns : N/A
' Called From : Anywhere
' Author : Paul Jones
' Date : 07/06/2001
' Notes :
'--------------------------------------------------------------------------
Dim objCol As ColumnHeader
Dim objLI As ListItem
Dim objILS As ImageList
Dim objPic As Picture
Dim dblXScale As Double
Dim dblYScale As Double
Dim sngFontSize As Single
Dim lngX As Long
Dim lngY As Long
Dim lngX1 As Long
Dim lngY1 As Long
Dim lngX2 As Long
Dim lngRows As Long
Dim lngLeft As Long
Dim lngPageNo As Long
Dim lngEOP As Long
Dim lngEnd As Long
Dim lngWidth As Long
Dim intCols As Integer
Dim lngTop As Long
Dim intOffset As Integer
Dim px As Integer
Dim py As Integer
Dim intRowHeight As Integer
Dim strText As String
Dim strTextTrun As String
'--------------------------------------------------------------------------
'Establish print & screen metrics
'--------------------------------------------------------------------------
On Error GoTo Error_Handler
Screen.MousePointer = vbHourglass
For Each objCol In pobjListView.ColumnHeaders
lngX = lngX + objCol.Width
Next
Set objILS = pobjListView.SmallIcons
dblXScale = (Prn.Width * 0.9) / lngX
dblYScale = Prn.Height / pobjListView.Height
lngLeft = (Prn.Width - (Prn.Width * 0.95)) / 2
sngFontSize = Prn.Font.Size
If pstrHeading <> "" Then
Prn.Font.Size = 16
Prn.CurrentX = (Prn.Width / 2) - (Prn.TextWidth(pstrHeading) / 2)
'Prn.Font.Underline = True
Prn.Font.Bold = True
Prn.Print pstrHeading
Prn.Font.Underline = False
Prn.Font.Size = sngFontSize
lngTop = Prn.CurrentY + Prn.CurrentY
End If
intRowHeight = (Screen.TwipsPerPixelY * 17)
lngEOP = Prn.Height - (intRowHeight * 3)
lngX = lngLeft
lngY = lngTop
lngY1 = lngTop + (Screen.TwipsPerPixelY * 17)
Prn.CurrentY = lngY
Prn.Font.Bold = True
Prn.DrawMode = vbCopyPen
px = Screen.TwipsPerPixelX
py = Screen.TwipsPerPixelY
'--------------------------------------------------------------------------
'Print column headers with slight 3D effect
'--------------------------------------------------------------------------
For Each objCol In pobjListView.ColumnHeaders
lngX1 = lngX + (objCol.Width * dblXScale)
Prn.Line (lngX, lngY)-(lngX1, lngY1), vbButtonShadow, BF
Prn.Line (lngX, lngY)-(lngX1 - px, lngY1), RGB(245, 245, 245), BF
Prn.Line (lngX + px, lngY + py)-(lngX1, lngY1), vbButtonShadow, BF
Prn.Line (lngX + px, lngY + py)-(lngX1 - px, lngY1 - py), vbButtonFace, BF
Prn.CurrentY = lngY + ((intRowHeight - Prn.TextHeight(objCol.Text)) / 2) + py
Select Case objCol.Alignment
Case ListColumnAlignmentConstants.lvwColumnCenter
Prn.CurrentX = lngX + (((objCol.Width * dblXScale) - Prn.TextWidth(objCol.Text)) / 2)
Case ListColumnAlignmentConstants.lvwColumnLeft
Prn.CurrentX = lngX + (px * 5)
Case ListColumnAlignmentConstants.lvwColumnRight
Prn.CurrentX = lngX + ((objCol.Width * dblXScale) - Prn.TextWidth(objCol.Text)) - (px * 5)
End Select
Prn.Print objCol.Text
lngX = lngX1
Next
lngEnd = lngX1 + px
Prn.Font.Bold = False
'--------------------------------------------------------------------------
'Print list item data
'--------------------------------------------------------------------------
For Each objLI In pobjListView.ListItems
If lngY1 > lngEOP - intRowHeight - intRowHeight Then
'------------------------------------------------------------------
'Print page number
'------------------------------------------------------------------
lngPageNo = lngPageNo + 1
Prn.CurrentX = (Prn.Width / 2) - (Prn.TextWidth("第 " & lngPageNo & " 页") / 2)
Prn.CurrentY = lngEOP - intRowHeight
Prn.Print "第 " & lngPageNo & " 页" '"Page " & lngPageNo
Prn.NewPage
Prn.CurrentY = lngTop
lngY = lngTop
Else
lngY = lngY + intRowHeight
End If
lngX = lngLeft
lngY1 = lngY + intRowHeight
For Each objCol In pobjListView.ColumnHeaders
'------------------------------------------------------------------
'Print the icon if on col 1
'------------------------------------------------------------------
If objCol.Index > 1 Then
strText = objLI.SubItems(objCol.Index - 1)
intOffset = 0
Else
strText = objLI.Text
If IsEmpty(objLI.SmallIcon) Then
intOffset = 0
Else
Set objPic = objILS.Overlay(objLI.SmallIcon, objLI.SmallIcon)
Prn.PaintPicture objPic, lngX + px, lngY + (py / 2), 16 * px, 16 * py, , , , , vbSrcCopy
intOffset = px * 16
End If
End If
'------------------------------------------------------------------
'Make sure text fits
'------------------------------------------------------------------
lngWidth = (objCol.Width * dblXScale)
lngX1 = lngX + lngWidth
strTextTrun = strText
Do Until Prn.TextWidth(strTextTrun) < lngWidth - (px * 5) - intOffset Or strText = ""
strText = Left$(strText, Len(strText) - 1)
strTextTrun = strText & "..."
Loop
Prn.Line (lngX, lngY)-(lngX1, lngY1), 1, B
Prn.CurrentY = lngY + ((intRowHeight - Prn.TextHeight(strTextTrun)) / 2) + py
Select Case objCol.Alignment
Case ListColumnAlignmentConstants.lvwColumnCenter
Prn.CurrentX = lngX + intOffset + (((objCol.Width * dblXScale) - Prn.TextWidth(strTextTrun)) / 2)
Case ListColumnAlignmentConstants.lvwColumnLeft
Prn.CurrentX = lngX + intOffset + (px * 5)
Case ListColumnAlignmentConstants.lvwColumnRight
Prn.CurrentX = lngX + ((objCol.Width * dblXScale) - intOffset - Prn.TextWidth(strTextTrun)) - (px * 5)
End Select
'------------------------------------------------------------------
'Print each colum
'------------------------------------------------------------------
Prn.Print strTextTrun
lngX = lngX1
Next
Next
'--------------------------------------------------------------------------
'Print final page number
'--------------------------------------------------------------------------
lngPageNo = lngPageNo + 1
Prn.CurrentX = (Prn.Width / 2) - (Prn.TextWidth("第 " & lngPageNo & " 页") / 2)
Prn.CurrentY = lngEOP - intRowHeight
Prn.Print "第 " & lngPageNo & " 页"
Prn.EndDoc
gPrintListView = True
Screen.MousePointer = vbDefault
Set objCol = Nothing
Set objILS = Nothing
Set objLI = Nothing
Set objPic = Nothing
Exit Function
Error_Handler:
Set objCol = Nothing
Set objILS = Nothing
Set objLI = Nothing
Set objPic = Nothing
Screen.MousePointer = vbDefault
'--------------------------------------------------------------------------
'Simple error message reporting
'--------------------------------------------------------------------------
MsgBox "系统打印出错:-" & vbCrLf & vbCrLf & _
"错误号: " & Err.Number & vbCrLf & "错误内容:" & Err.Description, vbExclamation
End Function
此问题由yhb1973cn回答。
附加关键字：编程, 源程序, programming, source code, Visual Basic, VB, 打印与报表, print, report crystal report, active report, Windows 9x控件, listview, treeview, monthview, progress bar。
|
如何打印listview中的内容
