📄 frmproductenregister.frm
字号:
Text2.Text = "原因不详"
Text2.SetFocus
Else
Text2.SetFocus
Exit Sub
End If
End If
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from Product where ProductID='" & Text1 & "'"
.ActiveConnection = Cn
.Open
End With
If rs.RecordCount <> 0 Then
MsgBox "当前产品编号已存在!", vbCritical, "提示"
rs.Close
Exit Sub
End If
rs.AddNew
Call EditUpdate(1)
Else '修改
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from Product where ProductID='" & Text1 & "'"
.ActiveConnection = Cn
.Open
End With
Call EditUpdate(0)
End If
Call cmdCancel_Click
End Sub
Sub EditUpdate(StatID As Integer)
Dim SeleID As Integer
rs.Fields(0) = Text1
rs.Fields(2) = Combo1
rs.Fields(3) = Combo2
rs.Fields(4) = Combo3
rs.Fields(5) = DTPicker1.Value
rs.Fields(6) = DTPicker2.Value
rs.Fields(7) = DTPicker3.Value
rs.Fields(8) = Combo4
rs.Fields(9) = Combo5
rs.Fields(10) = Text2
rs.Fields!AddDate = Format(Date, "yyyymm")
rs.Update
If StatID = 1 Then
SeleID = ListView1.Count
ListView1.ItemAdd SeleID, Text1, 0, 0
Else
SeleID = ListView1.ItemFindText(Text1, , cPartial)
ListView1.ItemSelected(SeleID) = True
ListView1.SubItemSet SeleID, 0, Text1, 0
End If
ListView1.SubItemSet SeleID, 1, Combo1, 0
ListView1.SubItemSet SeleID, 2, Combo2, 0
ListView1.SubItemSet SeleID, 3, DTPicker1.Value, 0
ListView1.SubItemSet SeleID, 4, DTPicker2.Value, 0
ListView1.SubItemSet SeleID, 5, DTPicker3.Value, 0
ListView1.SubItemSet SeleID, 6, Combo4, 0
ListView1.SubItemSet SeleID, 7, Combo5, 0
ListView1.SubItemSet SeleID, 8, Text2, 0
ListView1.SubItemSet SeleID, 9, Combo3, 0
ListView1.ItemSelected(SeleID) = True
ListView1.ItemEnsureVisible (SeleID)
End Sub
Private Sub Form_Load()
Call LoadSpecData
Call LoadComBox("Model", Combo1)
Call LoadComBox("Specification", Combo2)
Call LoadComBox("Client", Combo3)
Call LoadComBox("DisposeCategory", Combo5)
Call LoadComBox("Parts", Combo6)
DTPicker1.Value = Date
DTPicker2.Value = Date
DTPicker3.Value = Date
List1.AddHeader 120, LeftJustify, "维修零件名称"
List1.AddHeader 50, RightJustify, "数量"
End Sub
'载入规格
Sub LoadSpecData()
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, "产品编码", 85, [caleft])
Call .ColumnAdd(1, "型号", 55, [caRight])
Call .ColumnAdd(2, "规格", 40, [caRight])
Call .ColumnAdd(3, "生产时间", 80, [caRight])
Call .ColumnAdd(4, "维修时间", 80, [caRight])
Call .ColumnAdd(5, "修好时间", 80, [caRight])
Call .ColumnAdd(6, "结果", 40, [caRight])
Call .ColumnAdd(7, "处理方式", 90, [caRight])
Call .ColumnAdd(8, "损坏原因", 160, [caRight])
Call .ColumnAdd(9, "客户名称", 200, [caRight])
Call .ColumnAdd(10, "备注", 50, [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)
Cn.Open "dsn=SerManage"
Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from Product where AddDate='" & Format(Date, "yyyymm") & "'"
.ActiveConnection = Cn
.Open
End With
Me.Caption = Me.Caption & " 月份:" & Format(Date, "yyyymm") & " 本月记录:" & rs.RecordCount & "条"
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(0), 0, 0)
Call .SubItemSet(nIdx, 1, rs.Fields(2), 0)
Call .SubItemSet(nIdx, 2, rs.Fields(3), 0)
Call .SubItemSet(nIdx, 3, rs.Fields(5), 0)
Call .SubItemSet(nIdx, 4, rs.Fields(6), 0)
Call .SubItemSet(nIdx, 5, rs.Fields(7), 0)
Call .SubItemSet(nIdx, 6, rs.Fields(8), 0)
Call .SubItemSet(nIdx, 7, rs.Fields(9), 0)
Call .SubItemSet(nIdx, 8, rs.Fields(10) & "", 0)
Call .SubItemSet(nIdx, 9, rs.Fields(4) & "", 0)
rs.MoveNext
Next nIdx
.Visible = True
End With
rs.Close
'CategoryID PartsID PartsName
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
rs.Close
Cn.Close
End Sub
Private Sub ListView1_ItemClick(Item As Integer)
On Error Resume Next
Text1 = ListView1.SubItemText(Item, 0)
Combo1 = ListView1.SubItemText(Item, 1)
Combo2 = ListView1.SubItemText(Item, 2)
DTPicker1.Value = ListView1.SubItemText(Item, 3)
Combo3 = ListView1.SubItemText(Item, 9)
DTPicker2.Value = ListView1.SubItemText(Item, 4)
DTPicker3.Value = ListView1.SubItemText(Item, 5)
Combo4 = ListView1.SubItemText(Item, 6)
Text2 = ListView1.SubItemText(Item, 8)
Combo5 = ListView1.SubItemText(Item, 7)
SeleItem = Item
'Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from PartsList where ProductID='" & Text1 & "'"
.ActiveConnection = Cn
.Open
End With
Dim i As Integer
List1.ClearList
For i = 0 To rs.RecordCount - 1
List1.AddItem rs.Fields(1) & vbTab & rs.Fields(2)
rs.MoveNext
Next
rs.Close
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
Sub LoadComBox(DbName As String, ComboxObj As Object)
Dim i As Integer
'Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "select * from " & DbName
.ActiveConnection = Cn
.Open
End With
ComboxObj.Clear
For i = 0 To rs.RecordCount - 1
If DbName = "Parts" Then
ComboxObj.AddItem rs.Fields(2)
Else
ComboxObj.AddItem rs.Fields(1) 'rs.Fields(0) & vbTab &
End If
rs.MoveNext
Next
' If ComboxObj.ListCount <> 0 Then
' ComboxObj.ListIndex = 0
' Else
' ComboxObj.AddItem "未知"
' End If
rs.Close
End Sub
Private Sub Text1_GotFocus()
Text1.BackColor = &HFFFFC0
Text1.ForeColor = vbBlack
End Sub
Private Sub Text1_LostFocus()
Text1.BackColor = vbWhite
Text1.ForeColor = vbBlack
End Sub
Private Sub Text2_GotFocus()
Text2.BackColor = &HFFFFC0
Text2.ForeColor = vbBlack
End Sub
Private Sub Text2_LostFocus()
Text2.BackColor = vbWhite
Text2.ForeColor = vbBlack
End Sub
Private Sub Combo1_GotFocus()
Combo1.BackColor = &HFFFFC0
Combo1.ForeColor = vbBlack
End Sub
Private Sub Combo1_LostFocus()
Combo1.BackColor = vbWhite
Combo1.ForeColor = vbBlack
End Sub
Private Sub Combo2_GotFocus()
Combo2.BackColor = &HFFFFC0
Combo2.ForeColor = vbBlack
End Sub
Private Sub Combo2_LostFocus()
Combo2.BackColor = vbWhite
Combo2.ForeColor = vbBlack
End Sub
Private Sub Combo3_GotFocus()
Combo3.BackColor = &HFFFFC0
Combo3.ForeColor = vbBlack
End Sub
Private Sub Combo3_LostFocus()
Combo3.BackColor = vbWhite
Combo3.ForeColor = vbBlack
End Sub
Private Sub Combo4_GotFocus()
Combo4.BackColor = &HFFFFC0
Combo4.ForeColor = vbBlack
End Sub
Private Sub Combo4_LostFocus()
Combo4.BackColor = vbWhite
Combo4.ForeColor = vbBlack
End Sub
Private Sub Combo5_GotFocus()
Combo5.BackColor = &HFFFFC0
Combo5.ForeColor = vbBlack
End Sub
Private Sub Combo5_LostFocus()
Combo5.BackColor = vbWhite
Combo5.ForeColor = vbBlack
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -