📄 frmparts.frm
字号:
VERSION 5.00
Begin VB.Form FrmParts
BorderStyle = 3 'Fixed Dialog
Caption = "产品部件信息"
ClientHeight = 4950
ClientLeft = 45
ClientTop = 330
ClientWidth = 6540
Icon = "FrmParts.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4950
ScaleWidth = 6540
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame3
Height = 4965
Left = 15
TabIndex = 0
Top = -75
Width = 6510
Begin VB.TextBox Text1
Height = 300
Left = 3120
Locked = -1 'True
MaxLength = 3
TabIndex = 3
Top = 3870
Width = 810
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "FrmParts.frx":038A
Left = 885
List = "FrmParts.frx":0398
Style = 2 'Dropdown List
TabIndex = 2
Top = 3855
Width = 1335
End
Begin VB.TextBox Text2
Height = 300
Left = 4830
Locked = -1 'True
TabIndex = 1
Top = 3870
Width = 1620
End
Begin ServicingMS.ucListView ListView1
Height = 3645
Left = 45
TabIndex = 4
Top = 150
Width = 6435
_ExtentX = 11351
_ExtentY = 6429
End
Begin ServicingMS.lvButtons_H CmdAdd
Height = 375
Left = 480
TabIndex = 5
Top = 4455
Width = 945
_ExtentX = 1667
_ExtentY = 661
Caption = "新增"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
cGradient = 0
Mode = 0
Value = 0 'False
Image = "FrmParts.frx":03B4
cBack = -2147483633
End
Begin ServicingMS.lvButtons_H CmdEdit
Height = 375
Left = 1635
TabIndex = 6
Top = 4455
Width = 945
_ExtentX = 1667
_ExtentY = 661
Caption = "修改"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
cGradient = 0
Mode = 0
Value = 0 'False
Image = "FrmParts.frx":074E
cBack = -2147483633
End
Begin ServicingMS.lvButtons_H CmdDele
Height = 375
Left = 2700
TabIndex = 7
Top = 4455
Width = 945
_ExtentX = 1667
_ExtentY = 661
Caption = "删除"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
cGradient = 0
Mode = 0
Value = 0 'False
Image = "FrmParts.frx":0AE8
cBack = -2147483633
End
Begin ServicingMS.lvButtons_H CmdSave
Height = 375
Left = 3840
TabIndex = 8
Top = 4455
Width = 945
_ExtentX = 1667
_ExtentY = 661
Caption = "保存"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
cGradient = 0
Mode = 0
Value = 0 'False
Image = "FrmParts.frx":0E82
Enabled = 0 'False
cBack = -2147483633
End
Begin ServicingMS.lvButtons_H CmdCancel
Height = 375
Left = 4965
TabIndex = 9
Top = 4455
Width = 945
_ExtentX = 1667
_ExtentY = 661
Caption = "取消"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
cGradient = 0
Mode = 0
Value = 0 'False
Image = "FrmParts.frx":121C
Enabled = 0 'False
cBack = -2147483633
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "部件编号:"
Height = 240
Left = 2295
TabIndex = 12
Top = 3915
Width = 855
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "部件类别:"
Height = 225
Left = 75
TabIndex = 11
Top = 3930
Width = 855
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "部件名称:"
Height = 210
Left = 4035
TabIndex = 10
Top = 3930
Width = 885
End
Begin VB.Line Line1
BorderColor = &H80000003&
X1 = 30
X2 = 6465
Y1 = 4320
Y2 = 4320
End
Begin VB.Line Line2
BorderColor = &H80000005&
X1 = 30
X2 = 6450
Y1 = 4335
Y2 = 4335
End
End
End
Attribute VB_Name = "FrmParts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_ColumnSortOrder(2) As eSortOrderConstants
Private m_CurrentColumn As Integer
Dim SeleItem As Integer
Dim OperStat As Integer '0,修改 1,增加
Private Sub CmdAdd_Click()
OperStat = 1
cmdCancel.Enabled = True
CmdAdd.Enabled = False
CmdEdit.Enabled = False
CmdDele.Enabled = False
ListView1.Enabled = False
ListView1.Enabled = False
Text1 = Format(ListView1.Count + 1, "000")
Text1.Locked = True
Text2.Locked = False
Text2.SetFocus
End Sub
Private Sub cmdCancel_Click()
CmdSave.Enabled = False
cmdCancel.Enabled = False
CmdAdd.Enabled = True
CmdEdit.Enabled = True
CmdDele.Enabled = True
Text1.Locked = True
Text2.Locked = True
ListView1.Enabled = True
End Sub
Private Sub CmdDele_Click()
If ListView1.SelectedCount <> 0 Then
'Text1 = ListView1.SubItemText(SeleItem, 0)
'Text1 = Text1 & Space(2) & ListView1.SubItemText(SeleItem, 2)
If MsgBox("确定删除" & Text1 & "资料吗?", vbQuestion + vbOKCancel, "提示") = vbOK Then
'数据库操作
Call DBdelete("Parts", "PartsID", Left(Combo1, 3) & Text1)
ListView1.ItemRemove (SeleItem)
End If
Else
MsgBox "请选择要删除的内容.", vbCritical, "错误"
End If
End Sub
Private Sub CmdEdit_Click()
If ListView1.SelectedCount <> 0 Then
Call CmdAdd_Click
OperStat = 0
Text1.Locked = True
Text2.Locked = False
Text2.SetFocus
Else
MsgBox "请选择要修改的内容.", vbCritical, "错误"
End If
End Sub
Private Sub CmdSave_Click()
Dim i As Integer
If OperStat = 1 Then '增加
Cn.Open "dsn=SerManage"
Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from Parts where PartsName='" & Text2 & "'"
.ActiveConnection = Cn
.Open
If .RecordCount = 0 Then
.AddNew
.Fields(0) = Left(Combo1, 3)
.Fields(1) = Left(Combo1, 3) & Text1
.Fields(2) = Text2
.Update
.Close
Cn.Close
Else
MsgBox "输入信息已存在,请重输!", vbCritical, "提示"
.Close
Cn.Close
Exit Sub
End If
End With
i = ListView1.Count
ListView1.ItemAdd i, Left(Combo1, 3) & Text1, 0, 0
ListView1.SubItemSet i, 1, IIf(Combo1.ListIndex = 0, "电器类", "电子类"), 0
ListView1.SubItemSet i, 2, Text2, 0
ListView1.ItemSelected(i) = True
ListView1.ItemEnsureVisible (i)
Else
i = ListView1.ItemFindText(Text1, , cPartial)
ListView1.ItemSelected(i) = True
ListView1.SubItemSet i, 1, IIf(Combo1.ListIndex = 0, "电器类", "电子类"), 0
ListView1.SubItemSet i, 2, Text2, 0
End If
Call cmdCancel_Click
End Sub
Private Sub Combo1_Click()
Call ListView1.Clear
Cn.Open "dsn=SerManage"
Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
'配件库
.Source = "select * from Parts where CategoryID='" & Left(Combo1, 3) & "'"
.ActiveConnection = Cn
.Open
End With
Dim nIdx As Integer
Dim nCol As Integer
With ListView1
.Visible = False
For nCol = 0 To 2
m_ColumnSortOrder(nCol) = [soDefault] '~None
.ColumnIcon(nCol) = -1 '~None
Next nCol
m_CurrentColumn = -1
For nIdx = .Count To .Count + rs.RecordCount - 1
Call .ItemAdd(nIdx, rs.Fields(1), 0, 0)
Call .SubItemSet(nIdx, 1, IIf(Val(rs.Fields(0)) = 101, "电器类", "电子类"), 0)
Call .SubItemSet(nIdx, 2, rs.Fields(2), 0)
rs.MoveNext
Next nIdx
.Visible = True
End With
rs.Close
Cn.Close
End Sub
Private Sub Form_Load()
Call LoadPartsData
Combo1.ListIndex = 0
End Sub
'载入部件
Sub LoadPartsData()
With ListView1
Call .Initialize
Call .InitializeImageListSmall
'Call .InitializeImageListLarge
Call .InitializeImageListHeader
'Call .ImageListSmall_AddIcon(ilsIcons)
Call .ImageListSmall_AddBitmap(LoadResPicture(101, vbResBitmap), vbMagenta)
'Call .ImageListLarge_AddBitmap(LoadResPicture("IL32x32", vbResBitmap), vbMagenta)
Call .ImageListHeader_AddBitmap(LoadResPicture("ILHEADER", vbResBitmap), vbMagenta)
Call .ColumnAdd(0, "部件编码", 80, [caleft])
Call .ColumnAdd(1, "部件类别", 80, [caRight])
Call .ColumnAdd(2, "部件名称", 100, [caRight])
Call .ColumnAdd(3, "备注", 100, [caRight])
.RaiseSubItemPrePaint = True 'Force OnSubItemPrePaint() event
End With
ListView1.BorderStyle = bsThick
ListView1.ViewMode = vmDetails
ListView1.GridLines = True
'ListView1.HeaderFlat = True
'ListView1.ScrollBarFlat = True
ListView1.FullRowSelect = True
Call Randomize(Timer)
End Sub
Private Sub ListView1_ItemClick(Item As Integer)
Text1 = ListView1.SubItemText(Item, 1)
If Trim(Text1) = "电器类" Then
Combo1.ListIndex = 0
Else
Combo1.ListIndex = 1
End If
Text1 = ""
Text1 = Mid(ListView1.SubItemText(Item, 0), 4, 3)
Text2 = ListView1.SubItemText(Item, 2)
SeleItem = Item
End Sub
Private Sub ListView1_OnSubItemPrePaint(ByVal Item As Integer, ByVal SubItem As Integer, TextBackColor As Long, TextForeColor As Long, Process As Boolean)
If (Item Mod 2) Then
TextBackColor = RGB(250, 242, 190) 'RGB(150, 200, 250)
TextForeColor = RGB(0, 0, 0)
Process = True
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.SetFocus
End If
End Sub
Private Sub Text2_Change()
If Len(Text2) > 0 Then
CmdSave.Enabled = True
Else
CmdSave.Enabled = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -