📄 frm_addml1.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Frm_addml
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 5250
ClientLeft = 0
ClientTop = 0
ClientWidth = 5985
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 5250
ScaleWidth = 5985
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Caption = "查找(&S)"
Height = 345
Index = 4
Left = 2474
TabIndex = 11
Top = 4710
Width = 1005
End
Begin VB.CommandButton Command1
Caption = "删除(&D)"
Height = 345
Index = 3
Left = 1312
TabIndex = 6
Top = 4710
Width = 1005
End
Begin VB.CommandButton Command1
Caption = "新增(&A)"
Height = 345
Index = 2
Left = 150
TabIndex = 5
Top = 4710
Width = 1005
End
Begin MSComctlLib.ImageList ImageList1
Left = 750
Top = -210
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_addml1.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_addml1.frx":1CDC
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame Frame1
BackColor = &H00CFCFCF&
Caption = "资料目录"
Height = 4125
Left = 150
TabIndex = 3
Top = 480
Width = 5655
Begin VB.TextBox Text1
Appearance = 0 'Flat
ForeColor = &H000040C0&
Height = 285
Index = 1
Left = 4950
TabIndex = 9
Top = 3735
Width = 555
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
ForeColor = &H000040C0&
Height = 285
Index = 0
Left = 960
TabIndex = 7
Top = 3735
Width = 2925
End
Begin MSComctlLib.ListView ListView1
Height = 3435
Left = 150
TabIndex = 4
Top = 210
Width = 5355
_ExtentX = 9446
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 0
NumItems = 0
End
Begin VB.Label Label1
BackColor = &H00CFCFCF&
Caption = "页 码:"
Height = 255
Index = 1
Left = 4080
TabIndex = 10
Top = 3780
Width = 885
End
Begin VB.Label Label1
BackColor = &H00CFCFCF&
Caption = "资料名称:"
Height = 255
Index = 0
Left = 150
TabIndex = 8
Top = 3780
Width = 885
End
End
Begin VB.CommandButton Command1
Appearance = 0 'Flat
Caption = "取 消(&C)"
Height = 345
Index = 1
Left = 4800
MaskColor = &H00FFFFFF&
TabIndex = 2
Top = 4710
Width = 1005
End
Begin VB.CommandButton Command1
Caption = "保 存(&S)"
Height = 345
Index = 0
Left = 3636
TabIndex = 1
Top = 4710
Width = 1005
End
Begin VB.Image Imageicon
Height = 315
Left = 3465
Picture = "Frm_addml1.frx":3D60
Stretch = -1 'True
Top = 6480
Width = 315
End
Begin VB.Label lblTitle
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "目录列表"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Left = 3420
TabIndex = 0
Top = 6120
Width = 840
End
Begin VB.Image imgWindowBottomRight
Height = 450
Left = 2430
Picture = "Frm_addml1.frx":4DA2
Top = 5940
Width = 285
End
Begin VB.Image imgWindowBottomLeft
Height = 450
Left = 2070
Picture = "Frm_addml1.frx":54EC
Top = 5940
Width = 285
End
Begin VB.Image imgTitleMinimize
Height = 210
Left = 2790
Picture = "Frm_addml1.frx":5C36
Stretch = -1 'True
Top = 5940
Width = 210
End
Begin VB.Image imgTitleClose
Height = 210
Left = 2835
Picture = "Frm_addml1.frx":5E80
Stretch = -1 'True
Top = 6300
Width = 210
End
Begin VB.Image imgTitleHelp
Height = 210
Left = 2790
Picture = "Frm_addml1.frx":60CA
Stretch = -1 'True
Top = 6660
Width = 210
End
Begin VB.Image imgTitleMain
Height = 450
Left = 1350
Picture = "Frm_addml1.frx":6314
Stretch = -1 'True
Top = 6390
Width = 285
End
Begin VB.Image imgWindowRight
Height = 450
Left = 2430
Picture = "Frm_addml1.frx":6A5E
Stretch = -1 'True
Top = 6420
Width = 285
End
Begin VB.Image imgWindowLeft
Height = 450
Left = 2070
Picture = "Frm_addml1.frx":71A8
Stretch = -1 'True
Top = 6420
Width = 285
End
Begin VB.Image imgWindowBottom
Height = 450
Left = 1710
Picture = "Frm_addml1.frx":78F2
Stretch = -1 'True
Top = 6420
Width = 285
End
Begin VB.Image imgTitleRight
Height = 450
Left = 1710
Picture = "Frm_addml1.frx":803C
Top = 5940
Width = 285
End
Begin VB.Image imgTitleLeft
Height = 450
Left = 1350
Picture = "Frm_addml1.frx":8786
Top = 5940
Width = 285
End
End
Attribute VB_Name = "Frm_addml"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
ListView1.SortKey = 1
ListView1.Sorted = True
ListView1.SortOrder = lvwAscending
temp = ""
For i = 1 To ListView1.ListItems.Count
temp = temp & ListView1.ListItems(i).Text & Chr(13)
temp = temp & ListView1.ListItems(i).SubItems(1) & Chr(13)
Next i
Frm_tjwz.txt1(6).Text = temp
Unload Me
Case 1
itemp = MsgBox("确认不保存修改吗？", vbQuestion + vbYesNo)
If itemp = 6 Then
Unload Me
End If
Case 2
Dim itmx As ListItem
Set itmx = ListView1.ListItems.Add(, , "末命名", 1, 1)
itmx.SubItems(1) = "000"
itmx.Selected = True
Text1(0).Text = ListView1.SelectedItem.Text
Text1(1).Text = ListView1.SelectedItem.ListSubItems(1).Text
Text1(0).SetFocus
Case 3
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
If ListView1.ListItems.Count = 0 Then
Command1(3).Enabled = False
Text1(0).Text = ""
Text1(1).Text = ""
Else
Text1(0).Text = ListView1.SelectedItem.Text
Text1(1).Text = ListView1.SelectedItem.ListSubItems(1).Text
End If
Case 4
temp1 = InputBox$("输入名称开始关键字符", "查找", "")
'MsgBox temp1
If temp1 <> "" Then
Set itmx = ListView1.FindItem(temp1, 0, 1, 1)
MsgBox Not (itmx Is Nothing)
If Not (itmx Is Nothing) Then
itmx.Selected = True
'itmx.= True
Text1(0).Text = ListView1.SelectedItem.Text
Text1(1).Text = ListView1.SelectedItem.ListSubItems(1).Text
Text1(0).SetFocus
End If
End If
End Select
End Sub
Private Sub Form_Load()
MakeWindow Me
ListView1.ColumnHeaders.Add 1, , "资料名称", ListView1.Width / 4 * 3
ListView1.ColumnHeaders.Add 2, , "页 码", ListView1.Width / 4 - 300
ListView1.ColumnHeaders(2).Alignment = lvwColumnCenter
temp1 = Frm_tjwz.txt1(6).Text
If temp1 <> "" Then
read_1 (temp1)
End If
ListView1.SortKey = 1
ListView1.Sorted = True
ListView1.SortOrder = lvwAscending
If ListView1.ListItems.Count > 0 Then
Text1(0).Text = ListView1.SelectedItem.Text
Text1(1).Text = ListView1.SelectedItem.ListSubItems(1).Text
End If
End Sub
Private Sub imgTitleClose_Click()
Command1_Click (1)
End Sub
Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me
End Sub
Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me
End Sub
Private Sub imgTitleMinimize_Click()
Me.WindowState = 1
End Sub
Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me
End Sub
Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
ListView1.SortOrder = lvwAscending
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Text1(0).Text = ListView1.SelectedItem.Text
Text1(1).Text = ListView1.SelectedItem.ListSubItems(1).Text
'ListView1.SelectedItem.Checked = True
End Sub
Private Sub Text1_Change(Index As Integer)
'MsgBox ListView1.SelectedItem.Index
If ListView1.ListItems.Count > 0 Then
Select Case Index
Case 0
ListView1.SelectedItem.Text = Text1(0).Text
Case 1
ListView1.SelectedItem.ListSubItems(1).Text = Text1(1).Text
End Select
End If
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 1 Then
strValid = "0123456789"
If KeyAscii > 26 Then
If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
If Index = 1 Then
a = Val(Text1(1).Text)
If a > 999 Then a = 999
If a < 1 Then a = 0
Select Case a
Case 0 To 9
Text1(1).Text = "00" & a
Case 10 To 99
Text1(1).Text = "0" & a
Case 100 To 999
Text1(1).Text = a
End Select
End If
End Sub
Private Sub read_1(tt1 As String)
Dim li1 As ListItem
istar = 1
iserch = Chr(13)
ifound = InStr(istar, tt1, Chr(13))
While ifound <> 0
itemp = Mid(tt1, istar, ifound - istar)
Set li1 = ListView1.ListItems.Add(, , itemp, 1, 1)
istar = ifound + 1
ifound = InStr(istar, tt1, Chr(13))
itemp = Mid(tt1, istar, ifound - istar)
li1.SubItems(1) = itemp
istar = ifound + 1
ifound = InStr(istar, tt1, Chr(13))
Wend
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -