frmitemlist.frm

金算盘软件代码

    cmdTypact(4).top = cmdTypact(0).top
    cmdTypact(5).top = cmdTypact(0).top
    chkShowAll.top = cmdTypact(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
'    #If conVersionType = 16 Then
'        cmdTypact(2).Visible = False
'        cmdTypact(3).Visible = False
'        cmdTypact(4).Visible = False
'    #Else
'        cmdTypact(2).Visible = True
'        cmdTypact(3).Visible = True
'        cmdTypact(4).Visible = True
'    #End If
'    #If conQuanDisc <> -1 Then
'        cmdTypact(5).Visible = False
'    #Else
'        cmdTypact(5).Visible = True
'    #End If
End Sub


Private Sub clePaste_KeyPress(ByVal KeyAscii As Integer)
   Dim intCurrentOfPaste As Integer
'   Dim intUnitCol As Integer
   intCurrentOfPaste = GetCol("外库数量", 5)
'   intUnitCol = GetCol("常用计量单位", 5)
'   If KeyAscii <> 13 And KeyAscii <> 8 And KeyAscii <> 46 And (KeyAscii < 48 Or KeyAscii > 57) Then
'        BKKEY clePaste.hwnd
'   End If
If sstTypAct.Tab = 5 Then
   If KeyAscii = 13 Then
        clePaste.Left = -30000
'        With msgStock
'            If SaveOutStock(clePaste.Text, ListID(5)) Then .TextMatrix(mintCurrentOfPaste, intCurrentOfPaste) = displaydata(me.hwnd,clePaste.Text,) & "(" & Trim(.TextMatrix(mintCurrentOfPaste, intUnitCol)) & ")"
'        End With
        With mclsList(5).FlexGrid
            SaveOutStock clePaste.Text, CLng(.TextArray(mintCurrentOfPaste * .Cols))
        End With
   End If
End If
End Sub

Private Sub clePaste_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
    Dim intCol As Integer
    intCol = GetCol("外库数量", 5)
    If Shift = 1 And (KeyCode = vbKeyUp Or KeyCode = vbKeyDown) And mblnPasteVisible Then
        With msgStock
            SaveOutStock clePaste.Text, CLng(.TextArray(mintCurrentOfPaste * .Cols))
            If .Row < .Rows - 1 And KeyCode = vbKeyDown Then .Row = .Row + 1
            If .Row > 1 And KeyCode = vbKeyUp Then .Row = .Row - 1
        End With
        PasteControl intCol
    End If
End Sub

Private Sub clePaste_LostFocus()
'    If Not mblnScrollMissFocus Then
'    Dim intUnitCol As Integer
    
'    intUnitCol = GetCol("常用计量单位", 5)
    mblnPasteVisible = False
'    End If
'    clePaste.Visible = False
    clePaste.Left = -30000
'    With msgStock
'        If SaveOutStock(clePaste.Text, ListID(5)) Then .TextMatrix(mintCurrentOfPaste, intCurrentOfPaste) = CStr(Val(clePaste.Text)) & "(" & Trim(.TextMatrix(mintCurrentOfPaste, intUnitCol)) & ")"
'    End With
     With mclsList(5).FlexGrid
        SaveOutStock clePaste.Text, CLng(.TextArray(mintCurrentOfPaste * .Cols))
     End With
'    mblnScrollMissFocus = False
End Sub

'命令控件数组
Private Sub cmdTypact_Click(Index As Integer)
    Dim PosX, PosY As Integer
    
    PosX = cmdTypact(Index).Left
    PosY = cmdTypact(Index).top + cmdTypact(Index).Height
    With frmMain
        Select Case Index
               Case 0
                    MakeListEditMenu
                    mblnCardEdit = False
                    mblnCardNew = False
                    PopupMenu .mnuListEdit
                    If mblnCardNew Then mclsMainControl_EditNew
                    If mblnCardEdit Then mclsMainControl_EditEdit
               Case 1
                    MakeListReportMenu (getDepEmp())
                    PopupMenu .mnuListReport, , PosX, PosY
                Case 2
                    #If conVersionType <> 16 Then
                        ItemBegin
                    #End If
                Case 3
                    If mfrmFanceAnanly Is Nothing Then Set mfrmFanceAnanly = New frmBudgetList
                    mfrmFanceAnanly.ShowList 1
                Case 4
                    frmAdaptCard.ShowCard
                Case 5
                    With frmItemDiscListCard
                        .Show
                        .ZOrder 0
                    End With
        End Select
    End With
End Sub

'取部门职员
Private Function getDepEmp() As String
    Dim strDepEmp As String
    Dim i As Integer
    
    Select Case sstTypAct.Tab
           Case 0
                If msgItemType.Row > 0 And msgItemType.ColSel > 0 Then
                    With msgItemType
                      .Redraw = False
                      For i = 1 To .Cols - 1
                          If .TextMatrix(0, i) = "商品类型名称" Or .TextMatrix(0, i) = "商品类型名称↑" Or .TextMatrix(0, i) = "商品类型名称↓" Then
                             strDepEmp = .TextMatrix(.Row, i)
                             Exit For
                          End If
                      Next
                      .Redraw = True
                    End With
                Else
                   strDepEmp = ""
                   
                End If
           Case 1
                If msgItem.Row > 0 And msgItem.ColSel > 0 Then
                   With msgItem
                        .Redraw = False
                        For i = 1 To .Cols - 1
                            If .TextMatrix(0, i) = "商品名称" Or .TextMatrix(0, i) = "商品名称↑" Or .TextMatrix(0, i) = "商品名称↓" Then
                               strDepEmp = .TextMatrix(.Row, i)
                               Exit For
                            End If
                        Next
                        .Redraw = True
                   End With
                Else
                    strDepEmp = ""
                End If
            
    End Select
    getDepEmp = strDepEmp
    
End Function



Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    On Error GoTo ErrHandle
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    Me.HelpContextID = 30018
    '部门职员列表窗体初始化
    Debug.Print "Load Start: ", Timer
    
    intViewID(0) = 54
    intViewID(1) = 368
    intViewID(2) = 55
    intViewID(3) = 61
    intViewID(4) = 53
    intViewID(5) = 1031
    For i = 0 To 5
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        'Set mclsList(i).Again = cmdAgain
        Set mclsList(i).Find = txtfind
    Next
    Set mclsList(0).FlexGrid = msgItemType
    Set mclsList(1).FlexGrid = msgItemNature
    Set mclsList(2).FlexGrid = msgItem
    Set mclsList(3).FlexGrid = msgTax
    Set mclsList(4).FlexGrid = msgPostion
    Set mclsList(5).FlexGrid = msgStock
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    mblnPasteVisible = False
    mblnScrollMissFocus = False
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass
    
    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
    
'    If sstTypAct.Tab = 0 Then
'        sstTypAct_Click 0
'    Else
'        sstTypAct.Tab = 0
'    End If
'    #If conVersionType = 16 Then
'        sstTypAct.TabVisible(4) = False
'    #Else
'        sstTypAct.TabVisible(4) = True
'    #End If
'    #If conTest <> 1 Then
'        sstTypAct.TabVisible(5) = False
'    #Else
'        sstTypAct.TabVisible(5) = True
'    #End If
    Debug.Print "Load End: ", Timer
    Unload MsgForm
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         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
        MakeListEditMenu
        mblnCardEdit = False
        mblnCardNew = False
        PopupMenu frmMain.mnuListEdit
        If mblnCardNew Then mclsMainControl_EditNew
        If mblnCardEdit Then mclsMainControl_EditEdit
    End If
End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.width - 2 * (ListFormLeft + ListFormRight), 500
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_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
       Select Case True
        Case mIsShowCard(0)
            ShowMsg Me.hwnd, "请先关闭商品类型卡片！", vbExclamation + MB_TASKMODAL, "商品类型卡片"
            Cancel = True
'            frmItemTypeListCard.Show
'            frmItemTypeListCard.ZOrder 0
        Case mIsShowCard(1)
            ShowMsg 0, "请先关闭商品卡片！", vbExclamation + MB_TASKMODAL, "商品卡片"
            Cancel = True
'            frmItemListCard.Show
'            frmItemListCard.ZOrder 0
        Case mIsShowCard(2)
            ShowMsg 0, "请先关闭调整商品价格卡片！", vbExclamation + MB_TASKMODAL, "调整商品价格卡片"
            Cancel = True
            frmAdaptCard.Show
            frmAdaptCard.ZOrder 0
        Case mIsShowCard(3)
            ShowMsg 0, "请先关闭商品性质卡片！", vbExclamation + MB_TASKMODAL, "商品性质卡片"
            Cancel = True
'            frmItemNatureListCard.Show
'            frmItemNatureListCard.ZOrder 0
        Case mIsShowCard(4)
            MsgBox "请先关闭商品税率卡片！", vbExclamation
            Cancel = True
'            frmItemTaxListCard.Show
'            frmItemTaxListCard.ZOrder 0
        Case mIsShowCard(5)
            MsgBox "请先关闭商品货位卡片！", vbExclamation
            Cancel = True
'            frmPositionListCard.Show
'            frmPositionListCard.ZOrder 0
'        Case mIsShowCard(6)
'            MsgBox "请先关闭经营预算列表！", vbExclamation
'            Cancel = True
'            mfrmFanceAnanly.Show
'            mfrmFanceAnanly.ZOrder 0
       End Select
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    Debug.Print "End1" & Time
    On Error Resume Next
'    If mIsShowCard(0) Then Unload frmItemTypeListCard
'    If mIsShowCard(1) Then Unload frmItemListCard
    If mIsShowCard(2) Then Unload frmAdaptCard
'    If mIsShowCard(3) Then Unload frmItemNatureListCard
'    If mIsShowCard(4) Then Unload frmItemTaxListCard
'    If mIsShowCard(5) Then Unload frmPositionListCard
    For intCount = 0 To sstTypAct.Tabs - 1
        If blnIsLoad(intCount) Then
            mclsList(intCount).SaveListSet
        End If
        blnIsLoad(intCount) = False
        Set mclsList(intCount) = Nothing
    Next
    '    blnIsLoad(0) = False
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    Debug.Print "Endh1" & Time
    gclsSys.MainControls.Remove Me
    Debug.Print "Endh2" & Time
    Set mclsMainControl = Nothing
    Set mfrmFanceAnanly = Nothing
    Debug.Print "End2" & Time
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
       Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Activate()
    SetHelpID 30018
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
    'If mclsList(sstTypAct.Tab).FlexGrid.Enabled Then mclsList(sstTypAct.Tab).FlexGrid.SetFocus
    mclsList(sstTypAct.Tab).FlexGrid.Redraw = True
    UpdateMenuStatus
    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

'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
    With sstTypAct
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).DoShowAll chkShowAll.Value
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
    UpdateMenuStatus
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String