📄 frmlist.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frmList
Caption = "Form2"
ClientHeight = 5355
ClientLeft = 3165
ClientTop = 1785
ClientWidth = 6690
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 5355
ScaleWidth = 6690
Begin MSComctlLib.ImageList imlToolbarIcons
Left = 3360
Top = 960
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":0000
Key = "New"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":0112
Key = "Find"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":0224
Key = "Delete"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":0336
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":0452
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmList.frx":056E
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 630
Left = 0
TabIndex = 0
Top = 0
Width = 6690
_ExtentX = 11800
_ExtentY = 1111
ButtonWidth = 820
ButtonHeight = 953
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
ImageList = "imlToolbarIcons"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 3
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "增加"
Key = "New"
Object.ToolTipText = "New"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查找"
Key = "Find"
Object.ToolTipText = "Find"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "注销"
Key = "Delete"
Object.ToolTipText = "Delete"
EndProperty
EndProperty
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Height = 2895
Left = 840
TabIndex = 1
Top = 1800
Width = 2055
_ExtentX = 3625
_ExtentY = 5106
_Version = 393216
FixedCols = 0
AllowBigSelection= 0 'False
FocusRect = 2
HighLight = 2
SelectionMode = 1
AllowUserResizing= 3
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
Attribute VB_Name = "frmlist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public ListNo As String
Dim rsx As New Recordset
Dim sps As New spListHeaders
Private Sub MSHFlexGrid1_DblClick()
If Not (rsx.EOF And rsx.BOF) Then
Fedit
End If
End Sub
Private Sub Form_Load()
With rsx
.ActiveConnection = cnnString
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
End With
updateField
Init_ListImglist Me.imlToolbarIcons, Me.Toolbar1, (Not sps.ReadOnly), sps.other
'SetDefault sps
Me.fFilter
'Set MSHFlexGrid1.DataSource = rsx
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.MSHFlexGrid1.Width = Me.ScaleWidth
Me.MSHFlexGrid1.Height = Me.ScaleHeight - Me.Toolbar1.Height
Me.MSHFlexGrid1.Top = Me.Toolbar1.Height
Me.MSHFlexGrid1.Left = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim vn As String
vn = sps.ViewNo
releObject rsx
releObject sps
'mshflexgrid1.DataChanged = False
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.key
Case strKprint
Case strKpreview
Case strKOUTPUT
Case strKadd
faddnew
Case strKedit
Fedit
' Case strKdel
' fdelete
Case strKfilter
fFilter
Case strKfind
fFind
Case strKsort
fSort
Case strKsetfield
SetField
Case strKrefresh
fRefresh
Case strKsave
FsaveLayout
Case strKhelp
Case strKclose
Unload Me
End Select
' Select Case Button.key
' Case "New"
' faddnew
' Case "Find"
' 'rsx.Find "cusid=64"
' MsgBox "查找", vbInformation, "系统提示"
' Case "Delete"
' MsgBox "注销", vbInformation, "系统提示"
' 'resetField
' SetField
'
' 'fdelete
' Case strKpreview
' ResetCond sps, rsx
'
' fprint rsx, sps
' DrepList.Show 1
'
' End Select
End Sub
Sub SetField()
With frmSetList
Set .listX = sps
.Show 1
If .ok Then
updateField
fRefresh
End If
End With
End Sub
Sub updateField()
FillViewStruct sps, cnnString, ListNo
FillMHFGridStruct sps, MSHFlexGrid1
Me.caption = sps.vName
End Sub
Sub fSelect()
End Sub
Property Let value(strkey As String, R As Long, val As Variant)
MSHFlexGrid1.TextMatrix(R, sps.SUBIndex(strkey) - 1) = NullToString(val)
End Property
'取得表体某单元格的值
Property Get value(strkey As String, R As Long) As Variant
value = MSHFlexGrid1.TextMatrix(R, sps.SUBIndex(strkey) - 1)
End Property
Sub recToGrid()
With MSHFlexGrid1
.Clear
FillMHFGridStruct sps, MSHFlexGrid1
'.Rows = 1
.Rows = 2
fillList sps, MSHFlexGrid1, rsx
End With
End Sub
Public Sub FsaveLayout()
Dim i As Long
For i = 1 To MSHFlexGrid1.Cols
sps(i).Width = MSHFlexGrid1.ColWidth(i - 1)
Next i
SaveViewStruct sps, cnnString, ListNo
End Sub
Public Sub fRefresh()
If rsx.State = adStateOpen Then
rsx.Close
End If
'ResetCond sps, rsx
recToGrid
End Sub
Public Sub fFind()
On Error Resume Next
Dim Colname As String
Dim valueX As String
With frmFind
Set .sps = sps
.Show 1
If .ok Then
Colname = mid(.StrFind, 1, InStr(1, .StrFind, "=") - 1)
valueX = Trim(mid(.StrFind, InStr(1, .StrFind, "=") + 1))
valueX = mid(valueX, 2, Len(valueX) - 2)
MSHFlexGrid1.Col = sps.SUBIndex(Colname) - 1
If .ForeDirection Then
While MSHFlexGrid1.Row < MSHFlexGrid1.Rows - 1
MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1
If Me.MSHFlexGrid1.text = valueX Then
Me.MSHFlexGrid1.TopRow = MSHFlexGrid1.Row
'Me.MSHFlexGrid1.RowPosition() = 1
Exit Sub
End If
Wend
Else
While MSHFlexGrid1.Row > 1
MSHFlexGrid1.Row = MSHFlexGrid1.Row - 1
If Me.MSHFlexGrid1.text = valueX Then
Me.MSHFlexGrid1.TopRow = MSHFlexGrid1.Row
'Me.MSHFlexGrid1.RowIsVisible(MSHFlexGrid1.Row) = True
Exit Sub
End If
Wend
End If
MsgBox "没有找到要查的值！", vbInformation, "提示信息"
End If
End With
End Sub
Public Sub fSort()
Dim Colname As String
Dim Direction As String
With frmSort
Set .sps = sps
.Show 1
If .ok Then
Colname = mid(.Strsort, 1, InStr(1, .Strsort, " ") - 1)
Direction = Trim(mid(.Strsort, InStr(1, .Strsort, " ") + 1))
MSHFlexGrid1.Col = sps.SUBIndex(Colname) - 1
If Direction = "ASC" Then
MSHFlexGrid1.Sort = 5
Else
MSHFlexGrid1.Sort = 6
End If
' rsx.Sort = .Strsort
End If
End With
End Sub
Function fFilter()
Dim cond As New condtion
Select Case sps.ViewNo
Case "leds"
Case "modedefs"
End Select
fRefresh
releObject cond
End Function
Public Sub faddnew()
On Error GoTo errh
Select Case sps.ViewNo
Case "graphiclib"
graphmaintain.creategraph
End Select
Me.fRefresh
Exit Sub
errh:
MsgBox "不能增加新的项目！", vbInformation, "增加错误"
End Sub
Public Sub Fedit()
On Error GoTo errh
Select Case sps.ViewNo
Case "modes"
modemaintain.modifymode Me.value("modeid", Me.MSHFlexGrid1.Row)
Case "leds"
ledmaintain.modifyled Me.value("ledid", Me.MSHFlexGrid1.Row)
Case "ledcontrols"
ledcontrolmaintain.modifyledcontrol Me.value("ledid", Me.MSHFlexGrid1.Row)
Case "signposts"
signpostmaintain.modifysignpost Me.value("ledid", Me.MSHFlexGrid1.Row)
Case "modedefs"
modedefmaintain.modifymodedef Me.value("modeid", Me.MSHFlexGrid1.Row), Me.value("sid", Me.MSHFlexGrid1.Row)
Case "graphiclib"
graphmaintain.modifygraph Me.value("gid", Me.MSHFlexGrid1.Row)
End Select
'Me.fRefresh
Exit Sub
errh:
MsgBox "Cann't modify item error", vbInformation, "modify error"
End Sub
Public Sub fdelete()
On Error GoTo errh
Select Case sps.ViewNo
Case "graphiclib"
' customermaintain.delcustomer Me.value("customerid")
End Select
Me.fRefresh
Exit Sub
errh:
MsgBox "This item is using , cann't delete", vbInformation, "Delete error"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -