frminvoiceinfo.frm

金算盘软件代码

    Dim WidthRate  As Integer
    WidthRate = Int(Shape1(1).width / 3)
    
    Label1(0).Left = Shape1(1).Left + 120
    Label1(0).top = Shape1(1).top + 225
    Label1(0).width = 795
    
    Label1(1).Left = Label1(0).Left
    Label1(1).width = 795
    Label1(1).top = Label1(0).top + Label1(0).Height + 225
    
    Label1(2).Left = Label1(0).Left
    Label1(2).width = 795
    Label1(2).top = Label1(1).top + Label1(1).Height + 225
    
    Label1(3).Left = Shape1(1).Left + WidthRate + 550
    Label1(3).width = 450
    Label1(3).top = Label1(1).top
    
    Label1(4).Left = Label1(3).Left
    Label1(4).width = 450
    Label1(4).top = Label1(2).top
    
    Label1(5).Left = Shape1(1).Left + 2 * WidthRate + 50
    Label1(5).width = 585
    Label1(5).top = Label1(0).top
    
    Label1(6).Left = Label1(5).Left
    Label1(6).width = 585
    Label1(6).top = Label1(1).top
    
    Label1(7).Left = Label1(5).Left
    Label1(7).width = 585
    Label1(7).top = Label1(2).top
    
    lblField(0).Left = Label1(0).Left + Label1(0).width + 50
    lblField(0).width = Label1(5).Left - lblField(0).Left - 50
    lblField(0).top = Label1(0).top
    
    lblField(1).Left = lblField(0).Left
    lblField(1).width = Label1(3).Left - lblField(1).Left - 50
    lblField(1).top = Label1(1).top
    
    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 = 10012
    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()
    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 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
'                            grdList.ColWidth(2) = 0
                    .TextMatrix(i, 7) = ""
                    .TextMatrix(i, 2) = "期初单"
'                            grdList.TextMatrix(0, 3) = "期初单"
                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