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

📄 frmmainbrow.frm

📁 一套鞋厂的仓库管理系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
    lvListView.View = lvwReport
    
    Me.mnuchangyong.Checked = True
    Me.mnunochangyong.Checked = False
    Me.mnudaihuo.Checked = False
    viewflag = "A"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("退出开发材料库存管理系统?", vbOKCancel) = vbOK Then
       Unload Me
    Else
        Cancel = True
    End If
End Sub

'''点击标题栏，可以按标题排序
Private Sub lvListView_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    If lvListView.SortOrder = lvwAscending Then
       lvListView.SortOrder = lvwDescending
    Else
      lvListView.SortOrder = lvwAscending
    End If
    lvListView.SortKey = ColumnHeader.Index - 1
    lvListView.Sorted = True
End Sub

Private Sub lvListView_DblClick()
On Error Resume Next
    Me.MousePointer = 11
    ids = Mid(Me.lvListView.SelectedItem.Key, 2, 100)
    pubidname = Mid(Me.tvTreeView.SelectedItem.Key, 2, 100)
    frmdatamodifymain.ID = ids
    frmdatamodifymain.comok.Value = True
    frmdatamodifymain.Show 1
    Me.MousePointer = 0
End Sub

Private Sub lvListView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
   Me.PopupMenu FrmMainBrow.ywj02
End If
End Sub

Private Sub mnuchangyong_Click()
    Me.mnuchangyong.Checked = True
    Me.mnunochangyong.Checked = False
    Me.mnudaihuo.Checked = False
    If viewflag <> "A" Then
      viewflag = "A"
        Me.Label2.Caption = "常用" & "  品名资料    "
    End If
End Sub

Private Sub mnuconfiger_Click()
On Error Resume Next
    Dim i
    Dim str As String
    str = App.Path & "\scrsaver.exe"
    i = Shell(str, vbNormalFocus)
End Sub

Private Sub mnudaihuo_Click()
    Me.mnuchangyong.Checked = False
    Me.mnunochangyong.Checked = False
    Me.mnudaihuo.Checked = True
    If viewflag <> "C" Then
      viewflag = "C"
    Me.Label2.Caption = "呆货" & "  品名资料    "
    End If
End Sub

Private Sub mnuexit_Click()
    If MsgBox("退出开发材料库存管理系统?", vbOKCancel) = vbOK Then
       Unload Me
    End If
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show 1
End Sub

Private Sub mnuHelpConcents_Click()
    Dim nRet As Integer
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
        'Shell App.Path & "sd2000.hlp"
    Else
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
                'Shell App.Path & "\sd2000.hlp"
    End If
End Sub
Private Sub mnunochangyong_Click()
    Me.mnuchangyong.Checked = False
    Me.mnunochangyong.Checked = True
    Me.mnudaihuo.Checked = False
    If viewflag <> "B" Then
      viewflag = "B"
      Me.Label2.Caption = "不常用" & "  品名资料    "
    End If

End Sub

Private Sub mnuscreen_Click()
On Error Resume Next
    Dim RetVal
    Dim str As String
    str = App.Path & "\screen.exe"
    RetVal = Shell(str, 3)
End Sub

Private Sub mnustuffbrow_Click()
    Me.MousePointer = 11
    FrmdataBrow.Show 1
    Me.MousePointer = 0
End Sub

Private Sub mnustuffclass_Click()
    Me.MousePointer = 11
   frmstuffclass.Show 1
   Me.MousePointer = 0
End Sub

Private Sub mnustuffdata_Click()
    Me.MousePointer = 11
    frmmaindata.Show 1
    Me.MousePointer = 0
End Sub

Private Sub mnuuserpassword_Click()
    frmpassword.Top = 1500
    frmpassword.Left = 3900
    frmpassword.Show 1
End Sub
Private Sub menumodify_click()
    On Error Resume Next
    Me.MousePointer = 11
    ids = Mid(Me.lvListView.SelectedItem.Key, 2, 100)
    pubidname = Mid(Me.tvTreeView.SelectedItem.Key, 2, 100)
    frmdatamodifymain.ID = ids
    frmdatamodifymain.comok.Value = True
    frmdatamodifymain.Show 1
    Me.MousePointer = 0
End Sub

Private Sub menudel_click()
On Error Resume Next
Me.MousePointer = 11
    If MsgBox("确定删除此记录？", vbOKCancel) = vbOK Then
        ids = Mid(Me.lvListView.SelectedItem.Key, 2, 100)
        Dim rst1 As ADODB.Recordset
        Set rst1 = New ADODB.Recordset
        rst1.Open "select * from stuffdatatable where stuffdatatable.id=" & ids, GetConnect, adOpenDynamic, adLockOptimistic
        If rst1.EOF And rst1.BOF Then
            rst1.Close
            Me.MousePointer = 0
            Exit Sub
        End If
        rst1.Delete
        rst1.Close
        MsgBox "记录删除OK!"
    Else
    Me.MousePointer = 0
    End If
Me.MousePointer = 0
End Sub

Private Sub mnudel_click()
    On Error Resume Next
    Me.MousePointer = 11
    If MsgBox("确定删除此记录？", vbOKCancel) = vbOK Then
        Dim rst1 As ADODB.Recordset
        ids = Mid(Me.tvTreeView.SelectedItem.Key, 2, 100)
        Set rst1 = New ADODB.Recordset
        rst1.Open "select * from stuffclasstable where fatherclass=" & ids, GetConnect, adOpenForwardOnly, adLockReadOnly
        If rst1.EOF And rst1.BOF Then
            Dim rst2 As ADODB.Recordset
            Set rst2 = New ADODB.Recordset
            rst2.Open "select * from stuffdatatable where stuffdatatable.stuffclass=" & ids, GetConnect, adOpenForwardOnly, adLockReadOnly
            If rst2.EOF And rst2.BOF Then
               Dim rst3 As ADODB.Recordset
               Set rst3 = New ADODB.Recordset
               rst3.Open "select * from stuffclasstable where id =" & ids, GetConnect, adOpenDynamic, adLockOptimistic
               rst3.Delete
               rst3.Close
               MsgBox "删除OK!"
               rst2.Close
               rst1.Close
               
               '刷新树型列表开始
               Me.tvTreeView.Nodes.Clear
                rst3.Open "select * from stuffclasstable order by fatherclass", GetConnect, adOpenForwardOnly, adLockReadOnly
                Do Until rst3.EOF
                If rst3![fatherclass] = 0 Then
                    tvTreeView.Nodes.Add , , "_" & Format(rst3![ID], "00000"), rst3![Name], 3, 4
                Else
                    tvTreeView.Nodes.Add "_" & Format(rst3![fatherclass], "00000"), tvwChild, "_" & Format(rst3![ID], "00000"), rst3![Name], 3, 4
                End If
                    rst3.MoveNext
                Loop
                rst3.Close
               '刷新树型列表结束
               
               Me.MousePointer = 0
               Exit Sub
            End If
            rst2.Close
        Else
           Me.MousePointer = 0
        End If
        MsgBox "不能删除！"
        rst1.Close  '关闭rst1
    Else
    End If
    Me.MousePointer = 0
End Sub
 
Private Sub mnuadd_click()
    Me.MousePointer = 11
    frmstuffclass.Show 1
    Me.MousePointer = 0
End Sub
Private Sub mnuaddstuff_click()
    Me.MousePointer = 11
    frmmaindata.Show 1
    Me.MousePointer = 0
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新类别"
            frmstuffclass.Show 1
        Case "新材料"
            Me.MousePointer = 11
            frmmaindata.Show 1
            Me.MousePointer = 0
        Case "删除"
        
        Case "修改"
            On Error Resume Next
            Me.MousePointer = 11
            ids = Mid(Me.lvListView.SelectedItem.Key, 2, 100)
            pubidname = Mid(Me.tvTreeView.SelectedItem.Key, 2, 100)
            frmdatamodifymain.ID = ids
            frmdatamodifymain.comok.Value = True
            frmdatamodifymain.Show 1
            Me.MousePointer = 0
            
        Case "排序"
            frmindex.Show 1
        Case "列表"
            Me.MousePointer = 11
            lvListView.ColumnHeaders.Clear
            lvListView.ColumnHeaders.Add , , "材料代号", (lvListView.Width / 6) - 200
            lvListView.ColumnHeaders.Add , , "助记码", (lvListView.Width / 6) - 200, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "材料名称", (lvListView.Width / 6), lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "规格", (lvListView.Width / 6), lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "颜色", (lvListView.Width / 6), lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "单位", 0, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "货品类别", 0, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "库存类别", 0, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "初始库存", 0, lvwColumnRight
            lvListView.ColumnHeaders.Add , , "厂商", (lvListView.Width / 6), lvwColumnCenter
            lvListView.View = lvwReport
            Me.MousePointer = 0

        Case "详细资料"
            Me.MousePointer = 11
            lvListView.ColumnHeaders.Clear
            lvListView.ColumnHeaders.Add , , "材料代号", (lvListView.Width / 8) - 100
            lvListView.ColumnHeaders.Add , , "助记码", (lvListView.Width / 8) - 100, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "材料名称", (lvListView.Width / 8) + 300, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "规格", (lvListView.Width / 8), lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "颜色", (lvListView.Width / 8), lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "单位", (lvListView.Width / 8) - 200, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "货品类别", 0, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "库存类别", 0, lvwColumnCenter
            lvListView.ColumnHeaders.Add , , "初始库存", lvListView.Width / 8 - 200, lvwColumnRight
            lvListView.ColumnHeaders.Add , , "厂商", (lvListView.Width / 8) + 100, lvwColumnCenter
            lvListView.View = lvwReport
            Me.MousePointer = 0

        Case "刷新"
            Dim rst1 As New ADODB.Recordset
            rst1.Open "select * from stuffclasstable order by fatherclass", GetConnect, adOpenForwardOnly, adLockReadOnly
            Do Until rst1.EOF
                If rst1![fatherclass] = 0 Then
                    tvTreeView.Nodes.Add , , "_" & Format(rst1![ID], "00000"), rst1![Name], 3, 4
                Else
                    tvTreeView.Nodes.Add "_" & Format(rst1![fatherclass], "00000"), tvwChild, "_" & Format(rst1![ID], "00000"), rst1![Name], 3, 4
                End If
                rst1.MoveNext
            Loop
            rst1.Close
    End Select
End Sub

Private Sub tvTreeView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
      Me.PopupMenu FrmMainBrow.ywj01
End If
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
On Error Resume Next
Me.MousePointer = 11
Dim itmX As ListItem
Dim i As Long
Dim rst1 As New ADODB.Recordset
    i = Mid(Node.Key, 2, 100)
    lvListView.ListItems.Clear
        
    str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffclass=" & i & " and " & " libclass = '" & viewflag & "' order by stuffdatatable.id"
    rst1.Open str, GetConnect, adOpenForwardOnly, adLockReadOnly
    Do Until rst1.EOF
        Set itmX = lvListView.ListItems.Add(, "_" & Format(rst1![ID], "00000"), Format(rst1![ID], "00000"), 2, 2)
        
        If Not IsNull(rst1![helpcode]) Then
           itmX.SubItems(1) = CStr(Trim(rst1![helpcode]))
        End If
        If Not IsNull(rst1![Name]) Then
           itmX.SubItems(2) = CStr(Trim(rst1![Name]))
        End If
        If Not IsNull(rst1![kind]) Then
           itmX.SubItems(3) = CStr(Trim(rst1![kind]))
        End If
        If Not IsNull(rst1![color]) Then
           itmX.SubItems(4) = CStr(Trim(rst1![color]))
        End If
        If Not IsNull(rst1![unit]) Then
           itmX.SubItems(5) = CStr(Trim(rst1![unit]))
        End If
        If Not IsNull(rst1![stuffclass]) Then
            itmX.SubItems(6) = CStr(Trim(rst1![stuffclass]))
        End If
        If Not IsNull(rst1![libclass]) Then
            itmX.SubItems(7) = CStr(Trim(rst1![libclass]))
        End If
        If Not IsNull(rst1![initlib]) Then
            itmX.SubItems(8) = CStr(rst1![initlib])
        End If
        If Not IsNull(rst1![supply]) Then
            itmX.SubItems(9) = CStr(rst1![supply])
        End If
        rst1.MoveNext
    Loop
    rst1.Close
    Me.Label2.Caption = IIf(viewflag = "A", "常用", IIf(viewflag = "B", "不常用", "呆货")) & "  品名资料    " & IIf(Me.lvListView.ListItems.Count <> 0, "共 " & Me.lvListView.ListItems.Count & " 种", "")
    lvListView.Refresh
    Me.MousePointer = 0
End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -