frmjobpay.frm

金算盘软件代码

   Begin VB.Label lblF 
      AutoSize        =   -1  'True
      Caption         =   "付款方式(&M)"
      Height          =   180
      Index           =   4
      Left            =   210
      TabIndex        =   14
      Top             =   1830
      Width           =   990
   End
   Begin VB.Label lblF 
      AutoSize        =   -1  'True
      Caption         =   "付款日期(&D)"
      Height          =   180
      Index           =   0
      Left            =   210
      TabIndex        =   6
      Top             =   630
      Width           =   990
   End
   Begin VB.Label lblF 
      AutoSize        =   -1  'True
      Caption         =   "经 办 人(&E)"
      Height          =   180
      Index           =   6
      Left            =   210
      TabIndex        =   18
      Top             =   2250
      Width           =   990
   End
   Begin VB.Label lblF 
      AutoSize        =   -1  'True
      Caption         =   "累计已付款"
      Height          =   180
      Index           =   8
      Left            =   210
      TabIndex        =   22
      Top             =   2640
      Width           =   900
   End
   Begin VB.Label lblF 
      AutoSize        =   -1  'True
      Caption         =   "单    位(&C)"
      Height          =   180
      Index           =   2
      Left            =   210
      TabIndex        =   10
      Top             =   1020
      Width           =   990
   End
End
Attribute VB_Name = "frmJobPay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x1 As Long
Dim x2 As Long
Dim y1 As Long
Dim y2 As Long
Dim YesNo As Boolean
Dim lngVoucherID As Long
Dim lngVoucherDetailID As Long
Dim lngAccountID As Long
Dim lngProjectID As Long
Dim blnCanEdit As Boolean
Dim dblBudgetAmount As Double
Dim blnAlert As Boolean
Dim blnIsChanged As Boolean
Dim lngOldCustomerID As Long
Private Sub cmdYesNo_Click(Index As Integer)
    If Index = 0 Then
        If blnCanEdit Then
'            If C2Dbl(lblTitle(3).Tag) > 0 And (C2Dbl(curInput.Text) < 0 Or C2Dbl(curInput.Text) > C2Dbl(lblTitle(3).Tag)) Or C2Dbl(lblTitle(3).Tag) < 0 And (C2Dbl(curInput.Text) > 0 Or C2Dbl(curInput.Text) < C2Dbl(lblTitle(3).Tag)) Then
'                strErr = "发票已到金额" & Format$(curInput.Text, FormatString(gclsBase.NaturalCurDec)) & "不能大于本次开票金额" & Format$(C2Dbl(lblTitle(3).Tag), FormatString(gclsBase.NaturalCurDec)) & "！"
'                ShowMsg Me.hwnd, strErr, MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
'                curInput.SetFocus
'                Exit Sub
'            End If
            
            If SaveBill() Then
                YesNo = True
                Unload Me
            End If
        Else
            YesNo = False
            Unload Me
        End If
    Else
        YesNo = False
        Unload Me
    End If
End Sub


Private Sub curInput_Change(Index As Integer)
    blnIsChanged = True
End Sub

Private Sub dtmInput_Change()
    blnIsChanged = True
End Sub


Private Sub Form_Activate()
    If blnAlert Then Exit Sub
    blnAlert = True
'    ProjectChange refInput(4).ID
    If blnCanEdit Then
        refInput(4).SetFocus
'        dtmInput.SetFocus
    Else
        cmdYesNo(0).SetFocus
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And Shift = 0 Then
        SendKeys "{TAB}"
    ElseIf KeyCode = 27 Then 'Escape
        If refInput(0).ReferVisible Or refInput(1).ReferVisible Or refInput(2).ReferVisible Or refInput(3).ReferVisible Or dtmInput.DropDown Then
        ElseIf Me.ActiveControl.Name = "cmdYesNo" Then
            If blnIsChanged Then
                If ShowMsg(Me.hwnd, "是否保存在建工程付款单？", MB_SYSTEMMODAL + MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1, Me.Caption) = IDYES Then
                    cmdYesNo_Click 0
                Else
                    cmdYesNo_Click 1
                End If
            Else
                cmdYesNo_Click 1
            End If
        Else
            KeyCode = 0
            If Me.Visible And Me.Enabled Then cmdYesNo(0).SetFocus
        End If
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'    If KeyAscii = 13 Then
'        KeyAscii = Asc(vbTab)
'    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'    If KeyAscii = 13 And Shift = 0 Then
'        SendKeys "{TAB}"
'    End If
End Sub

