📄 frmpictype.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CE671F01-259E-40DA-92FE-95803E2ECBB5}#1.0#0"; "SMARTXPBUTTON.OCX"
Begin VB.Form FrmPicType
BackColor = &H00E0E0E0&
BorderStyle = 3 'Fixed Dialog
Caption = "照片类别"
ClientHeight = 4800
ClientLeft = 45
ClientTop = 420
ClientWidth = 5820
Icon = "FrmPicType.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4800
ScaleWidth = 5820
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H00DFFFF8&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 1
Left = 3615
TabIndex = 1
Text = "Text1"
Top = 1590
Width = 2025
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H00DFFFF8&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 0
Left = 3615
TabIndex = 0
Text = "Text1"
Top = 525
Width = 2025
End
Begin MSComctlLib.ImageList ImageList2
Left = 1080
Top = 1035
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPicType.frx":030A
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPicType.frx":0624
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPicType.frx":09BE
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 4635
Left = 45
TabIndex = 6
Top = 90
Width = 3435
_ExtentX = 6059
_ExtentY = 8176
View = 3
Arrange = 1
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList2"
SmallIcons = "ImageList2"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin SmartXPButton.XpButton Command1
Height = 435
Index = 0
Left = 3960
TabIndex = 2
Top = 2400
Width = 1515
_ExtentX = 2672
_ExtentY = 767
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = " 增加(&A)"
PictureSmoothBackColor= 13882323
ButtonPicture = "FrmPicType.frx":0E10
End
Begin SmartXPButton.XpButton Command1
Height = 435
Index = 1
Left = 3960
TabIndex = 3
Top = 2940
Width = 1515
_ExtentX = 2672
_ExtentY = 767
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = " 修改(&C)"
PictureSmoothBackColor= 13882323
ButtonPicture = "FrmPicType.frx":0F6A
End
Begin SmartXPButton.XpButton Command1
Height = 435
Index = 2
Left = 3960
TabIndex = 4
Top = 3480
Width = 1515
_ExtentX = 2672
_ExtentY = 767
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = " 删除(&D)"
PictureSmoothBackColor= 13882323
ButtonPicture = "FrmPicType.frx":10C4
End
Begin SmartXPButton.XpButton Command1
Height = 435
Index = 3
Left = 3960
TabIndex = 5
Top = 4020
Width = 1515
_ExtentX = 2672
_ExtentY = 767
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = " 退出(&X)"
PictureSmoothBackColor= 13882323
ButtonPicture = "FrmPicType.frx":121E
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "类别名称:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 3615
TabIndex = 8
Top = 1275
Width = 945
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "类别编码:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 3615
TabIndex = 7
Top = 210
Width = 945
End
End
Attribute VB_Name = "FrmPicType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Rec As New ADODB.Recordset
Dim i As Integer
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0 '增加
If Len(Trim(Text1(0).Text)) = 0 Then
MsgBox "照片类别编码不能为空，请重新输入编码。", vbOKOnly + vbExclamation, "编码出错..."
Text1(0).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) = "" Then
Text1(1).SetFocus
Exit Sub
End If
Rec.CursorLocation = adUseClient
Rec.Open "select * from TblType where tid='" & Trim(Text1(0).Text) & "'", _
MdlMain.Cn, adOpenDynamic, adLockOptimistic
If Rec.EOF And Rec.BOF Then
Rec.AddNew
Rec.Fields("tid").Value = Trim(Text1(0).Text)
Rec.Fields("tname").Value = Trim(Text1(1).Text)
Rec.Update
ListView1.ListItems.Add , "r" & Rec.Fields("tid").Value, Rec.Fields("tid").Value, 2, 2
ListView1.ListItems("r" & Rec.Fields("tid").Value).SubItems(1) = Rec.Fields("tname").Value
Else
MsgBox "本照片编码已存在，请重新输入...", vbCritical + vbOKOnly, "编码重复"
Rec.Close: Set Rec = Nothing
Text1(0).SetFocus
Exit Sub
End If
Rec.Close: Set Rec = Nothing
Text1(0).Text = "": Text1(1).Text = ""
Text1(0).SetFocus
Case 1 '修改
If ListView1.ListItems.Count = 0 Then Exit Sub
If Len(Trim(Text1(1).Text)) = 0 Then
Text1(1).SetFocus
Exit Sub
End If
MdlMain.Cn.Execute "update TblType set tname='" & Trim(Text1(1).Text) & "' where tid='" _
& ListView1.SelectedItem.Text & "'"
ListView1.SelectedItem.SubItems(1) = Trim(Text1(1).Text)
Text1(1).SetFocus
Case 2 '删除
If ListView1.ListItems.Count = 0 Then Exit Sub
If MsgBox("你真的要删除选定的照片类别吗？", vbOKCancel + vbQuestion, "请确认删除...") = vbOK Then
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).Selected = True Then
MdlMain.Cn.Execute "delete from TblType where tid='" & ListView1.ListItems(i).Text & "'"
End If
Next i
ListView1.ListItems.Clear
Rec.CursorLocation = adUseClient
Rec.Open "select * from TblType order by tid", MdlMain.Cn, adOpenDynamic, adLockOptimistic
If Not Rec.EOF And Not Rec.BOF Then
Do While Not Rec.EOF
ListView1.ListItems.Add , "r" & Rec.Fields("tid").Value, Rec.Fields("tid").Value, 2, 2
ListView1.ListItems("r" & Rec.Fields("tid").Value).SubItems(1) = Rec.Fields("tname").Value
Rec.MoveNext
Loop
End If
Rec.Close: Set Rec = Nothing
Text1(0).SetFocus
If ListView1.ListItems.Count <> 0 Then
ListView1.ListItems(1).Selected = True
ListView1.Tag = ListView1.SelectedItem.Key
Call ListView1_ItemClick(ListView1.SelectedItem)
End If
End If
Case 3 '退出
Unload Me
End Select
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Me.KeyPreview = True
Text1(0).Text = ""
Text1(1).Text = ""
Text1(0).MaxLength = 18
ListView1.ColumnHeaders.Add , "h1", "类别编码", 900
ListView1.ColumnHeaders.Add , "h2", "类别名称", 2200
On Error Resume Next
Rec.CursorLocation = adUseClient
Rec.Open "select * from TblType order by tid", MdlMain.Cn, adOpenDynamic, adLockOptimistic
If Not Rec.EOF And Not Rec.BOF Then
Do While Not Rec.EOF
ListView1.ListItems.Add , "r" & Rec.Fields("tid").Value, Rec.Fields("tid").Value, 2, 2
ListView1.ListItems("r" & Rec.Fields("tid").Value).SubItems(1) = Rec.Fields("tname").Value
Rec.MoveNext
Loop
End If
Rec.Close: Set Rec = Nothing
If ListView1.ListItems.Count <> 0 Then
ListView1.ListItems(1).Selected = True
ListView1.Tag = ListView1.SelectedItem.Key
Call ListView1_ItemClick(ListView1.SelectedItem)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Rec.Close: Set Rec = Nothing
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If ListView1.ListItems.Count = 0 Then Exit Sub
Text1(0).Text = Item.Text
Text1(1).Text = Item.SubItems(1)
On Error Resume Next
With ListView1
.ListItems(.Tag).SmallIcon = 2
.SelectedItem.SmallIcon = 3
.Tag = .SelectedItem.Key
End With
End Sub
Private Sub Text1_GotFocus(Index As Integer)
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -