frmvouchercashflow.frm

金算盘软件代码

    ShowCashFlow = True
End Function

Private Sub InitPasteLst(Optional lngID As Long = 0)
    Dim strSql As String, lngItemID As Long
    lstInput.ClearRefer
    lstInput.SeekCol = "1,2"
    If GrdCol.TextMatrix(GrdCol.Row, 1) = "流入" Then
        lngItemID = 1
    ElseIf GrdCol.TextMatrix(GrdCol.Row, 1) = "流出" Then
        lngItemID = 2
    ElseIf lblNote(3).Caption = "流入" Then
        lngItemID = 1
    ElseIf lblNote(3).Caption = "流出" Then
        lngItemID = 2
    Else
    End If
     strSql = "SELECT lngCashItemID,strCashItemCode || ' ' || strCashItemName FROM CashItem WHERE  strCashItemCode<>' '" _
        & " AND lngCashFlowType=" & lngItemID & " ORDER BY strCashItemCode "
   lstInput.SQL = strSql
    Set lstInput.Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    lstInput.AddRefer "<新增>"   '设置固定选项
    lstInput.AddRefer "<删除>"
    lstInput.AddRefer "<修改>"
    If lngID <> 0 Then
        lstInput.SeekId lngID
    End If
End Sub

Private Sub cmdOK_Click(Index As Integer)
    Debug.Print "click"
    Dim strNextCode As String
    mblnExit = True
    Select Case Index
    Case 0
        blnKeyDown = True
        If SaveCard Then
            mblnIsChanged = False
            Unload Me
        End If
    
    Case 1
        mblnIsChanged = False
        blnKeyDown = True
        Unload Me
    Case 2
        mnuNew_Click
    Case 3
        mnuDel_Click
    End Select
End Sub
Private Sub SetForm(ByVal iVer As Integer)
    Dim i As Integer
        GrdCol.TabStop = False
End Sub

Private Sub cmdOK_GotFocus(Index As Integer)
    Debug.Print "getfocus"
    lstInput.Visible = False
    txtInput.Visible = False
    blnNotEntercell = True
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Form_key_Down KeyCode
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 93 Then
        GrdCol_Mouseup vbRightButton, 0, 0, 0
        Exit Sub
    End If
        If (Shift And vbCtrlMask) > 0 Then
            If KeyCode = Asc("d") Or KeyCode = Asc("D") Then mnuDel_Click
            If KeyCode = Asc("a") Or KeyCode = Asc("A") Then mnuNew_Click
        End If
End Sub

Private Sub Form_Load()
    
    Me.HelpContextID = 30021
    SetForm 16
    Utility.LoadFormResPicture Me
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = GrdCol.hwnd
    Set KeyPressHook = New Hook
    KeyPressHook.SetHookAll Me.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    lstInput.BackColor = GrdCol.BackColor
    txtInput.BackColor = GrdCol.BackColor
    GrdCol.RowHeightMin = 16 * Screen.TwipsPerPixelY
    txtInput.Height = 16 * Screen.TwipsPerPixelY
    lstInput.Height = 16 * Screen.TwipsPerPixelY
    lstInput.AutoPop = True
    lstInput.CodeSort = True
'    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
'    mclsSubClass.Messages(WM_LBUTTONUP) = True

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
        
    If UnloadMode <> vbFormControlMenu Then
        If blnKeyDown = False Then
            blnKeyDown = True
            If lstInput.ReferVisible Then
                lstInput.PopRefer False
            Else
                cmdOk(0).SetFocus
            End If
            Cancel = 1
            Exit Sub
        End If
    Else
        cmdOk(0).SetFocus
    End If
    If mblnIsChanged Then
            strMess = "是否保存资金流量分配？"
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mclsSubClass = Nothing
    Set KeyPressHook = Nothing
    mblnIsChanged = False
    Unload Me
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub GrdCol_Click()
    If GrdCol.Row >= 1 Then
        If GrdCol.col = 1 Then
            If GrdCol.TextMatrix(GrdCol.Row, 1) = "流入" Then
                GrdCol.TextMatrix(GrdCol.Row, 1) = "流出"
            Else
                GrdCol.TextMatrix(GrdCol.Row, 1) = "流入"
            End If
            GrdCol.TextMatrix(GrdCol.Row, 2) = ""
            GrdCol.TextMatrix(GrdCol.Row, 3) = ""
            GrdCol.TextMatrix(GrdCol.Row, 4) = ""
            lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
            lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - TotalAmount(), FormatString(gclsBase.NaturalCurDec))
            mblnIsChanged = True
            GrdCol.col = 2
            EnterCell
        End If
    End If
End Sub

Private Sub grdCol_GotFocus()
    If blnNotEntercell Then Exit Sub
    EnterCell
End Sub

Private Sub Form_key_Down(ByVal KeyCode As Long)
    Dim bCancel As Long
    KeyPressHook_OnMessage Me.hwnd, WM_KEYDOWN, KeyCode, 0, bCancel
End Sub

