📄 frmprint.frm
字号:
VERSION 5.00
Object = "{A8561640-E93C-11D3-AC3B-CE6078F7B616}#1.0#0"; "VSPRINT7.ocx"
Begin VB.Form frmPrint
Caption = "巡检报告"
ClientHeight = 6345
ClientLeft = 60
ClientTop = 450
ClientWidth = 8400
Icon = "frmPrint.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6345
ScaleWidth = 8400
StartUpPosition = 3 '窗口缺省
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 6375
Left = 30
TabIndex = 1
Top = -60
Width = 2895
Begin VB.CommandButton Command1
Caption = "退出(&E)"
Height = 375
Left = 570
TabIndex = 5
Top = 5910
Width = 1335
End
Begin VB.ListBox List1
Height = 5280
Left = 60
TabIndex = 4
Top = 540
Width = 2745
End
Begin VB.ComboBox Combo1
Height = 300
Left = 990
Style = 2 'Dropdown List
TabIndex = 2
Top = 210
Width = 1815
End
Begin VB.Label Label1
Caption = "GPS终端号:"
Height = 255
Left = 90
TabIndex = 3
Top = 270
Width = 915
End
End
Begin VSPrinter7LibCtl.VSPrinter VP
Height = 5835
Left = 2970
TabIndex = 0
Top = 0
Width = 5475
_cx = 9657
_cy = 10292
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
MousePointer = 0
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty HdrFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Courier New"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_ConvInfo = 1
AutoRTF = -1 'True
Preview = -1 'True
DefaultDevice = 0 'False
PhysicalPage = -1 'True
AbortWindow = -1 'True
AbortWindowPos = 0
AbortCaption = "Printing..."
AbortTextButton = "Cancel"
AbortTextDevice = "on the %s on %s"
AbortTextPage = "Now printing Page %d of"
FileName = ""
MarginLeft = 1440
MarginTop = 1440
MarginRight = 1440
MarginBottom = 1440
MarginHeader = 0
MarginFooter = 0
IndentLeft = 0
IndentRight = 0
IndentFirst = 0
IndentTab = 720
SpaceBefore = 0
SpaceAfter = 0
LineSpacing = 100
Columns = 1
ColumnSpacing = 180
ShowGuides = 2
LargeChangeHorz = 300
LargeChangeVert = 300
SmallChangeHorz = 30
SmallChangeVert = 30
Track = 0 'False
ProportionalBars= -1 'True
Zoom = 32.8753680078508
ZoomMode = 3
ZoomMax = 400
ZoomMin = 10
ZoomStep = 25
EmptyColor = -2147483636
TextColor = 0
HdrColor = 0
BrushColor = 0
BrushStyle = 0
PenColor = 0
PenStyle = 0
PenWidth = 0
PageBorder = 0
Header = ""
Footer = ""
TableSep = "|;"
TableBorder = 7
TablePen = 0
TablePenLR = 0
TablePenTB = 0
NavBar = 3
NavBarColor = -2147483633
ExportFormat = 0
URL = ""
Navigation = 3
NavBarMenuText = "Whole &Page|Page &Width|&Two Pages|Thumb&nail"
End
End
Attribute VB_Name = "frmPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim IsEmpty As Boolean
Dim RsReport As New ADODB.Recordset
Private Sub Combo1_Click()
'根据GPS终端号加载报告码
Dim pGpsID As String
pGpsID = Me.Combo1.Text
If pGpsID = "" Then Exit Sub
Load_ReportCode ByVal pGpsID
'报表置空
VP.Zoom = 100
VP.StartDoc
IsEmpty = True '空表
DrawReport ByVal IsEmpty, ByVal ""
VP.EndDoc
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
SetOriginalSettings ByVal VP
'VP.ZoomMode = zmWholePage
VP.Zoom = 100
VP.StartDoc
IsEmpty = True '空表
DrawReport ByVal IsEmpty, ByVal ""
VP.EndDoc
'加载
Load_GpsID
End Sub
Private Sub Form_Resize()
On Error Resume Next
VP.Move VP.Left, VP.Top, ScaleWidth - VP.Left, ScaleHeight - VP.Top
Frame1.Top = -30
Frame1.Left = 30
Frame1.Height = VP.Height
Frame1.Width = 2895
List1.Top = 550
List1.Left = 60
List1.Height = Frame1.Height - 1000
List1.Width = 2745
Command1.Top = List1.Top + List1.Height + 50
End Sub
'加载GPS终端号
Sub Load_GpsID()
Dim strSql As String
Set RsReport = Nothing
strSql = "select * from tbl_GPS order by GpsID asc"
RsReport.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until RsReport.EOF
Me.Combo1.AddItem RsReport("GpsID")
RsReport.MoveNext
Loop
RsReport.Close
If Me.Combo1.ListCount > 0 Then Me.Combo1.Text = Me.Combo1.List(0)
End Sub
'加载报告码
Sub Load_ReportCode(ByVal sGpsID As String)
Dim strSql As String
strSql = "select * from tbl_Gps_CheckReport where GpsID='" & sGpsID & "'"
With Me.List1
.Clear
Set RsReport = Nothing
RsReport.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until RsReport.EOF
.AddItem RsReport("ReportCode").Value
RsReport.MoveNext
Loop
RsReport.Close
End With
End Sub
'根据报告内容预览报表
Sub DrawReport(ByVal bIsEmpty As Boolean, ByVal pReportCode As String)
Dim I As Integer
Dim sGpsID As String, sStartTime As String, sEndTime As String
Dim sResultReport As String
Dim iRows As Integer, iCols As Integer
Dim strSql As String
' On Error Resume Next
' sGpsID = "0001"
' sStartTime = "2005-4-4 13:18:00"
' sEndTime = "2005-4-4 13:22:28"
' sResultReport = "当前GPS终端号(0001)要求巡检设备27个，共巡检通过10个，巡检率为 37.04%。"
If Not bIsEmpty Then
Set RsReport = Nothing
strSql = "select * from tbl_Gps_CheckReport where ReportCode='" & pReportCode & "'"
RsReport.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If RsReport.RecordCount > 0 Then
sGpsID = RsReport("GpsID")
sStartTime = RsReport("StartTime")
sEndTime = RsReport("EndTime")
sResultReport = RsReport("CheckResult")
Else
sGpsID = ""
sStartTime = ""
sEndTime = ""
sResultReport = ""
End If
RsReport.Close
Else
sGpsID = ""
sStartTime = ""
sEndTime = ""
sResultReport = ""
End If
With VP
.PaperSize = pprA4
.PageBorder = tbNone
.FontSize = 18
SetSubTitle "巡检报告表"
.FontSize = 10
'VP = ""
VP = "GPS终端号: " & sGpsID
VP = "开始时间: " & sStartTime
VP = "结束时间: " & sEndTime
VP = "巡检结果: " & sResultReport
.StartTable
.TablePen = 1
.TablePenTB = 50
.TablePenLR = 50
iCols = 6
.TableCell(tcCols) = iCols
.TableCell(tcColWidth, 1, 1) = "0.5in"
.TableCell(tcColWidth, 1, 2) = "0.8in"
.TableCell(tcColWidth, 1, 3) = "1.2in"
.TableCell(tcColWidth, 1, 4) = "1.2in"
.TableCell(tcColWidth, 1, 5) = "1.2in"
.TableCell(tcColWidth, 1, 6) = "1.7in"
.TableCell(tcRows) = 2
For I = 1 To iCols
.TableCell(tcAlign, 1, I) = taCenterBottom
.TableCell(tcFontBold, 1, I) = True
Next
.TableCell(tcText, 1, 1) = "序号"
.TableCell(tcText, 1, 2) = "设备号"
.TableCell(tcText, 1, 3) = "设备名称"
.TableCell(tcText, 1, 4) = "经度(Longitude)"
.TableCell(tcText, 1, 5) = "纬度(Latitude)"
.TableCell(tcText, 1, 6) = "巡检结果"
I = 0
If Not bIsEmpty Then
Set RsReport = Nothing
strSql = "select * from tbl_Gps_CheckReport_list where ReportCode='" & pReportCode & "'"
RsReport.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
iRows = RsReport.RecordCount + 1
.TableCell(tcRows) = iRows
For I = 1 To iRows
.TableCell(tcRowHeight, I) = "0.28in"
.TableCell(tcAlign, I, 1) = taCenterBottom
.TableCell(tcAlign, I, 2) = taCenterBottom
.TableCell(tcAlign, I, 3) = taCenterBottom
.TableCell(tcAlign, I, 4) = taCenterBottom
.TableCell(tcAlign, I, 5) = taCenterBottom
.TableCell(tcAlign, I, 6) = taCenterBottom
Next
I = 1
Do Until RsReport.EOF
I = I + 1
.TableCell(tcText, I, 1) = I - 1
.TableCell(tcText, I, 2) = RsReport("EquipmentID")
.TableCell(tcText, I, 3) = RsReport("Name")
.TableCell(tcText, I, 4) = RsReport("Center_X")
.TableCell(tcText, I, 5) = RsReport("Center_Y")
.TableCell(tcText, I, 6) = RsReport("State")
RsReport.MoveNext
Loop
RsReport.Close
Else
'空数据
iRows = 25
For I = 1 To iRows
.TableCell(tcRowHeight, I) = "0.28in"
Next
End If
.EndTable
VP = ""
VP = " 巡检员签字:" & "" & String(50, " ") & "制表日期: " & Format(Date, "YYYY-MM-DD")
'If Not IsEmpty Then
' VP = " 巡检员签字:" & "" & String(50, " ") & "制表日期: " & Format(Date, "YYYY-MM-DD")
'Else
' VP = " 巡检员签字:" & "" & String(60, " ") & "制表日期: " & Format(Date, "YYYY-MM-DD")
'End If
End With
End Sub
Sub SetSubTitle(s$)
VP.FontName = "宋体"
VP.IndentLeft = "2in"
'VP = ""
VP.FontBold = True
VP.FontSize = 24
VP.TextColor = vbBlack
VP = s
SetNormal
End Sub
Sub SetNormal()
With VP
.FontName = "宋体"
.FontBold = False
.FontItalic = False
.FontUnderline = False
.FontSize = 11
.TextColor = 0
.IndentLeft = 0
.SpaceAfter = 130
.PageBorder = pbTopBottom
.PenColor = vbBlack
.PenStyle = psSolid
.PenWidth = 0
.Header = ""
.Footer = ""
End With
End Sub
Private Sub List1_Click()
If List1.Text <> "" Then
VP.Zoom = 100
VP.StartDoc
DrawReport False, List1.Text
VP.EndDoc
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -