?? posprint.cls
字號:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "PosPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Dim PageLeft As Single
Dim PageTop As Single
Private Type PrintText
caption As String
X As Single
Y As Single
strfont As String
strsize As Integer
bStrickThought As Boolean
End Type
Private Type Cell
x1 As Single
y1 As Single
x2 As Single
y2 As Single
LineWidth As Integer
str As PrintText
End Type
'要引發該事件,請遵循下列語法使用 RaiseEvent:
'RaiseEvent PrintGrid[(arg1, arg2, ... , argn)]
Public Event PrintPage()
Public Event ShowConfig()
'保持屬性值的局部變量
'保持屬性值的局部變量
'保持屬性值的局部變量
Private mvarN_Head10 As String '局部復制
Private mvarN_Head11 As String '局部復制
Private mvarN_Head2 As String '局部復制
'保持屬性值的局部變量
Private mvarGrid As Object '局部復制
Public Property Set N_Grid(ByVal vData As Object)
'向屬性指派對象時使用,位于 Set 語句的左邊。
'Syntax: Set x.Grid = Form1
Set mvarGrid = vData
End Property
Public Property Get N_Grid() As Object
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.Grid
Set N_Grid = mvarGrid
End Property
Public Property Let N_Head2(ByVal vData As String)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.N_Head2 = 5
mvarN_Head2 = vData
End Property
Public Property Get N_Head2() As String
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.N_Head2
N_Head2 = mvarN_Head2
End Property
Public Property Let N_Head11(ByVal vData As String)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.N_Head11 = 5
mvarN_Head11 = vData
End Property
Public Property Get N_Head11() As String
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.N_Head11
N_Head11 = mvarN_Head11
End Property
Public Property Let N_Head10(ByVal vData As String)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.N_Head10 = 5
mvarN_Head10 = vData
End Property
Public Property Get N_Head10() As String
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.N_Head10
N_Head10 = mvarN_Head10
End Property
Public Property Let SetChange(ByVal vData As Boolean)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.SetChange = 5
ChangeX = vData
End Property
Public Property Get SetChange() As Boolean
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.SetChange
SetChange = ChangeX
End Property
Public Sub ShowConfig()
End Sub
Public Property Let N_Cols(ByVal vData As String)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_Cols = 5
mvarNew_Cols = vData
End Property
Public Property Get N_Cols() As String
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_Cols
N_Cols = mvarNew_Cols
End Property
Public Property Let N_PageTop(ByVal vData As Integer)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_PageTop = 5
mvarNew_PageTop = vData
End Property
Public Property Get N_PageTop() As Integer
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_PageTop
N_PageTop = mvarNew_PageTop
End Property
Public Property Let N_PageLeft(ByVal vData As Integer)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_PageLeft = 5
mvarNew_PageLeft = vData
End Property
Public Property Get N_PageLeft() As Integer
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_PageLeft
N_PageLeft = mvarNew_PageLeft
End Property
Public Property Let N_Border(ByVal vData As Integer)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_Border = 5
mvarNew_Border = vData
End Property
Public Property Get N_Border() As Integer
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_Border
N_Border = mvarNew_Border
End Property
Public Property Let N_RowHeight(ByVal vData As Integer)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_RowHeight = 5
mvarNew_RowHeight = vData
End Property
Public Property Get N_RowHeight() As Integer
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_RowHeight
N_RowHeight = mvarNew_RowHeight
End Property
Public Property Let N_PageHeight(ByVal vData As Long)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_PageHeight = 5
mvarNew_PageHeight = vData
End Property
Public Property Get N_PageHeight() As Long
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_PageHeight
N_PageHeight = mvarNew_PageHeight
End Property
Public Property Let N_PageWidth(ByVal vData As Long)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_PageWidth = 5
mvarNew_PageWidth = vData
End Property
Public Property Get N_PageWidth() As Long
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_PageWidth
N_PageWidth = mvarNew_PageWidth
End Property
Public Property Let N_PageSize(ByVal vData As Integer)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_PageSize = 5
mvarNew_PageSize = vData
End Property
Public Property Get N_PageSize() As Integer
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_PageSize
N_PageSize = mvarNew_PageSize
End Property
Public Property Let N_TiTle(ByVal vData As String)
'向屬性指派值時使用,位于賦值語句的左邊。
'Syntax: X.New_TiTle = 5
mvarNew_TiTle = vData
End Property
Public Property Get N_TiTle() As String
'檢索屬性值時使用,位于賦值語句的右邊。
'Syntax: Debug.Print X.New_TiTle
N_TiTle = mvarNew_TiTle
End Property
Public Sub PrintPage()
On Error Resume Next
Dim MyPage As PageSetting
MyPage.sngPageHeight = mvarNew_PageHeight - mvarNew_PageTop
MyPage.sngPageLeft = mvarNew_PageLeft
MyPage.sngPageTop = mvarNew_PageTop
MyPage.sngPageWidth = mvarNew_PageWidth - mvarNew_PageLeft - 18
Dim strHead1 As String
Dim strHead2 As String
Dim strHead3 As String
Dim Grid As MSFlexGrid
Dim GridCols As String
Dim RowsHeight As Single
Dim LineWidth As Integer
Dim strTitle As String
strTitle = N_TiTle
strHead1 = N_Head10
strHead2 = N_Head11
strHead3 = N_Head2
Set Grid = N_Grid
GridCols = N_Cols
RowsHeight = N_RowHeight
Const HeadHeight = 6
Printer.ScaleMode = 6
PageLeft = MyPage.sngPageLeft
PageTop = MyPage.sngPageTop
Dim AllPages As Long '總頁數
Dim RowsPerPage As Long '每頁表格行的數量
Dim PerPages As Long '每頁的循環變量
Const GridLeft = 0
Const GridTop = 15 + HeadHeight * 2
RowsPerPage = Int((MyPage.sngPageHeight - GridTop - RowsHeight - 35) / RowsHeight) '計算每頁的表格行數不包括列頭
'去掉多余的空行
Dim sngGridRow As Long, sGridRow As Long
sngGridRow = 1: sGridRow = 1
For sngGridRow = 1 To Grid.Rows - 1
If Grid.TextMatrix(sngGridRow, 1) = "" Then Exit For
sGridRow = sngGridRow
Next
sGridRow = sGridRow + 2 '包括合計項目一起帶入
AllPages = Int((sGridRow + 0.1) / RowsPerPage) + 1
'--計算列寬
Dim lngScaleWidth As Long '表格總寬 計算比例時用
Dim Mycols() As String '存儲要打印的列的一維數組
Mycols = Split(GridCols, ",")
Dim MyColX(20) As Single '每一列左右坐標,第0列是mycolx(0)-mycolx(1)
MyColX(0) = 0
For i = 0 To UBound(Mycols) '獲取每個需要打印的列寬
lngScaleWidth = lngScaleWidth + Grid.ColWidth(Mycols(i))
MyColX(i + 1) = lngScaleWidth
Next i
LineWidth = N_Border
For PerPages = 1 To AllPages '每頁循環
'--計算標題的左邊
Dim titleLonger As Long '-標題共長多少字節
Dim titleLeft As Single
titleLonger = LenB(strTitle)
titleLeft = (MyPage.sngPageWidth - titleLonger * 4) / 2
'--打印標題
printCellOut 0, 0, 0, 0, 0, titleLeft, 0, strTitle, "宋體", 16, False
'--打印頭1
printCellOut 0, 0, 0, 0, 0, 0, 15, strHead1, "", 9, False
'--打印頭2
printCellOut 0, 0, 0, 0, 0, 0, 15 + HeadHeight, strHead3, "", 9, False
'--計算右對齊的左邊
Dim HeadLeft3 As Single
HeadLeft3 = MyPage.sngPageWidth - (LenB(strHead2) * 2)
'--打印頭3
printCellOut 0, 0, 0, 0, 0, HeadLeft3, 15 + HeadHeight, strHead2, "", 9, False
'--打印表格(0,28)
Dim NowCol, NowRow As Long
'-打印列頭
NowRow = 0
For NowCol = 0 To UBound(Mycols) '一共有幾列
printCellOut GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * NowRow, _
GridLeft + ((MyColX(NowCol + 1) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * (NowRow + 1), _
LineWidth, GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth) + 1, GridTop + RowsHeight * NowRow + 1, _
Grid.TextMatrix(NowRow, Mycols(NowCol)), "宋體", 9, False
Next NowCol
'-打印表格主體
For NowRow = 1 To RowsPerPage
If Not (NowRow + (PerPages - 1) * RowsPerPage) > sGridRow Then
Grid.Row = NowRow
'如果刪除線為真時
If Grid.CellFontStrikeThrough = True Then
For NowCol = 0 To UBound(Mycols) '所有列
printCellOut GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * NowRow, _
GridLeft + ((MyColX(NowCol + 1) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * (NowRow + 1), _
LineWidth, GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth) + 1, GridTop + RowsHeight * NowRow + 1, _
Grid.TextMatrix(NowRow + (PerPages - 1) * RowsPerPage, Mycols(NowCol)), "宋體", 9, True
Next NowCol
Else
For NowCol = 0 To UBound(Mycols) '所有列
printCellOut GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * NowRow, _
GridLeft + ((MyColX(NowCol + 1) / lngScaleWidth) * MyPage.sngPageWidth), GridTop + RowsHeight * (NowRow + 1), _
LineWidth, GridLeft + ((MyColX(NowCol) / lngScaleWidth) * MyPage.sngPageWidth) + 1, GridTop + RowsHeight * NowRow + 1, _
Grid.TextMatrix(NowRow + (PerPages - 1) * RowsPerPage, Mycols(NowCol)), "宋體", 9, False
Next NowCol
End If
End If
Next NowRow
'打印頁碼
printCellOut 0, 0, 0, 0, 0, (MyPage.sngPageWidth - 12) / 2, GridTop + RowsHeight * (NowRow + 1) + 2, "第" + CStr(PerPages) + "頁", "", 9, False
Printer.EndDoc
Next PerPages
Exit Sub
Print_Err:
MsgBox "對不起,打印發生錯誤,請與供應商聯系。 ", vbInformation
Exit Sub
End Sub
Private Sub PrintCell(prnCell As Cell)
'On Error GoTo err1
Printer.ScaleMode = 6
If Not prnCell.LineWidth = 0 Then
Printer.DrawWidth = prnCell.LineWidth
End If
If Not Printer.FillColor = 0 Then
Printer.Line (prnCell.x1, prnCell.y1)-(prnCell.x2, prnCell.y2), , BF
Else
Printer.FillStyle = 1
Printer.Line (prnCell.x1, prnCell.y1)-(prnCell.x2, prnCell.y2), , B
End If
If prnCell.str.strfont = "" Then
prnCell.str.strfont = "宋體"
End If
Printer.Font = prnCell.str.strfont
If prnCell.str.strsize = 0 Then
prnCell.str.strsize = 12
End If
Printer.FontSize = prnCell.str.strsize
Printer.FontStrikethru = prnCell.str.bStrickThought
Printer.CurrentX = prnCell.str.X
Printer.CurrentY = prnCell.str.Y
Printer.Print prnCell.str.caption
Exit Sub
'err1:
' MsgBox Err.Description
End Sub
Private Sub printCellOut(x1 As Single, y1 As Single, x2 As Single, y2 As Single _
, LineWidth As Integer, _
strx As Single, stry As Single, _
strcaption As String, strfont As String, _
strsize As Integer, bThought As Boolean)
Dim printWords As Cell
printWords.x1 = x1 + PageLeft
printWords.y1 = y1 + PageTop
printWords.x2 = x2 + PageLeft
printWords.y2 = y2 + PageTop
printWords.LineWidth = LineWidth
printWords.str.X = strx + PageLeft
printWords.str.Y = stry + PageTop
printWords.str.caption = strcaption
printWords.str.strfont = strfont
printWords.str.strsize = strsize
printWords.str.bStrickThought = bThought
If printWords.x2 < 0 Then
printWords.x2 = 0
End If
If printWords.x1 < 0 Then
printWords.x1 = 0
End If
If printWords.y1 < 0 Then
printWords.y1 = 0
End If
If printWords.y2 < 0 Then
printWords.y2 = 0
End If
If printWords.str.X < 0 Then
printWords.str.X = 0
End If
If printWords.str.Y < 0 Then
printWords.str.Y = 0
End If
PrintCell printWords
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -