frmvouchervolume.frm

金算盘软件代码

        blnKeyDown = True
        If SaveCard Then
            mblnIsChanged = False
            Unload Me
        End If
    Case 1
        If Me.ActiveControl.Name = "txtInput" Then
            cmdOk(0).SetFocus
            Exit Sub
        End If
        mblnIsChanged = False
        blnKeyDown = True
        Unload Me
    Case 2
        mnuNew_Click
    Case 3
        mnuDel_Click
    Case 4 '打印
        blnKeyDown = True
        If SaveCard Then
            mblnIsChanged = False
        Else
            Exit Sub
        End If
        Dim myPrintclass As PrintClass
        Dim strHead As String
        Dim strFooter As String
        Set myPrintclass = New PrintClass
        strHead = "会计期间：" & lstInput(0).Text & "  " & "凭证类型：" & lstInput(1).TextMatrix(lstInput(1).ReferRow, 3)
        strFooter = lblNote(2).Caption & lblNote(3).Caption
        myPrintclass.PrintList gclsBase.BaseDB, GrdCol, 34, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & Chr(2) & strHead & Space(2) & strFooter
        Set myPrintclass = Nothing
    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)
    If Index <> 1 And Index <> 3 Then
        SaveInput2Form
'        If DataValid1() = False Then Exit Sub
    End If
    If Index <> 2 Then
        txtInput.ZOrder 1
    End If
    blnNotEntercell = True
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
    GrdCol_RowColChange
    lstInput(0).SetFocus
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
End Sub

Private Sub Form_Load()
    
    Me.HelpContextID = 30021
    SetForm 16
    Utility.LoadFormResPicture Me
    cmdOk(4).Picture = Utility.GetFormResPicture(1012, 0)
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = GrdCol.hwnd
    Set KeyPressHook = New Hook
    KeyPressHook.SetHookAll Me.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    txtInput.BackColor = GrdCol.BackColor
    txtInput.Appearance = 0
    txtInput.Visible = False
    GrdCol.RowHeightMin = 16 * Screen.TwipsPerPixelY
    GrdCol.Cols = 5
    GrdCol.TextMatrix(0, 1) = "凭证册号"
    GrdCol.TextMatrix(0, 2) = "凭证起始编号"
    GrdCol.TextMatrix(0, 3) = "凭证结束编号"
    GrdCol.TextMatrix(0, 4) = "已分册凭证张数"
    GrdCol.ColWidth(0) = 0
    GrdCol.ColWidth(1) = 1000
    GrdCol.ColWidth(2) = 1400
    GrdCol.ColWidth(3) = 1400
    GrdCol.ColWidth(4) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - GrdCol.ColWidth(3) - 5 * Screen.TwipsPerPixelX
    GrdCol.ColAlignment(1) = flexAlignRightCenter
    GrdCol.ColAlignment(2) = flexAlignRightCenter
    GrdCol.ColAlignment(3) = flexAlignRightCenter
'    grdCol.ColAlignment(4) = flexAlignRightCenter
    GrdCol.ColAlignment(4) = flexAlignCenterCenter
    Dim i As Long
    For i = 1 To GrdCol.Cols - 1
        GrdCol.FixedAlignment(i) = flexAlignCenterCenter
    Next i
    
    txtInput.Height = 16 * Screen.TwipsPerPixelY
'    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
            cmdOk(0).SetFocus
            Cancel = 1
            Exit Sub
        End If
        If mblnExit = False Then
            blnKeyDown = True
            cmdOk(0).SetFocus
            Cancel = 1
            Exit Sub
        End If
    Else
        cmdOk(0).SetFocus
    End If
    
    SaveInput2Form
'    If DataValid1() = False Then Exit Sub
    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_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 GrdCol_RowColChange()
    If Me.Visible = False Then Exit Sub
    If GrdCol.Row = GrdCol.Rows - 1 Then
'        cmdOK(2).Enabled = True
        cmdOk(3).Enabled = True
    Else
'        cmdOK(2).Enabled = False
        cmdOk(3).Enabled = False
    End If
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 InsertARow
                    If GrdCol.Row <= 0 Then GrdCol.Row = 1
                    If GrdCol.col <> 1 And GrdCol.col <> 3 Then GrdCol.col = 1
                    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 = "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
                    SaveInput2Form
                    If DataValid1() = False Then
                        blnBusy = False
                        Exit Sub
                    End If
                    If wParam = 38 Then
                        If mlngRow > 1 Then
                            GrdCol.Row = mlngRow - 1
                            EnterCell
                        Else
                            lstInput(0).SetFocus
                        End If
                    ElseIf wParam = 40 Then
                        If mlngRow < GrdCol.Rows - 1 Then
                            GrdCol.Row = mlngRow + 1
                            EnterCell
                        ElseIf Trim(GrdCol.TextMatrix(mlngRow, 1)) <> "" Then
                            InsertARow
                            GrdCol.Row = GrdCol.Rows - 1
                            GrdCol.col = 1
                            EnterCell
                        Else
                            cmdOk(0).SetFocus
                        End If
                    ElseIf wParam = 37 Then
                        If mlngCol > 1 Then
                            GrdCol.col = 1
                            EnterCell
                        End If
                    ElseIf wParam = 39 Then
                        cmdOk(0).SetFocus
                    End If
                ElseIf Me.ActiveControl.Name = "cmdOK" Then
                    If wParam = 37 Then
                        If GrdCol.Row <= 0 Then GrdCol.Row = 1
                        If GrdCol.col < 1 Or GrdCol.col > 3 Then GrdCol.col = 1
                        mlngRow = GrdCol.Row
                        mlngCol = GrdCol.col
                        EnterCell
                    ElseIf wParam = 38 Then
                        If Me.ActiveControl.Index = 0 Then cmdOk(0).SetFocus
                    ElseIf wParam = 40 Then
                        If Me.ActiveControl.Index = cmdOk.Count - 1 Then cmdOk(cmdOk.Count - 1).SetFocus
                    End If
                Else
                '    cmdOK(0).SetFocus
                End If
                blnBusy = False
        End If
        If wParam = 9 Or wParam = 13 Then        'TAB键处理程序
            If Not blnBusy Then
                blnBusy = True
                If (GetKeyState(16) = -127 Or GetKeyState(16) = -128) Then
                    If Me.ActiveControl.Name = "txtInput" Then
                        SaveInput2Form
                        If DataValid1() = False Then
                            blnBusy = False
                            Exit Sub
                        End If
                        If mlngCol > 1 Then
                            GrdCol.col = 1
                            EnterCell
                        ElseIf mlngRow > 1 Then
                            GrdCol.col = 3
                            GrdCol.Row = mlngRow - 1
                            EnterCell
                        Else
                            lstInput(1).SetFocus
                        End If
                    ElseIf Me.ActiveControl.Name = "cmdOK" Then
                        If wParam = 9 Then
                            If Me.ActiveControl.Index = 0 Then
                                GrdCol.col = 1
                                If GrdCol.Rows = 1 Then InsertARow
                                GrdCol.Row = GrdCol.Rows - 1
                                mlngRow = GrdCol.Row
                                mlngCol = GrdCol.col
                                EnterCell
                            Else
                                cmdOk(Me.ActiveControl.Index - 1).SetFocus
                            End If
                        End If