frmpayableinfo.frm

金算盘软件代码

    lblField(2).Left = lblField(0).Left
    lblField(2).width = lblField(1).width
    lblField(2).top = Label1(2).top
    
    lblField(3).Left = Label1(3).Left + Label1(3).width + 50
    lblField(3).width = Label1(6).Left - lblField(3).Left - 50
    lblField(3).top = Label1(3).top
    
    lblField(4).Left = lblField(3).Left
    lblField(4).width = lblField(3).width
    lblField(4).top = Label1(4).top
    
    lblField(5).Left = Label1(5).Left + Label1(5).width + 50
    lblField(5).width = Shape1(1).width + Shape1(1).Left - lblField(5).Left - 50
    lblField(5).top = Label1(5).top
    
    lblField(6).Left = lblField(5).Left
    lblField(6).width = lblField(5).width
    lblField(6).top = Label1(3).top
    
    lblField(7).Left = lblField(5).Left
    lblField(7).width = lblField(5).width
    lblField(7).top = Label1(4).top
    
    cmdButton(0).top = Shape1(1).top
    cmdButton(0).Left = Me.ScaleWidth - cmdButton(0).width - 100
    
    cmdButton(1).top = cmdButton(0).top + cmdButton(0).Height + 100
    cmdButton(1).Left = cmdButton(0).Left
    
    cmdButton(2).top = cmdButton(1).top + cmdButton(1).Height + 100
    cmdButton(2).Left = cmdButton(1).Left
    
    For i = 0 To cmdButton.Count - 1
        cmdButton(i).Visible = True
    Next i
    Label2.Visible = True
    Label3.Visible = True
    Shape1(0).Visible = True
    Shape1(1).Visible = True
    For i = 0 To lblField.Count - 1
        Label1(i).Visible = True
        lblField(i).Visible = True
    Next i

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture 1022
    Utility.RemoveFormResPicture 1010
    Utility.RemoveFormResPicture 139
    Set mclsSubClass = Nothing
End Sub

Private Sub grdList_EnterCell()
    grdList.ColSel = grdList.Cols - 1
End Sub

Private Sub grdList_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        CmdRelating_Click
    End If
End Sub

Private Sub grdlist_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    grdList.ColSel = grdList.Cols - 1
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    '“钩子”事件处理
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 8600 \ Screen.TwipsPerPixelX
        MinMax.ptMinTrackSize.y = 4600 \ Screen.TwipsPerPixelY
        MinMax.ptMaxTrackSize.x = 1800
        MinMax.ptMaxTrackSize.y = 1600
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10013
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Set mclsGrid = New Grid
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = Me.hwnd
    mclsSubClass.Messages(WM_GETMINMAXINFO) = True
    
    Set mclsGrid.Grid = grdList
    grdList.ColSel = grdList.Cols - 1
    cmdButton(0).Picture = Utility.GetFormResPicture(1022, 0)
    cmdButton(1).Picture = Utility.GetFormResPicture(1010, 0)
    Me.top = (Screen.Height - Me.Height) / 2 '2000
    Me.Left = (Screen.width - Me.width) / 2 '2000
End Sub

Private Sub grdList_DblClick()
    '效果等同于单击“关联”按纽
    If grdList.MouseRow = 0 Then Exit Sub
    CmdRelating_Click
End Sub

Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub CmdRelating_Click()
    'Me.MouseIcon = vbHourglass
   If grdList.ColSel <> 0 And grdList.Rows > 1 Then
        ActivityID1 = C2lng(grdList.TextMatrix(grdList.Row, 0))
        ActivityTypeID1 = C2lng(grdList.TextMatrix(grdList.Row, 7))
        If ActivityTypeID1 = 0 Then
            ShowMsg Me.hwnd, "没有可关联的单据！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
            blnBz = False
            Exit Sub
        End If
        blnBz = True
        Unload Me
   End If
End Sub
Private Sub cmdButton_Click(Index As Integer)
    Select Case Index
    Case 0
        cmdOK_Click
    Case 1
        CmdRelating_Click
    Case 2
        If grdList.Rows > 1 And grdList.ColSel <> 0 Then
            If grdList.Row < 1 Then grdList.Row = 1
            Me.Hide
            ActivityTypeID1 = C2lng(grdList.TextMatrix(grdList.Row, 7))
            Select Case ActivityTypeID1
                Case 40 '收款单
                    Set frm = FrmPayment 'FrmReceive
                Case 39 '付款单
                    Set frm = FrmPayment
                Case Else
                    Set frm = FrmPayment
            End Select
            Screen.MousePointer = vbHourglass
'----------------------------------------------
            strCurrAmount = Format(grdList.TextMatrix(grdList.Row, 6), FormatString(C2Dbl(grdList.TextMatrix(grdList.Row, 8))))
            strRate = Format(RateValue(lngCurID, lblField(3).Caption), FormatString(intRateDec))
            
            If blnInDirect(lngCurID) Then
                strAmount = Format(C2Dbl(strCurrAmount) / IIf(C2Dbl(strRate) = 0, 1, C2Dbl(strRate)), FormatString(gclsBase.NaturalCurDec))
            Else
                strAmount = Format(C2Dbl(strCurrAmount) * IIf(C2Dbl(strRate) = 0, 1, C2Dbl(strRate)), FormatString(gclsBase.NaturalCurDec))
            End If
