frmpayment.frm

金算盘软件代码

      BackStyle       =   0  'Transparent
      Caption         =   "付款单"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004000&
      Height          =   360
      Left            =   300
      TabIndex        =   21
      Top             =   480
      Width           =   1080
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   150
      TabIndex        =   20
      Top             =   1110
      UseMnemonic     =   0   'False
      Visible         =   0   'False
      Width           =   825
   End
   Begin VB.Label lblFieldCaption 
      Alignment       =   2  'Center
      BackColor       =   &H80000002&
      Caption         =   "标题"
      ForeColor       =   &H8000000E&
      Height          =   195
      Index           =   0
      Left            =   150
      TabIndex        =   19
      Top             =   900
      UseMnemonic     =   0   'False
      Visible         =   0   'False
      Width           =   825
   End
   Begin VB.Label LblBack 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   5250
      Left            =   60
      TabIndex        =   22
      Top             =   450
      Width           =   7995
   End
End
Attribute VB_Name = "FrmPayment"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据(付款单)
'  作者：王兴元
'  日期：1998.07.2
'==================================================================================

Option Explicit
Public ReceiptTypeID  As Integer
Dim clsBill As BillSet                 '
Dim clsLst As clsListMethod         '确定凭证是否存在等的类模块
Dim WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim strColRow() As String   '单据体行复制/粘贴存储区动态数组
Dim lgID As Long
Dim srName As String
Dim srCode As String
Dim blnHaveVoucher As Boolean       '确定是否生成了凭证
Dim blnNotResize As Boolean
Dim intYesNoCancel As Integer
Dim blnIsCanEventChk_Click As Boolean

Dim blnWriteForm As Boolean     '是否是数据引入标志(不加载 MSGFORM 窗体)
Dim blnIsClose As Boolean   '关闭标志

Dim strAlpha As String
Dim lngDigit As Long
Dim lngOldAccountID As Long   '旧单子的银行存款科目ID
Dim lngOldCurrencyID As Long  '旧单子的银行存款科目币种ID
Dim strOldCurrAmount As String   '旧单子的银行存款科目原币金额
Dim strOldRate As String      '旧单子的银行存款科目汇率
Dim strOldAmount As String       '旧单子的银行存款科目本币金额
Dim blnIsClosed As Boolean  '对银行存款科目，以前是否已经关闭标志
Public lngCancelActivityID As Long '冲销单据的原单据ID存贮变量

Dim blnEdit As Boolean  '填制权限
Dim blnView As Boolean  '查询权限
Private blnPrinted As Boolean '已打印标志
Public lngSpecial As Long '是否采购付款销售收款
    
Private Sub cmbInput_Click()
    clsBill.bytRegion = FHead
    clsBill.bytIndex = 3
    clsBill.SaveInput2Form
'    clsBill.TemplateChange BillPublic.FirstId(xTemplatE, C2lng(LblHead(2).Tag))
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    clsBill.Form_key_Down KeyCode
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If clsBill Is Nothing Then Exit Sub
    If KeyCode = 93 Then
        If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FGrid1 Or clsBill.bytRegion = FPicture Then
            GrdCol_Mouseup vbRightButton, 0, 0, 0
        Else
            Form_MouseUp vbRightButton, 0, 0, 0
        End If
        Exit Sub
    End If
    
    If Shift = 2 And KeyCode = 65 Then  'CTRL+A
        If Not ChangeSaveNote() Then Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyPageDown Then
        cmdButton_Click 0
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyPageUp Then
        cmdButton_Click 1
        Exit Sub
    ElseIf Shift = 2 And KeyCode = vbKeyReturn Then
        cmdButton_Click 4
        Exit Sub
    End If
    If KeyCode <> Asc(vbTab) Then
        clsBill.Form_KeyDown KeyCode, Shift
    End If

End Sub

Private Sub Form_Load()
'----------------------------------
'    Me.Hide
'    Me.Move -5000, -5000
    If blnWriteForm = False Then MsgForm.PleaseWait