Private Sub Form_Load()
    blnAlert = False
    cmdYesNo(0).Tag = 1001
    cmdYesNo(1).Tag = 1002
    Utility.LoadFormResPicture Me
    x1 = lblF(0).Left - 8 * Screen.TwipsPerPixelX
    y1 = lblF(0).top - 12 * Screen.TwipsPerPixelY
    x2 = lblF(11).Left + lblF(11).width + 8 * Screen.TwipsPerPixelY
    y2 = lblF(11).top + lblF(11).Height + 7 * Screen.TwipsPerPixelY
    refInput(0).AutoPop = True: refInput(0).CodeSort = True
    refInput(1).AutoPop = True: refInput(1).CodeSort = True
    refInput(2).AutoPop = True: refInput(2).CodeSort = True
    refInput(3).AutoPop = True: refInput(3).CodeSort = True

End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hwnd, x1, y1, x2, y1
'    DrawInSertLine Me.hwnd, X2, Y1, X2, Y2
    DrawInSertLine Me.hwnd, x2, y2, x1, y2
    DrawBLine Me.hdc, x2, y1, x2, y2, RGB(0, 0, 0)
    DrawBLine Me.hdc, x2 + 1 * Screen.TwipsPerPixelX, y1, x2 + 1 * Screen.TwipsPerPixelX, y2 + Screen.TwipsPerPixelY, RGB(255, 255, 255)
'    DrawInSertLine Me.hwnd, X1, Y2, X1, Y1
    DrawBLine Me.hdc, x1, y2, x1, y1, RGB(0, 0, 0)
    DrawBLine Me.hdc, x1 + 1 * Screen.TwipsPerPixelX, y2, x1 + 1 * Screen.TwipsPerPixelX, y1, RGB(255, 255, 255)
End Sub

Public Function ShowJobPay(ByVal VoucherID As Long, ByVal VoucherDetailID As Long, Optional ByVal blnEdit As Boolean) As Boolean
    lngVoucherID = VoucherID
    lngVoucherDetailID = VoucherDetailID
    txtInput(0).MaxLength = 20
    txtInput(1).MaxLength = 20
    curInput(0).Digits = gclsBase.NaturalCurDec
    curInput(1).Digits = gclsBase.NaturalCurDec
    LoadBill VoucherDetailID
    blnCanEdit = blnEdit
    If blnEdit = False Then
        refInput(0).Enabled = False
        refInput(1).Enabled = False
        refInput(2).Enabled = False
        refInput(3).Enabled = False
        refInput(4).Enabled = False
        txtInput(0).Enabled = False
        txtInput(1).Enabled = False
        curInput(0).Enabled = False
        curInput(1).Enabled = False
    End If
    
    blnIsChanged = False
    Me.Show vbModal
    ShowJobPay = YesNo
