frmreport.frm
来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· FRM 代码 · 共 348 行
FRM
348 行
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form FrmReport
Caption = "System Report Manager"
ClientHeight = 6750
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
ClipControls = 0 'False
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "FrmReport.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 6750
ScaleWidth = 11880
ShowInTaskbar = 0 'False
Begin VB.FileListBox FileName
Height = 330
Left = 3600
TabIndex = 8
Top = 120
Visible = 0 'False
Width = 855
End
Begin VB.CommandButton Command1
Caption = "Delete(&D)"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7440
TabIndex = 6
Top = 240
Width = 1335
End
Begin RichTextLib.RichTextBox ReportTextFunc
Height = 5895
Left = 2760
TabIndex = 5
Top = 840
Width = 8655
_ExtentX = 15266
_ExtentY = 10398
_Version = 393217
Enabled = -1 'True
HideSelection = 0 'False
ScrollBars = 3
AutoVerbMenu = -1 'True
FileName = "C:\电梯控制系统1003\FuncTestFile.txt"
TextRTF = $"FrmReport.frx":0442
End
Begin RichTextLib.RichTextBox ReportTextWire
Height = 5535
Left = 2760
TabIndex = 4
Top = 1320
Visible = 0 'False
Width = 8655
_ExtentX = 15266
_ExtentY = 9763
_Version = 393217
Enabled = -1 'True
AutoVerbMenu = -1 'True
FileName = "C:\电梯控制系统1003\WireTestFile.txt"
TextRTF = $"FrmReport.frx":06CA
End
Begin VB.CommandButton SaveAsCmd
Caption = "Save (&S)"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 3
Top = 240
Width = 1335
End
Begin VB.CommandButton CreateCmd
Caption = "Create(&C)"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 2
Top = 240
Width = 1335
End
Begin VB.CommandButton PrintCmd
Caption = "Print(&P)"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8760
TabIndex = 1
Top = 240
Width = 1335
End
Begin VB.CommandButton ExitCmd
Caption = "Exit(&X)"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 10080
TabIndex = 0
Top = 240
Width = 1335
End
Begin MSComctlLib.ListView FileList
Height = 5895
Left = 0
TabIndex = 7
Top = 840
Width = 2775
_ExtentX = 4895
_ExtentY = 10398
View = 3
Arrange = 1
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "File Name"
Object.Width = 4304
EndProperty
End
Begin VB.Label Label1
Caption = "Select Project Report:"
BeginProperty Font
Name = "Arial"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 9
Top = 120
Width = 3135
End
End
Attribute VB_Name = "FrmReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Sub FileList_Refresh()
Dim i As Integer
Dim TempItem
FileList.ListItems.Clear
If FileName.ListCount > 0 Then
For i = FileName.ListCount - 1 To 0 Step -1
Set TempItem = FileList.ListItems.Add()
TempItem.Text = FileName.List(i)
Next i
End If
End Sub
Private Sub Command1_Click()
On Error GoTo Err
FillComp = False
FillSucc = False
SetWindowPos FrmLogin.hwnd, HWND_TOPMOST, 200, 100, 480, 190, SWP_SHOWWINDOW
Do Until FillComp
DoEvents
Loop
If Not FillSucc Then
Exit Sub
End If
Kill App.Path & "\resultfiles\" & FileList.SelectedItem.Text
FileName.Refresh
FileList_Refresh
Exit Sub
Err:
MsgBox Error$
End Sub
Private Sub CreateCmd_Click()
On Error GoTo CreateErr
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.copyfile App.Path & "\resultfiles\" & FileList.SelectedItem.Text, App.Path & "\resultfiles\" & FileList.SelectedItem.Text & ".txt"
ReportTextFunc.Text = ""
ReportTextFunc.LoadFile App.Path & "\resultfiles\" & FileList.SelectedItem.Text & ".txt", rtfText
ReportTextFunc.Refresh
fso.deletefile App.Path & "\resultfiles\" & FileList.SelectedItem.Text & ".txt"
Exit Sub
CreateErr:
MsgBox "You have to make a test before. No report can be set up."
End Sub
Private Sub ExitCmd_Click()
On Error Resume Next
Dim fso, style
Dim response
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo LoadErr
Me.left = GetSetting(App.title, "Settings", "MainLeft", 100)
Me.top = GetSetting(App.title, "Settings", "MainTop", 100)
Me.Width = GetSetting(App.title, "Settings", "MainWidth", 12000)
Me.Height = GetSetting(App.title, "Settings", "MainHeight", 9000)
ReportTextFunc.Text = ""
ReportTextWire.Text = ""
Screen.MousePointer = 0
FileName.Path = App.Path & "\resultfiles"
FileList_Refresh
Exit Sub
LoadErr:
MsgBox Err.Description, vbExclamation
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
ReportTextFunc.Move ReportTextFunc.left, ReportTextFunc.top, Me.Width - 2900, Me.Height - ReportTextFunc.top - 400
ReportTextWire.Move ReportTextWire.left, ReportTextWire.top, Me.Width - 2900, Me.Height - ReportTextWire.top - 400
FileList.Move FileList.left, FileList.top, FileList.Width, ReportTextFunc.Height
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.title, "Settings", "MainLeft", Me.left
SaveSetting App.title, "Settings", "MainTop", Me.top
SaveSetting App.title, "Settings", "MainWidth", Me.Width
SaveSetting App.title, "Settings", "MainHeight", Me.Height
End If
End Sub
Private Sub PrintCmd_Click()
On Error GoTo Err
If ReportTextFunc.Visible = True Then
ReportTextFunc.SelLength = 0
ReportTextFunc.SelPrint Printer.hDC
End If
If ReportTextWire.Visible = True Then
ReportTextFunc.SelLength = 0
ReportTextFunc.SelPrint Printer.hDC
End If
Exit Sub
Err:
MsgBox "Not find printer."
End Sub
Private Sub SaveAsCmd_Click()
On Error GoTo SaveErr
Dim fso
Dim TempPath As String
FillComp = False
FillSucc = False
SetWindowPos FrmLogin.hwnd, HWND_TOPMOST, 200, 100, 480, 190, SWP_SHOWWINDOW
Do Until FillComp
DoEvents
Loop
If Not FillSucc Then
Exit Sub
End If
TempPath = GetFromINI("netpath", "path", App.Path & "\ini\missys.ini")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.copyfile App.Path & "\resultfiles\" & FileList.SelectedItem.Text, App.Path & "\BackFiles\"
On Error Resume Next
Err.Clear
fso.copyfile App.Path & "\resultfiles\" & FileList.SelectedItem.Text, TempPath
If Err.Number = 76 Then
MsgBox "Not found net path.", vbExclamation + vbOKOnly
End If
Exit Sub
SaveErr:
MsgBox Error$
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?