⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmproductenregister.frm

📁 需要控件:Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。
💻 FRM
📖 第 1 页 / 共 3 页
字号:
             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 + -