End Function
Private Function LoadBill(ByVal VDetailID As Long) As Boolean
    Dim recTmp As rdoResultset
    Dim strSql As String
    Dim i As Long
    strSql = "SELECT Project.strProjectCode || ' ' || Project.strProjectName ProjectName," & _
            "B.dblCurrencyAmount*B.intDirection Amount,B.lngProjectID InvoiceProjectID,B.dblPaymentAmount dblPaymentAmount," & _
            "C.strDate,B.strPayDate,B.strCheckNumber,B.strPayMan,Project.lngProjectID,Project.dblBudgetAmount,A.dblAmount," & _
           "B.lngOrderID,B.lngCustomerID,B.lngPayCustomerID,B.lngPaymentMethodID,B.lngAccountID,Project.strPrincipal " & _
           "FROM VoucherDetail B,Voucher C,Account,Project,ProjectInvoice A "
    strSql = strSql & _
            "WHERE B.lngVoucherID=C.lngVoucherID AND " & _
            "B.lngAccountID=Account.lngAccountID AND " & _
            "Account.lngAccountID=Project.lngAccountID(+) AND " & _
            "B.lngVoucherDetailID=A.lngVoucherDetailID(+) AND " & _
            "B.lngVoucherDetailID=" & VDetailID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp Is Nothing Then Exit Function
    If recTmp.EOF Then
        recTmp.Close
        Set recTmp = Nothing
        Exit Function
    End If
    lngAccountID = recTmp("lngAccountID")
    If recTmp("InvoiceProjectID") = 0 Then
        lngProjectID = IIf(IsNull(recTmp("lngProjectID")), 0, recTmp("lngProjectID"))
    Else
        lngProjectID = recTmp("InvoiceProjectID")
    End If
    dblBudgetAmount = IIf(IsNull(recTmp("dblBudgetAmount")), 0, recTmp("dblBudgetAmount")) '概预算金额
    lngOldCustomerID = recTmp("lngCustomerID")
    
    lblTitle(1).Caption = recTmp("ProjectName")
    lblTitle(3).Tag = recTmp("Amount")
    lblTitle(3).Caption = Format(recTmp("Amount"), FormatString(gclsBase.NaturalCurDec))
    
    If recTmp("strPayDate") = " " Then
        dtmInput.Text = recTmp("strDate")
    Else
        dtmInput.Text = recTmp("strPayDate")
    End If
    
    AddOrderRefer
    AddCustomerRefer
    AddPayCustomerRefer
    AddPaymentMethodRefer
    AddProjectRefer
    
    refInput(0).SeekId recTmp("lngOrderID")
    refInput(1).SeekId recTmp("lngCustomerID")
    refInput(2).SeekId recTmp("lngPayCustomerID")
    refInput(3).SeekId recTmp("lngPaymentMethodID")
    txtInput(0).Text = Trim(recTmp("strCheckNumber"))
    If refInput(3).ID = 0 Then
        With FrmVoucher.GrdCol
            For i = 1 To .Rows - 1
                If C2lng(.TextMatrix(i, 29)) > 0 Then
                    refInput(3).SeekId C2lng(.TextMatrix(i, 29))
                    txtInput(0).Text = Trim(.TextMatrix(i, 28))
                End If
            Next
        End With
    End If
    
    If Trim(recTmp("strPayMan")) = "" Then
        txtInput(1).Text = Trim(IIf(IsNull(recTmp("strPrincipal")), "", recTmp("strPrincipal")))
    Else
        txtInput(1).Text = Trim(recTmp("strPayMan"))
    End If
    
    curInput(0).Text = Format(recTmp("dblAmount"), FormatString(gclsBase.NaturalCurDec))
    If recTmp("dblPaymentAmount") = 0 Then
        curInput(1).Text = Format(recTmp("Amount"), FormatString(gclsBase.NaturalCurDec))
    Else
        curInput(1).Text = Format(recTmp("dblPaymentAmount"), FormatString(gclsBase.NaturalCurDec))
    End If
    
EndProc:
    recTmp.Close
    Set recTmp = Nothing
    
    refInput(4).SeekId lngProjectID
    LoadBill = True
End Function
Private Function ProjectChange(ByVal ProjectID As Long) As Boolean
    Dim recTmp As rdoResultset
    Dim strSql As String
    strSql = "SELECT SUM(V.dblPaymentAmount) FROM VoucherDetail V ,Voucher " & _
           "WHERE V.lngVoucherID=Voucher.lngVoucherID AND Voucher.blnIsVoid=0 AND V.lngProjectID=" & ProjectID & " AND V.lngVoucherDetailID<>" & lngVoucherDetailID
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp Is Nothing Then Exit Function
    If recTmp.EOF = False Then
        lblF(10).Caption = Format(recTmp(0), FormatString(gclsBase.NaturalCurDec))
    End If
    strSql = "SELECT SUM(dblAmount) FROM ProjectInvoice V " & _
           "WHERE V.lngProjectID=" & ProjectID & " AND NVL(V.lngVoucherDetailID,0)<>" & lngVoucherDetailID
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp Is Nothing Then Exit Function
    If recTmp.EOF = False Then
        lblF(11).Caption = Format(recTmp(0), FormatString(gclsBase.NaturalCurDec))
    End If
    
EndProc:
    recTmp.Close
    Set recTmp = Nothing
    ProjectChange = True
    Dim strErr As String
    strErr = ""
    If blnCanEdit Then
        If dblBudgetAmount > 0 And C2Dbl(lblF(10).Caption) > dblBudgetAmount Or dblBudgetAmount < 0 And C2Dbl(lblF(10).Caption) < dblBudgetAmount Then
            strErr = "累计付款金额" & lblF(10).Caption & "大于概预算金额" & Format$(dblBudgetAmount, FormatString(gclsBase.NaturalCurDec)) & "！"
        End If