frmlistpurchase.frm

金算盘软件代码

    Set mclsList.Again = cmdAgain
    
    mclsList.ListSet.ViewId = intViewID
    mclsList.InitFlexGrid
'    If mclsList.ListSet.ListID < 1 Then
'        'mclsList.SaveListSet
'        gclsBase.DateOfPeriod gclsBase.AccountYear, gclsBase.Period, BeginDate, EndDate '当前时间对应的会计期间
'        'DefaultWhere intFormType, mclsList.ListSet.ListID
'    End If
    '得到付款条件列表记录集
'    Debug.Print "Purchase Form_load Start:" & time
'    Set datGrid.Recordset = GetList()
'
'    If Not datGrid.Recordset.EOF Then datGrid.Recordset.MoveLast
'    datGrid.Recordset.Close
'    Debug.Print "Purchase Form_load End:" & time
'    mclsList.SetFlexGrid
''    HideColOfMe Me
'    '初始化查找复合列表框
'    mclsList.InitcboFindKind
'    mclsList.FlexNoChange = False
'    mclsList.FindNoChange = False
'    '设置第一行为选定行
'    With grdList
'        If .Rows > 1 Then grdList.Row = 1
'        .col = 0
'        .ColSel = .Cols - 1
'    End With
'    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = grdList.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Unload MsgForm
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
       ' Me.SetFocus
        UpdateMenuStatus
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If (UnloadMode = vbFormControlMenu Or UnloadMode = vbFormCode) _
'        And lngFormHwnd(intFormType + 1) > 0 Then
'       cMsgBox "请先关闭" & strTypeName & "的编辑窗口 ！"
'        Cancel = True
'        frmEdit.SetFocus
'    End If
    If mblnFinish Then Cancel = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If mclsList.ListSet.ListID < 1 Then
        mclsList.SaveListSet
        DefaultWhere intFormType, mclsList.ListSet.ListID
    Else
        mclsList.SaveListSet
    End If
    'Filter.DelSelectedCond mclsList.ListSet.ListID, 1 '删除过滤条件
    blnMenuBuilded = False
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    Set mclsList = Nothing
    Set mclsPurchase = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    frmMain.mnuTaskPurchase.Tag = 0
    
    Select Case intFormType
    Case 1 '"商品采购单"
        frmMain.mnuTaskPurchase.Tag = 0
    Case 2 '"直运采购单"
        frmMain.mnuTaskDirectPurchase.Tag = 0
    Case 3 '"受托入库单"
        frmMain.mnuTaskBorrowIn.Tag = 0
    Case 4 '"受托结算单"
        frmMain.mnuTaskBorrowPurchase.Tag = 0
    Case 5 '"加工入库单"
        frmMain.mnuInventoryEntrustIn.Tag = 0
    Case 6 '"加工费用单"
        frmMain.mnuInventoryEntrustExpense.Tag = 0
    Case 7 '"采购发票"
        frmMain.mnuTaskPurchaseInvoice.Tag = 0
    Case 8 '"自制入库单"
        frmMain.mnuInventoryIn.Tag = 0
    Case 9 '"盘盈入库单"
        frmMain.mnuInventoryCheckUp.Tag = 0
    Case 10 '"其他入库单"
        frmMain.mnuInventoryOtherIn.Tag = 0
    End Select
'    Set frmStockSales(intFormType + 1) = Nothing
    Set frmEdit = Nothing
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) And Me.WindowState <> 2 Then
        Me.Left = 300
    End If
    RedrawForm
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub
Private Sub Form_Activate()
    
    'grdList.SetFocus
    SetHelpID Me.HelpContextID
    grdList.Redraw = True
    
    strOldMenuCaption = frmMain.mnuEditInActive.Caption
    frmMain.mnuEditInActive.Caption = "作废(&H)"
    frmMain.mnuEditShowAll.Caption = "全部显示(&W)"
    MakeListEditMenu
    MakeListEditMenu
    MakeListReportMenu
    gclsSys.CurrFormName = Me.hwnd
    mclsMainControl_ChildActive
    
    UpdateMenuStatus
    blnMenuBuilded = True
    frmMain.mnuEditSearch.Enabled = False
    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub
'响应消息
Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    If gclsBase.OperatorID <> lngOldOperatorID Then '系统重新登录（更换了操作员）
        lngOldOperatorID = gclsBase.OperatorID
        Select Case intFormType
        Case 1 '"商品采购单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_1) '判断有无编辑权限
        Case 2 '"直运采购单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_2)
        Case 3 '"受托入库单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_3)
        Case 4 '"受托结算单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_4)
        Case 5 '"加工入库单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_5)
        Case 6 '"加工费用单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_6)
        Case 7 '"采购发票"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_7)
        Case 8 '"自制入库单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_8)
        Case 9 '"盘盈入库单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_9)
        Case 10 '"其他入库单"
            blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_10)
        End Select
    End If
    
    '响应消息:
    '    msgReceipt2 = 32                            '商品采购
    '    msgReceipt3 = 33                            '直运采购
    '    msgReceipt4 = 34                            '受托入库
    '    msgReceipt5 = 35                            '受托结算
    '    msgReceipt6 = 36                            '加工入库
    '    msgReceipt7 = 37                            '加工费用
    '    msgReceipt8 = 38                            '采购发票
    '    msgReceipt9 = 39                            '自制入库
    '    msgReceipt10 = 40                           '盘盈入库
    '    msgReceipt11 = 41                           '其他入库
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = 31 + intFormType Then
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
        End If
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuEditInActive.Caption = strOldMenuCaption
    blnMenuBuilded = False
    frmMain.mnuEditSearch.Enabled = False
    frmMain.mnuFilePrintReceipt.Enabled = False
    frmMain.SetEditUnEnabled
End Sub

'查找条件类型 ComboBox 控件
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    mclsList.ReGetColCaption
    With grdList
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                '保存新排序列内容
                If .RowHeight(.Row) = 0 Then
                    strFind = ""
                Else
                    strFind = .TextMatrix(.Row, i)
                End If
                '重新排序
                mclsList.FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    '恢复以前选定行
    If grdList.Rows > 1 Then
        If txtFind.Text = strFind Then
            txtFind_Change
        Else
            txtFind.Text = strFind
        End If
    End If
    grdList.Redraw = True
End Sub

Private Sub txtFind_Change()
    mclsList.TextFind txtFind.Text
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    If txtFind.Text = "" Then Exit Sub
    If KeyCode = 8 Then
        intSelLen = txtFind.SelLength
        If txtFind.SelStart > 0 Then txtFind.SelStart = txtFind.SelStart - 1
        txtFind.SelLength = intSelLen + 1
    End If
End Sub

Private Sub grdList_DblClick()
    If grdList.Row > 0 And grdList.MouseRow > 0 And grdList.ColSel > 0 And grdList.MouseCol > 1 Then
        bDblClick = True
        'If frmMain.mnuEditEdit.Enabled = False Then Exit Sub
        mclsMainControl_EditEdit
    End If
End Sub

'弹出右键菜单
Private Sub grdlist_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With grdList
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

'鼠标左键弹起时，更新菜单
Private Sub grdList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With grdList
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    mclsMainControl_EditInActive
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'显示全部记录/未停用记录 CheckBox 控件
Private Sub chkShowAll_Click()
    grdList.Redraw = False
    mclsList.DoShowAll chkShowAll.Value
    grdList.Redraw = True
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    UpdateMenuStatus
End Sub

Private Sub cmdEdit_Click()
    UpdateMenuStatus
    PopupMenu frmMain.mnuListEdit, , cmdEdit.Left, cmdEdit.top + cmdEdit.Height
End Sub

Private Sub cmdReport_Click()
    MakeListReportMenu
    PopupMenu frmMain.mnuListReport, , cmdReport.Left, cmdReport.top + cmdReport.Height
End Sub

'/////////////////////////////////////////////////////////////////////////////////
'////////
'////////
'////////                            按纽菜单
'////////
'////////
'/////////////////////////////////////////////////////////////////////////////////

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    Dim i As Integer
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        For i = 1 To 14
            Load .mnuListEditMenu(i)
        Next i
    End With
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0: '修改
        mclsMainControl_EditEdit