'   -------------------------------
    ReceiptTypeID = 15    '付款单ID
    If gclsSys Is Nothing Then Exit Sub
    
    Dim i As Integer
    ReDim strColRow(GrdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
    
    Set clsBill = New BillSet
    clsBill.ReceiptTypeID = ReceiptTypeID
    Set clsBill.Form = Me
    clsBill.blnSound = GetSetting(App.title, "15" + gclsBase.OperatorID, "Sound_Payment", "False")
    clsBill.blnTell = GetSetting(App.title, "15" + gclsBase.OperatorID, "Tell_Payment", "False")
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Set clsLst = New clsListMethod
    
    Me.HelpContextID = 60009
    blnNotResize = False
    FirstReceiptTypeIDAndName ReceiptTypeID, lgID, srName
    lblHead(2).Tag = lgID
    lngCancelActivityID = 0
    clsBill.blnNotFormActive = True
    Utility.LoadFormSetting Me
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    If Button = vbRightButton Then
        clsBill.blnGrdCellDoing = True
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
        clsBill.blnGrdCellDoing = True
        DoEvents
        clsBill.blnGrdCellDoing = False
    End If

End Sub

'窗体尺寸变化处理程序
Private Sub Form_Resize()
    If clsBill Is Nothing Then Exit Sub
    If Not blnNotResize Then clsBill.Form_Resize
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    If (clsBill Is Nothing) Or (gclsSys Is Nothing) Or (mclsMainControl Is Nothing) Then
        Screen.MousePointer = vbDefault
        Unload MsgForm
        Unload Me
        Exit Sub
    End If

    If clsBill.blnNotRaiseEvent Then Exit Sub
    If clsBill.blnGrdCellDoing Then
        Cancel = 1
        Exit Sub
    End If
    clsBill.SaveInput2Form
    If Not ChangeSaveNote Then
        gblnCancel = True
        Cancel = True
        Exit Sub
    End If
'存贮最后的GRID的各列的宽度
    BillPublic.SaveColWidthDefault Me
    '单据号维护
    If clsBill.lngNowID = 0 Then
        clsBill.intAccountYear = gclsBase.FYearOfDate(CDate(lblField(2).Caption))
        clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(CDate(lblField(2).Caption))
        blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), BillPublic.strDigitOfStr(lblField(1).Caption)
    Else
        BillPublic.blnModifyMaxNO gclsBase.FYearOfDate(CDate(lblField(2).Caption)), gclsBase.PeriodOfDate(CDate(lblField(2).Caption)), C2lng(lblHead(2).Tag), BillPublic.strAlphaOfStr(lblField(1).Caption), C2lng(BillPublic.strDigitOfStr(lblField(1).Caption))
    End If
     
    gclsSys.MainControls.Remove Me
    gclsSys.SendMessage Me.hWnd, 30 + C2lng(lblHead(2).Tag)
    frmPaymentList.IAmCLosed
    Set clsBill = Nothing
    Set clsLst = Nothing        '确定凭证是否存在等的类模块
    Set mclsMainControl = Nothing      '主控对象
    Unload Me
    
End Sub

Private Sub chkPrint0_Click()
'    frmMain.mnuEditShowAll.Checked = chkPrint(0).Value
End Sub

Private Sub chkPrint1_Click()
    Dim intYN As Integer
    Dim lngWriteOffID() As Long
    
    If blnIsCanEventChk_Click = False Then GoTo EndProc
    If chkPrint(1).Value = 1 Then
        blnIsCanEventChk_Click = False
        chkPrint(1).Value = 0
        blnIsCanEventChk_Click = True
        If ActivityIsHX(clsBill.lngNowID) Then
            If ShowMsg(Me.hWnd, "该张已经核销过的付款单保存后将不能取消作废！您确实要作废吗？", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_SYSTEMMODAL, "警告信息") <> IDYES Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        Else
            If ShowMsg(Me.hWnd, "该张付款单保存后将不能取消作废！您确实要作废吗？", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_SYSTEMMODAL, "警告信息") <> IDYES Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        End If
'-------- 冲销单据  作废
        If blnIsWriteOffBill(clsBill.lngNowID) Then
            If BillPublic.blnDelWriteOffBillNote(Me.hWnd, C2lng(lblHead(2).Tag), clsBill.lngNowID, "作废") = False Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        Else
            If BillPublic.blnWriteOff(Me.hWnd, C2lng(lblHead(2).Tag), clsBill.lngNowID, "作废", lngWriteOffID()) Then
                chkPrint(1).Value = 0
                GoTo EndProc
            End If
        End If
        blnIsCanEventChk_Click = False
        chkPrint(1).Value = 1
        blnIsCanEventChk_Click = True
    End If

    If chkPrint(1).Value = 0 Then
        Utility.RemoveFormResPicture (1024)
        cmdButton(6 + 1).Enabled = True
    Else
        cmdButton(6 + 1).Enabled = False
    End If
    If WanNeng Then
        tblReceipt.Buttons(ToolBarIndex(7, Me.Name)).Enabled = cmdButton(7).Enabled
    End If
    RefreshRect Me.hWnd, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2 + 140 * Screen.TwipsPerPixelX, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2 + 70 * Screen.TwipsPerPixelY
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
EndProc:
    Erase lngWriteOffID
End Sub

Private Sub chkPrint_Click(Index As Integer)
    clsBill.CHK_CLICK Index
'    If clsBill.blnMayChanged = False Then Exit Sub
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
    End Select
    clsBill.SetAFocus
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    clsBill.blnKeyDown = False
    If Not clsBill.cmdButton_Click(Index) Then GoTo EndProc
     
     Select Case Index
        Case 0
            cmdNext_Click
        Case 1
            CmdPrev_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            cmdOK_Click
            Exit Sub
        Case 5
'            TestData
            CmdCancel_Click
            Exit Sub
        Case 6
            BuildCancelBill True
        Case 7      '核销
            CmdReceive_Click
        Case 8      '关取凭证
            cmdVoucher_Click
        Case 9      '记事本
            CmdNote_Click
        Case 10
            CmdPrint_Click
    End Select
EndProc:
    If clsBill Is Nothing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
    clsBill.SetAFocus
End Sub

Private Sub CmdCancel_Click()
    clsBill.blnIsChanged = False
    clsBill.blnGrdCellDoing = False
     Unload Me
End Sub

Private Sub CmdEnd_Click()
    Dim i As Integer
    
    If Not ChangeSaveNote Then Exit Sub

    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3, C2lng(LblMemo(3).Tag))
    End If
    
    If lngID = 0 Then
        If blnEdit Then clsBill.GetANewBill C2lng(lblHead(5 - 1).Tag), C2lng(lblHead(2).Tag), lblField(1).Caption, True
        Exit Sub
    End If
    ShowAOldBill lngID
End Sub

Private Sub cmdHome_Click()