'-----------------------------------------------
            frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
            Unload Me
        ElseIf grdList.Rows = 1 Then
            Me.Hide
            Set frm = FrmPayment
            Screen.MousePointer = vbHourglass
            strCurrAmount = Format(lblField(7).Caption, FormatString(intCurDec))
            frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
            Unload Me
        End If
    End Select
End Sub

Private Function blnInDirect(ByVal lngCurrencyID As Long) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    strSql = "SELECT blnIsIndirect FROM Currencys WHERE lngCurrencyID =" & lngCurrencyID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp Is Nothing Then
        blnInDirect = False
    Else
        If recTmp.BOF And recTmp.EOF Then
            blnInDirect = False
        Else
            blnInDirect = recTmp!blnIsIndirect
        End If
        recTmp.Close
        Set recTmp = Nothing
    End If
End Function

Private Function ID2str(ByVal i As Integer, ByVal strID As String) As String
    With grdList
        Select Case strID
        Case "0"
            If .TextMatrix(i, 7) = "3" Then
                .TextMatrix(i, 2) = "直运采购"
            ElseIf .TextMatrix(i, 7) = "5" Then
                .TextMatrix(i, 2) = "受托结算"
            ElseIf .TextMatrix(i, 7) = "7" Then
                .TextMatrix(i, 2) = "加工费用"
            ElseIf .TextMatrix(i, 7) = "13" Then
                .TextMatrix(i, 2) = "商品销售"
            ElseIf .TextMatrix(i, 7) = "16" Then
                .TextMatrix(i, 2) = "受托结算"
            ElseIf .TextMatrix(i, 7) = "19" Then
                .TextMatrix(i, 2) = "分期结算"
            ElseIf .TextMatrix(i, 7) = "34" Then
                .TextMatrix(i, 2) = "应付贷项期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "35" Then
                .TextMatrix(i, 2) = "应付借项期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "36" Then
                .TextMatrix(i, 2) = "应收借项期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "37" Then
                .TextMatrix(i, 2) = "应收贷项期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "38" Then
                .TextMatrix(i, 2) = "应收计息期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "39" Then
                .TextMatrix(i, 2) = "付款单期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "40" Then
                .TextMatrix(i, 2) = "收款单期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "1" Then
                .TextMatrix(i, 2) = "采购发票期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "2" Then
                .TextMatrix(i, 2) = "直运采购期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "4" Then
                .TextMatrix(i, 2) = "受托结算期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "6" Then
                .TextMatrix(i, 2) = "加工费用期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "11" Then
                .TextMatrix(i, 2) = "销售发票期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "12" Then
                .TextMatrix(i, 2) = "直运销售期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "14" Then
                .TextMatrix(i, 2) = "委托结算期初"
                .TextMatrix(i, 7) = ""
            ElseIf .TextMatrix(i, 7) = "17" Then
                .TextMatrix(i, 2) = "分期结算期初"
                .TextMatrix(i, 7) = ""
            End If
            If gclsBase.ControlAccount = False Then
                .TextMatrix(i, 7) = ""
                .TextMatrix(i, 2) = "期初单"
            End If
        Case "1"
            If .TextMatrix(i, 7) = "34" Then
                .TextMatrix(i, 2) = "应付贷项"
            ElseIf .TextMatrix(i, 7) = "35" Then
                .TextMatrix(i, 2) = "应付借项"
            ElseIf .TextMatrix(i, 7) = "36" Then
                .TextMatrix(i, 2) = "应收借项"
            ElseIf .TextMatrix(i, 7) = "37" Then
                .TextMatrix(i, 2) = "应收贷项"
            ElseIf .TextMatrix(i, 7) = "38" Then
                .TextMatrix(i, 2) = "应收计息"
            ElseIf .TextMatrix(i, 7) = "39" Then
                .TextMatrix(i, 2) = "付款单"
            ElseIf .TextMatrix(i, 7) = "40" Then
                .TextMatrix(i, 2) = "收款单"
            Else
                .TextMatrix(i, 7) = ""
            End If
        Case "2"
            If .TextMatrix(i, 7) = "1" Then
                .TextMatrix(i, 2) = "商品采购"
            ElseIf .TextMatrix(i, 7) = "2" Then
                .TextMatrix(i, 2) = "直运采购"
            ElseIf .TextMatrix(i, 7) = "4" Then
                .TextMatrix(i, 2) = "受托结算"
            ElseIf .TextMatrix(i, 7) = "6" Then
                .TextMatrix(i, 2) = "加工费用"
            ElseIf .TextMatrix(i, 7) = "11" Then
                .TextMatrix(i, 2) = "商品销售"
            ElseIf .TextMatrix(i, 7) = "12" Then
                .TextMatrix(i, 2) = "直运销售"
            ElseIf .TextMatrix(i, 7) = "14" Then
                .TextMatrix(i, 2) = "委托结算"
            ElseIf .TextMatrix(i, 7) = "17" Then
                .TextMatrix(i, 2) = "分期结算"
            Else
                .TextMatrix(i, 7) = ""
            End If
        Case "3"
            .TextMatrix(i, 2) = "记帐凭证"
            .TextMatrix(i, 7) = "50"
        End Select
    End With
End Function