📄 frmbiao.frm
字号:
.Col = 8
MyFeeset.Close
MyFeeSet1.Close
MYSET.MoveNext
Loop
' For i = 0 To 9
' .ColWidth(i) = 1000
' Next
MYSET.Close
'Text2.Text = Format(sTotalFee_D + sTotalFee_Water, "0.0")
.ColWidth(8) = 1000
End With
Case 1 '打印
On Error Resume Next
'On Error GoTo ErrHandler
dlgCommonDialog.CancelError = True
dlgCommonDialog.ShowPrinter
If Err.Number = 32755 Then Exit Sub
Printer.ScaleMode = vbMillimeters '设置度量单位为毫米
Printer.ColorMode = vbPRCMColor '设置打印机为单色打印输出
print_H = Printer.Height / 56.7
print_W = Printer.Width / 56.7
' Printer.Orientation = vbPRORPortrait '设置横向打印
' Printer.PrintQuality = vbPRPQHigh '设置打印质量为低分辨率
Printer.DrawWidth = 1
dlgCommonDialog.Copies = 1
' dlgCommonDialog.Min = 1
' dlgCommonDialog.Max = 1
' dlgCommonDialog.FromPage = 1
' dlgCommonDialog.ToPage = 1
'CY = 30
With mfgFee
Dim dh As Long, DS As String
'打印标题
Printer.FontSize = 15
Printer.CurrentX = (print_W - TextWidth(Trim(Me.lblTitle.Caption)) / 56.7) / 2 - 30
Printer.CurrentY = 10
dh = 5 + TextHeight(lblTitle.Caption) / 56.7
Printer.Print lblTitle.Caption
Printer.FontSize = 10
'打印当前日期
DS = "制表日期:" & STR(Year(Now)) & "年" & STR(Month(Now)) & "月" & STR(Day(Now)) & "日"
Printer.CurrentX = print_W - TextWidth(DS) / 56.7 - 40
Printer.CurrentY = dh
Printer.Print DS
dh = dh + TextHeight(DS) / 56.7 + 8
'调用打印表格的子程序,打印表格内容
Printer.DrawStyle = 0
Print_Grid mfgFee, dh
'打印到文件结尾
Printer.EndDoc
End With
Case 2 '退出
Unload Me
Case 3 '预览
Picture1.Cls
Picture1.Visible = True
Picture2.Visible = True
HScroll1.Visible = True
VScroll1.Visible = True
' Picture2.ZOrder 0
' Picture1.ZOrder 0
Picture1.ScaleMode = vbMillimeters
Picture1.Height = 297 * 56.7
Picture1.Width = 210 * 56.7
CY = 30
With mfgFee
.row = 0
For u = 1 To .Rows
For I = 0 To 2
CY = I * 90 - 20
Picture1.FontSize = 16
Picture1.CurrentX = 50
Picture1.CurrentY = 25 + CY
' PICTURE1.Print RTU(0).RTUName & "费用结算单"
Picture1.Line (23, 48 + CY)-(160, 80 + CY), 0, B
Picture1.Line (23, 56 + CY)-(160, 56 + CY), 0, B
Picture1.Line (23, 64 + CY)-(160, 64 + CY), 0, B
Picture1.Line (23, 72 + CY)-(160, 72 + CY), 0, B
Picture1.Line (40, 48 + CY)-(40, 80 + CY), 0, B
Picture1.Line (61, 48 + CY)-(61, 80 + CY), 0, B
Picture1.Line (82, 48 + CY)-(82, 72 + CY), 0, B
Picture1.Line (103, 48 + CY)-(103, 72 + CY), 0, B
Picture1.Line (125, 48 + CY)-(125, 72 + CY), 0, B
Picture1.Line (139, 48 + CY)-(139, 72 + CY), 0, B
Picture1.FontSize = 12
Picture1.CurrentX = 43
Picture1.CurrentY = 50 + CY
Picture1.Print "上月表底"
Picture1.CurrentX = 64
Picture1.CurrentY = 50 + CY
Picture1.Print "本月表底"
Picture1.CurrentX = 85
Picture1.CurrentY = 50 + CY
' PICTURE1.Print "倍率"
Picture1.Print "换表度差"
Picture1.CurrentX = 106
Picture1.CurrentY = 50 + CY
Picture1.Print "使用量"
Picture1.CurrentX = 127
Picture1.CurrentY = 50 + CY
Picture1.Print "单 价"
Picture1.CurrentX = 143
Picture1.CurrentY = 50 + CY
Picture1.Print "金 额"
.row = .row + 1
.Col = 0
Picture1.CurrentX = 28
Picture1.CurrentY = 38 + CY
' PICTURE1.Print "户号: " & cboPrecinct.Text & .Text
.Col = 1
Picture1.CurrentX = 70
Picture1.CurrentY = 38 + CY
Picture1.Print "户名: "; .Text
Picture1.CurrentX = 125
Picture1.CurrentY = 38 + CY
Picture1.Print Year(Now) & " 年 " & Month(Now) & " 月"
Picture1.CurrentX = 25
Picture1.CurrentY = 59 + CY
Picture1.Print "电表"
'上月表底
.Col = 4
Picture1.CurrentX = 43
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
'本月表底
.Col = 5
Picture1.CurrentX = 63
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
'换表度差
.Col = 6
Picture1.CurrentX = 90
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
'电量
.Col = 7
Picture1.CurrentX = 108
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
.Col = 8
Picture1.CurrentX = 128
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
.Col = 9
Picture1.CurrentX = 143
Picture1.CurrentY = 59 + CY
Picture1.Print .Text
Picture1.CurrentX = 25
Picture1.CurrentY = 67 + CY
Picture1.Print "水表"
.Col = 10
Picture1.CurrentX = 43
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 11
Picture1.CurrentX = 63
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 12
Picture1.CurrentX = 90
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 13
Picture1.CurrentX = 108
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 14
Picture1.CurrentX = 128
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 15
Picture1.CurrentX = 143
Picture1.CurrentY = 67 + CY
Picture1.Print .Text
.Col = 16
Picture1.CurrentX = 25
Picture1.CurrentY = 75 + CY
Picture1.Print "合计"
Picture1.CurrentX = 48
Picture1.CurrentY = 75 + CY
Picture1.Print .Text
sTotalFee = .Text
Picture1.CurrentX = 70
Picture1.CurrentY = 75 + CY
Picture1.Print "人民币大写：" & test(CStr(Format(sTotalFee, "#0.00") * 100), 1)
Picture1.CurrentX = 23
Picture1.CurrentY = 84 + CY
'PICTURE1.Print "收款员:" & GetInitStr$("Setup", "Coll")
Next
If .row = .Rows - 1 Then Exit For
Next
End With
End Select
Exit Sub
ErrHandler:
MsgBox "error"
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Form_Load()
Fillcomb cmbElement, "select * from louhao order by bmid", "bmname"
cmbElement.ListIndex = -1
'Combo1.ListIndex = 0
dtpStart = DateSerial(Year(Now), Month(Now), 1)
'DTPicker1 = DateSerial(Year(Now), Month(Now), 1)
lblTitle.Caption = ""
mfgFee.Clear
'AddCombo1 cboPrecinct, "select * from bmPowerElement where type='所'"
Picture1.Visible = False
Picture2.Visible = False
HScroll1.Visible = False
VScroll1.Visible = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
With mfgFee
.Top = 2800
.Left = 60
.Height = Me.Height - 3800
.Width = Me.Width - 260
lblTitle.Left = .Left
lblTitle.Width = .Width
Picture2.Left = .Left
Picture2.Width = .Width - 280
Picture2.Height = .Height - 280
Picture2.Top = .Top
Picture1.Left = 0
Picture1.Width = 210 * 56.7
Picture1.Height = 297 * 56.7
Picture1.Top = 0
VScroll1.Top = .Top
VScroll1.Width = 280
VScroll1.Height = .Height
VScroll1.Left = 60 + .Width - 280
HScroll1.Left = .Left
HScroll1.Width = .Width - 280
HScroll1.Height = 280
HScroll1.Top = 1200 + .Height - 280
End With
Command1(0).Top = 2900 + mfgFee.Height
Command1(1).Top = Command1(0).Top
Command1(2).Top = Command1(0).Top
Command1(3).Top = Command1(0).Top
End Sub
Private Sub HScroll1_Scroll()
'If bFlag = False Then Exit Sub
If Picture1.Left <= (Me.Width - Picture2.Width) / 2 Then
Picture1.Left = -(HScroll1 / 100) * (Me.Width - Picture2.Width) / 2 - 400
Else
Picture1.Left = (Me.Width - Picture2.Width) / 2
End If
End Sub
Private Sub VScroll1_Change()
'If bFlag = False Then Exit Sub
If Picture1.Top <= Me.Height - Picture2.Height Then
Picture1.Top = -(VScroll1 / 100) * Me.Height + 400
Else
Picture1.Top = Me.Height - Picture2.Height
End If
End Sub
Private Sub hScroll1_Change()
'If bFlag = False Then Exit Sub
If Picture1.Left <= (Me.Width - Picture2.Width) / 2 Then
Picture1.Left = -(HScroll1 / 100) * (Me.Width - Picture2.Width) / 2 - 400
Else
Picture1.Left = (Me.Width - Picture2.Width) / 2
End If
End Sub
Private Sub VScroll1_Scroll()
'If bFlag = False Then Exit Sub
If Picture1.Top <= Me.Height - Picture2.Height Then
Picture1.Top = -(VScroll1 / 100) * Me.Height + 600
Else
Picture1.Top = Me.Height - Picture2.Height
End If
End Sub
'打印Grid对象的子程序,只要给出表格的名称和起始的X,Y坐标,即可完成操作
Sub Print_Grid(gd As Control, CY0 As Long)
On Error Resume Next
Dim I As Integer, j As Integer
Dim CX0 As Single
'Printer.ScaleMode = 3
Printer.FontSize = 10
With gd
For I = 0 To .Rows - 1
.row = I
CX0 = 10
For j = 0 To .Cols
.Col = j
'打印表格线
Printer.Line (CX0, CY0)-(CX0 + .ColWidth(j) / 56.7 + 3, _
CY0 + TextHeight("d") / 56.7 * 1.6), 0, B
'设置表格内文字的位置
If .row = 0 Then
Printer.CurrentX = CX0 + (.ColWidth(j) / 56.7 - TextWidth(.Text) / 56.7) / 2 + 1.5
ElseIf .ColAlignment(j) = 7 Then
Printer.CurrentX = CX0 + (.ColWidth(j) / 56.7 + 3 - TextWidth(.Text) / 56.7) - 3
Else
Printer.CurrentX = CX0 + 1.5
End If
Printer.CurrentY = CY0 + 1
'打印文字
Printer.Print .Text
'计算下一列表格的起始横坐标位置
CX0 = CX0 + .ColWidth(j) / 56.7 + 3
Next j
'计算下一行表格的起始纵坐标位置
If CY0 >= print_H - 30 Then
Printer.NewPage
CY0 = 30
Else
CY0 = CY0 + TextHeight("d") / 56.7 * 1.6
End If
Next I
End With
End Sub
Function fPrintText(sTitle As String, CX As Single, CY As Single, _
iFontSize As Integer, bBold As Boolean)
P.Font.Bold = bBold
P.FontSize = iFontSize
P.CurrentX = CX
P.CurrentY = CY
P.Print sTitle
End Function
Function fillfee(str1 As Integer) As Single
Dim MYSET As New ADODB.Recordset
Dim strsql As String
strsql = "select * from fee where userid1=" & str1
MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If Not MYSET.EOF Then
fillfee = MYSET("fee")
End If
MYSET.Close
Set MYSET = Nothing
End Function
Function fillfee1(str1 As Integer) As Single
Dim MYSET As New ADODB.Recordset
Dim strsql As String
strsql = "select * from userfee where userid1=" & str1 & "and clloyear=" & dtpStart.Year & "and cllomonth=" & dtpStart.Month
MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If Not MYSET.EOF Then
fillfee1 = MYSET("fee")
Else
fillfee1 = 0
End If
MYSET.Close
Set MYSET = Nothing
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -