frmprojset.frm
来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· FRM 代码 · 共 1,019 行 · 第 1/2 页
FRM
1,019 行
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmProjSet
Caption = "Project setting"
ClientHeight = 7980
ClientLeft = 165
ClientTop = 450
ClientWidth = 8880
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "FrmProjSet.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
PaletteMode = 1 'UseZOrder
ScaleHeight = 7980
ScaleWidth = 8880
WindowState = 2 'Maximized
Begin VB.CheckBox Option1
Caption = "Check1"
Height = 255
Left = 9240
TabIndex = 18
Top = 900
Width = 255
End
Begin VB.TextBox FileName
Height = 375
Left = 9240
TabIndex = 14
Top = 1320
Width = 2415
End
Begin VB.FileListBox FileList
Height = 1290
Left = 6360
Pattern = "*.ini"
TabIndex = 13
Top = 1320
Width = 2655
End
Begin VB.CommandButton Command3
Caption = "Open"
Height = 375
Left = 9240
TabIndex = 10
Top = 1920
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Delete"
Height = 375
Left = 9240
TabIndex = 9
Top = 2280
Width = 1215
End
Begin MSComctlLib.ListView TempListView
Height = 495
Left = 5400
TabIndex = 8
Top = 2760
Visible = 0 'False
Width = 735
_ExtentX = 1296
_ExtentY = 873
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.CommandButton Command2
Caption = "Save"
Height = 375
Left = 10440
TabIndex = 7
Top = 1920
Width = 1335
End
Begin VB.CommandButton UpCmd
Height = 345
Left = 5640
Picture = "FrmProjSet.frx":030A
Style = 1 'Graphical
TabIndex = 6
Top = 6480
Width = 405
End
Begin VB.CommandButton DownCmd
Height = 345
Left = 5640
Picture = "FrmProjSet.frx":0458
Style = 1 'Graphical
TabIndex = 5
Top = 5760
Width = 405
End
Begin VB.CommandButton MoveItemCmd
Height = 345
Left = 5640
Picture = "FrmProjSet.frx":05A6
Style = 1 'Graphical
TabIndex = 4
Top = 4440
Width = 405
End
Begin VB.CommandButton AddItemCmd
Height = 345
Left = 5640
Picture = "FrmProjSet.frx":06A8
Style = 1 'Graphical
TabIndex = 3
Top = 3720
Width = 405
End
Begin VB.CommandButton ExitCmd
Caption = "Exit(&X)"
Height = 375
Left = 10440
TabIndex = 2
Top = 2280
Width = 1335
End
Begin MSComctlLib.ListView lvwDB
Height = 6375
Left = 120
TabIndex = 0
Top = 1320
Width = 5175
_ExtentX = 9128
_ExtentY = 11245
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Test Item"
Object.Width = 6174
EndProperty
End
Begin MSComctlLib.ListView PrjList
Height = 4935
Left = 6360
TabIndex = 1
Top = 2760
Width = 5295
_ExtentX = 9340
_ExtentY = 8705
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Test Item"
Object.Width = 6174
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 5160
Top = 6120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmProjSet.frx":07AA
Key = "item"
EndProperty
EndProperty
End
Begin VB.Label Label5
Caption = "Master"
Height = 375
Left = 9480
TabIndex = 17
Top = 900
Width = 2175
End
Begin VB.Label Label4
Caption = "Display all Exist projects."
Height = 375
Left = 6360
TabIndex = 16
Top = 960
Width = 2655
End
Begin VB.Label Label3
Caption = "Project Name:"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6360
TabIndex = 15
Top = 480
Width = 2655
End
Begin VB.Label Label2
Caption = "Select trip which you want to test."
Height = 375
Left = 120
TabIndex = 12
Top = 960
Width = 5175
End
Begin VB.Label Label1
Caption = "Test trip:"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 11
Top = 480
Width = 5055
End
End
Attribute VB_Name = "FrmProjSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private MsgNum As Integer
Function BolGetFromINI(SectionHeader$, VarName$, FileName$) As Boolean
On Error GoTo Err
Dim RetString As String, TempStr As String
RetString = String(255, Chr(0))
'Get Requested Information
TempStr = left(RetString, GetPrivateProfileString(SectionHeader$, ByVal VarName$, "", RetString, Len(RetString), FileName$))
If TempStr <> "" Then
BolGetFromINI = True
Else
BolGetFromINI = False
End If
Exit Function
Err:
BolGetFromINI = False
End Function
Sub AddAllItem()
Dim StrSql As String, NowNodeKey As String
Dim TempItem As ListItem
' On Error GoTo GetErr
lvwDB.ListItems.Clear
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Installation Trip"
TempItem.Key = "keyInsT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Learning Trip"
TempItem.Key = "key2LrnT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Inspection Trip"
TempItem.Key = "keyIspT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Synchronization Trip"
TempItem.Key = "keySynT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Normal Trip"
TempItem.Key = "keyNorT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Automatic car light and fan"
TempItem.Key = "keyAutoT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Fire service"
TempItem.Key = "keyFireT"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "JABTrip"
TempItem.Key = "keyJAB"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Parameter"
TempItem.Key = "keyPara"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "MOhm meter"
TempItem.Key = "keyFunInfo"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Measure Voltage"
TempItem.Key = "keyFunInfo1"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Visual Inspection"
TempItem.Key = "keyFunInfo2"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "PowerOn"
TempItem.Key = "keyPowerOn"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "PowerOff"
TempItem.Key = "keyPowerOff"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "Message"
TempItem.Key = "keyMsg"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "OverLoad"
TempItem.Key = "keyoverload"
Set TempItem = lvwDB.ListItems.Add()
TempItem.SmallIcon = "item"
TempItem.Text = "EatherQuaker"
TempItem.Key = "keyeatherquaker"
Exit Sub
GetErr:
MsgBox Err.Description, vbExclamation
End Sub
Sub AddMeItem()
Dim StrSql As String, NowNodeKey As String
Dim TempItem As ListItem, Trec As Recordset
On Error GoTo GetErr
StrSql = "select itemset.*,testitemdetail.runnum from itemset,testitemdetail "
StrSql = StrSql + " where itemset.itemcode=testitemdetail.testitemcode and testitemdetail.itemcode='" & Trim$(PrjCodeCombo) & "' "
StrSql = StrSql + " order by testitemdetail.runnum "
Set Trec = SetDb.OpenRecordset(StrSql, dbOpenSnapshot, dbReadOnly)
PrjList.ListItems.Clear
If Trec.EOF Then
Trec.Close
Set Trec = Nothing
Exit Sub
End If
PrjList.ListItems.Clear
Do Until Trec.EOF
'添加 ListItem。
Set TempItem = PrjList.ListItems.Add()
If Not IsNull(Trec!itemdesc) Then
TempItem.Text = Trec!itemdesc
End If
TempItem.SmallIcon = "item"
TempItem.Key = "KEY" & Trim$(Trec!itemcode)
TempItem.SubItems(1) = Trim$(Trec!itemcode)
If Not IsNull(Trec!sendorread) Then
TempItem.SubItems(2) = _
Trim$(Trec!sendorread)
End If
If Not IsNull(Trec!timeinterval) Then
TempItem.SubItems(3) = _
Trec!timeinterval
End If
If Not IsNull(Trec!intertimeinterval) Then
TempItem.SubItems(4) = Trec!intertimeinterval
End If
If Not IsNull(Trec!signpos) Then
TempItem.SubItems(5) = _
Trec!signpos
End If
If Not IsNull(Trec!signlength) Then
TempItem.SubItems(6) = _
Trim$(Trec!signlength)
End If
If Not IsNull(Trec!okvalue) Then
TempItem.SubItems(7) = _
Trim$(Trec!okvalue)
End If
If Not IsNull(Trec!FunctionCode) Then
TempItem.SubItems(8) = _
Trim$(Trec!FunctionCode)
End If
Trec.MoveNext
Loop
Trec.Close
Set Trec = Nothing
Exit Sub
GetErr:
MsgBox Err.Description, vbExclamation
End Sub
Sub DelPrj()
On Error GoTo DelErr
Dim StrSql As String
StrSql = "delete from testitemdetail where itemcode='" & Trim$(PrjCodeCombo) & "' "
SetDb.Execute StrSql
StrSql = "delete from testitemhead where code='" & Trim$(PrjCodeCombo) & "' "
SetDb.Execute StrSql
Exit Sub
DelErr:
MsgBox Err.Description, vbExclamation
End Sub
Sub GetProject()
On Error GoTo GetErr
Dim StrSql As String, Trec As Recordset
StrSql = StrSql + " select * from testitemhead "
Set Trec = SetDb.OpenRecordset(StrSql, dbOpenSnapshot, dbReadOnly)
If Trec.EOF Then
PrjCodeCombo.Clear
Trec.Close
Exit Sub
End If
Do Until Trec.EOF
PrjCodeCombo.AddItem Trim$(Trec!code)
Trec.MoveNext
Loop
Trec.Close
Exit Sub
GetErr:
MsgBox Err.Description, vbExclamation
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?