Private Sub KeyPressHook_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    If Msg = WM_KEYDOWN Or Msg = WM_KEYUP Or Msg = WM_CHAR Then
        If blnBusy Then
            bCancel = 1
            Exit Sub
        End If
    End If
    If Msg = WM_KEYUP Or Msg = WM_CHAR Then
        If Msg = 27 Then
            If mblnExit = False Then
               ' bCancel = 1
                Exit Sub
            End If
        
        End If
    End If
        
    If Msg = WM_KEYDOWN Then
        If Me.ActiveControl.Name = "cmdOK" Then
                 If wParam = 37 Then
                    If GrdCol.Rows = 1 Then
                        GrdCol.Rows = 2
                        GrdCol.TextMatrix(1, 1) = lblNote(3).Caption
                    End If
                    If GrdCol.Row <= 0 Then GrdCol.Row = 1
                    If GrdCol.col <> 2 And GrdCol.col <> 3 Then GrdCol.col = 2
                    EnterCell
                ElseIf wParam = 38 Then
                    If Me.ActiveControl.Index = 0 Then
                        cmdOk(0).SetFocus
                        bCancel = 1
                    End If
                ElseIf wParam = 40 Then
                    If Me.ActiveControl.Index = cmdOk.Count - 1 Then
                        cmdOk(cmdOk.Count - 1).SetFocus
                        bCancel = 1
                    End If
                ElseIf wParam = 9 Then
                    If Me.ActiveControl.Index = cmdOk.Count - 1 Then
                        cmdOk(cmdOk.Count - 1).SetFocus
                        bCancel = 1
                    End If
                
                End If
                If wParam = 13 Then
                    mblnExit = True
                Else
                    mblnExit = False
                End If
                blnNotEntercell = True
        ElseIf Me.ActiveControl.Name = "lstInput" Then
            blnNotEntercell = True
            If lstInput.ReferVisible Then
                If wParam = 27 Then
                    mblnExit = False
                    blnKeyDown = False
            '        bCancel = 1
                    Exit Sub
                ElseIf wParam = 13 Then
                    mblnExit = False
                Else
                    mblnExit = True
                End If
            Else
                If wParam = 27 Then
                    mblnExit = False
                    blnKeyDown = False
            '        bCancel = 1
                    Exit Sub
                ElseIf wParam = 37 Then
                    mblnExit = True
                ElseIf wParam = 39 Then
                    If lstInput.SelStart = Len(lstInput.Text) Then
                        mblnExit = False
                    Else
                        mblnExit = True
                    End If
                ElseIf wParam = 13 Or wParam = 9 Then
                    mblnExit = False
                ElseIf wParam = 38 Or wParam = 40 Then
                    mblnExit = False
                ElseIf wParam = 9 Or wParam = 13 Then
                    mblnExit = False
                Else
                    mblnExit = True
                End If
            End If
        ElseIf Me.ActiveControl.Name = "txtInput" Then
            blnNotEntercell = True
                If wParam = 27 Then
                    mblnExit = False
                    blnKeyDown = False
            '        bCancel = 1
                    Exit Sub
                ElseIf wParam = 37 Then
                    If txtInput.SelStart = 0 Then
                        mblnExit = False
                    Else
                        mblnExit = True
                    End If
                ElseIf wParam = 39 Then
                    If txtInput.SelStart = Len(txtInput.Text) Then
                        mblnExit = False
                    Else
                        mblnExit = True
                    End If
                ElseIf wParam = 13 Or wParam = 9 Then
                    mblnExit = False
                ElseIf wParam = 38 Or wParam = 40 Then
                    mblnExit = False
                Else
                    mblnExit = True
                End If
        Else
            mblnExit = False
        End If
    End If
    
    If Msg = WM_KEYUP Then
        If mblnExit Then Exit Sub
        mblnExit = False
        If wParam = 33 Or wParam = 34 Or wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40 Then        'TAB键处理程序
          ' wParam = 33--PageUp / wParam = 34---PageDown / 13---enter
                blnBusy = True
                If Me.ActiveControl.Name = "txtInput" Then
                    txtInput_LostFocus
                    If wParam = 38 Then
                        If GrdCol.Row > 1 Then
                            GrdCol.Row = GrdCol.Row - 1
                            EnterCell
                        Else
                            cmdOk(0).SetFocus
                        End If
                    ElseIf wParam = 40 Then
                        If GrdCol.Row < GrdCol.Rows - 1 Then
                            GrdCol.Row = GrdCol.Row + 1
                            EnterCell
                        ElseIf C2lng(GrdCol.TextMatrix(GrdCol.Row, 4)) <> 0 Then
                            GrdCol.Rows = GrdCol.Rows + 1
                            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
                            If GrdCol.Rows > 17 Then
                                GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - (20) * Screen.TwipsPerPixelX
                            Else
                                GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - 5 * Screen.TwipsPerPixelX
                            End If
                            GrdCol.Row = GrdCol.Rows - 1
                            GrdCol.col = 2
                            EnterCell
                        Else
                            GrdCol.col = 2
                            If GrdCol.Rows > 1 Then GrdCol.Row = 1
                            DoEvents
                            cmdOk(0).SetFocus
                        End If
                    ElseIf wParam = 37 Then
                        GrdCol.col = 2
                        EnterCell
                    ElseIf wParam = 39 Then
                        DoEvents
                        cmdOk(0).SetFocus
                    End If
                ElseIf Me.ActiveControl.Name = "cmdOK" Then
                    If wParam = 37 Then
                        If GrdCol.Rows = 1 Then