frminorout.frm

金算盘软件代码

    If KeyCode = vbKeyReturn Then
        If Shift = 0 Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        ElseIf Shift = 2 Then
            cmdOKCancelFilter(0).Value = True
        End If
    End If
End Sub

Private Sub Form_Load()
    Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Set cmdOKCancelFilter(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdOKCancelFilter(1).Picture = GetFormResPicture(1002, vbResBitmap)
    Set cmdFindPath.Picture = GetFormResPicture(1017, vbResBitmap)
    Erase ListModule.marrAccount
    Erase ListModule.marrcustomer
    Erase ListModule.marrItem
    mintViewId(0) = 6
    mintViewId(1) = 7
    mintViewId(2) = 8
    mintViewId(3) = 9
    mintViewId(4) = 10
    mintViewId(5) = 11
    mintViewId(6) = 12
    mintViewId(7) = 13
    mintViewId(8) = 13
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.RemoveFormResPicture (139)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1017)
    Utility.RemoveFormResPicture (139)
    SaveSetting App.title, gclsBase.BaseName & "导入", "ImportFileName", txtPath.Text
End Sub

Private Sub msgPutItem_GotFocus()
    With msgPutItem
        If .Rows > 2 And .Row < 2 Then
            .Row = 2
            .ColSel = 3
        End If
    End With
End Sub

Private Sub msgPutItem_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode <> vbKeySpace Then Exit Sub
    With msgPutItem
        If .TextMatrix(.Row, 1) = "" Then
            .TextMatrix(.Row, 1) = "√"
        Else
            .TextMatrix(.Row, 1) = ""
        End If
    End With
End Sub

Private Sub msgPutItem_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgPutItem
        If .Rows > 1 Then
            If .MouseCol = 1 And .MouseRow <> 0 Then
                .MousePointer = vbCustom
            Else
                 .MousePointer = vbDefault
            End If
        Else
            .MousePointer = vbDefault
        End If
        If Button = vbLeftButton Then
            .AllowBigSelection = False
            If .Row <> .MouseRow Then
                .Row = .MouseRow
            End If
        End If
    End With
End Sub

Private Sub msgPutItem_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgPutItem
        If Button = vbLeftButton Then
            If .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    If .TextMatrix(.Row, 1) = "" Then
                        .TextMatrix(.Row, 1) = "√"
                    Else
                        .TextMatrix(.Row, 1) = ""
                    End If
                End If
            End If
        End If
    End With
End Sub

Private Function getID() As Integer
    With msgPutItem
         If .Row > 0 Then
            getID = CInt(.TextMatrix(.Row, 0))
         Else
            getID = -1
         End If
    End With
End Function

Private Function CoordinateArray(blnItem() As Boolean) As Boolean
    Dim intCount As Integer
    
    With msgPutItem
        For intCount = 2 To .Rows - 1
            If .TextMatrix(intCount, 1) = "√" Then
                blnItem(.TextMatrix(intCount, 0)) = True
                CoordinateArray = True
            Else
                blnItem(.TextMatrix(intCount, 0)) = False
            End If
        Next
    End With
End Function

Public Function ShowCardInOrOut(Optional ByVal blnInorOut As Boolean = True) As Boolean
    Dim strImportName As String
    
    On Error Resume Next
    strImportName = GetSetting(App.title, gclsBase.BaseName & "导入", "ImportFileName")
    If strImportName = "" Then
        strImportName = App.Path & "\Format.ini"
    End If
    mblnImport = blnInorOut
    InitGrid
    If mblnImport Then
        Me.Caption = "数据导入"
        lblImPortTable(1).Caption = "导入数据源(&P)"
        lblImPortTable(0).Caption = "导入项目(&T)"
        txtPath.Text = strImportName
        cmdOKCancelFilter(2).Visible = False
        InitByInorOut txtPath.Text
    Else
        Me.Caption = "数据导出"
        lblImPortTable(1).Caption = "导出文件夹(&P)"
        lblImPortTable(0).Caption = "导出项目(&T)"
        txtPath.Text = App.Path
        mintYear = gclsBase.AccountYear
        mintStartPeriod = 1
        mintEndPeriod = 1
    End If
    Me.Show vbModal
End Function

Private Sub InitGrid()
    Dim recTemp As rdoResultset, strSql As String
    
    With msgPutItem
        .AllowBigSelection = True
        .SelectionMode = flexSelectionByRow
        .Cols = 4
        .ColSel = .Cols - 1
        .ColWidth(0) = 0
        .ColWidth(1) = 450
        .ColWidth(2) = .width - 1780
        .ColWidth(3) = 1000
        .FixedRows = 1
        .TextMatrix(0, 1) = "选择"
        .TextMatrix(0, 2) = "项目"
        .TextMatrix(0, 3) = "导出日期"
        .AddItem "0" & Chr(9) & "" & Chr(9) & "货币", .Rows
        .AddItem "1" & Chr(9) & "" & Chr(9) & "科目", .Rows
        .AddItem "2" & Chr(9) & "" & Chr(9) & "部门", .Rows
        .AddItem "3" & Chr(9) & "" & Chr(9) & "职员类别", .Rows
        .AddItem "4" & Chr(9) & "" & Chr(9) & "职员", .Rows
        .AddItem "5" & Chr(9) & "" & Chr(9) & "单位类别", .Rows
        .AddItem "6" & Chr(9) & "" & Chr(9) & "单位", .Rows
        .AddItem "7" & Chr(9) & "" & Chr(9) & "统计核算", .Rows
        .AddItem "8" & Chr(9) & "" & Chr(9) & "项目核算", .Rows
        .AddItem "9" & Chr(9) & "" & Chr(9) & "商品性质", .Rows
        .AddItem "10" & Chr(9) & "" & Chr(9) & "商品类别", .Rows
        .AddItem "11" & Chr(9) & "" & Chr(9) & "商品", .Rows
        .AddItem "12" & Chr(9) & "" & Chr(9) & "商品单位", .Rows
        .AddItem "13" & Chr(9) & "" & Chr(9) & "货位", .Rows
        .AddItem "14" & Chr(9) & "" & Chr(9) & "工程类别", .Rows
        .AddItem "15" & Chr(9) & "" & Chr(9) & "工程", .Rows
        .AddItem "16" & Chr(9) & "" & Chr(9) & "自定义项目0", .Rows
        .AddItem "17" & Chr(9) & "" & Chr(9) & "自定义项目1", .Rows
        .AddItem "18" & Chr(9) & "" & Chr(9) & "自定义项目2", .Rows
        .AddItem "19" & Chr(9) & "" & Chr(9) & "自定义项目3", .Rows
        .AddItem "20" & Chr(9) & "" & Chr(9) & "自定义项目4", .Rows
        .AddItem "21" & Chr(9) & "" & Chr(9) & "自定义项目5", .Rows
        .AddItem "22" & Chr(9) & "" & Chr(9) & "凭证类别", .Rows
        .AddItem "23" & Chr(9) & "" & Chr(9) & "单据模板", .Rows
        .AddItem "24" & Chr(9) & "" & Chr(9) & "固资方式", .Rows
        .AddItem "25" & Chr(9) & "" & Chr(9) & "固资类别", .Rows
        .AddItem "26" & Chr(9) & "" & Chr(9) & "企业收发地址", .Rows
        .AddItem "27" & Chr(9) & "" & Chr(9) & "企业开户银行", .Rows
        .AddItem "28" & Chr(9) & "" & Chr(9) & "单位收发地址", .Rows
        .AddItem "29" & Chr(9) & "" & Chr(9) & "单位开户银行", .Rows
        .AddItem "30" & Chr(9) & "" & Chr(9) & "凭证", .Rows
'        .AddItem "31" & Chr(9) & "" & Chr(9) & "固资方式", .Rows
        .AddItem "32" & Chr(9) & "" & Chr(9) & "科目期初", .Rows
'        .AddItem "33" & Chr(9) & "" & Chr(9) & "固资类别", .Rows
        .AddItem "34" & Chr(9) & "" & Chr(9) & "应收应付期初", .Rows
'        .AddItem "35" & Chr(9) & "" & Chr(9) & "现金银行余额", .Rows
        .AddItem "36" & Chr(9) & "" & Chr(9) & "银行对帐单", .Rows
        .AddItem "37" & Chr(9) & "" & Chr(9) & "银行帐期初", .Rows
        .AddItem "38" & Chr(9) & "" & Chr(9) & "固资变动", .Rows
        .AddItem "39" & Chr(9) & "" & Chr(9) & "财务预算", .Rows
        .AddItem "40" & Chr(9) & "" & Chr(9) & "经营预算", .Rows
'        .RemoveItem 12
        #If conVersionType = 16 Then
            If gclsBase.ControlAccount Then
                strSql = "SELECT * FROM ReceiptType WHERE (lngReceiptTypeID > 33 AND lngReceiptTypeID < 42) OR lngReceiptTypeID IN (2,13) and bytVersion<>0"
            Else
'                Exit Sub
            End If
        #Else
            strSql = "SELECT * FROM ReceiptType WHERE  lngReceiptTypeID NOT IN (41,48,49,50,51,54,55) and bytVersion<>0"
        #End If
        If strSql <> "" Then
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql) ' WHERE lngReceiptTypeID<>41")
            Do While Not recTemp.EOF
                .AddItem recTemp!lngReceiptTypeID + 40 & Chr(9) & "" & Chr(9) & recTemp!strReceiptTypeName
                recTemp.MoveNext
            Loop
        End If
        pctLine(0).Left = .Left + 30 + .ColWidth(1)
        pctLine(0).top = .top + .RowPos(0) + 30
        pctLine(0).Height = .Height - 90
        pctLine(1).Left = .Left + 30 + .ColWidth(1) + .ColWidth(2)
        pctLine(1).top = .top + .RowPos(0) + 30
        pctLine(1).Height = .Height - 90
        Set .MouseIcon = GetFormResPicture(101, vbResCursor)
    End With
End Sub

Private Function InitByInorOut(ByVal strFile As String) As Boolean
    Dim intCount As Integer
    Dim lngResult As Long
    Dim strResult As String * 10
    Dim strExportDate As String
    Dim strName As String
    
    If mblnImport Then '引入
        With msgPutItem
            For intCount = 1 To .Rows - 1
                lngResult = GetPrivateProfileSection(.TextMatrix(intCount, 2), strResult, 10, strFile)
                If lngResult > 0 Then
                    strName = "," & .TextMatrix(intCount, 2) & ","
                    #If conVersionType = 1 Then
                        .RowHeight(intCount) = .RowHeight(0)
                        strExportDate = VBGetPrivateProfileString(.TextMatrix(intCount, 2), "导出日期", strFile)
                        .TextMatrix(intCount, 3) = strExportDate
                    #ElseIf conVersionType = 16 Then
                        If gclsBase.ControlAccount Then
                            If InStr(strConStr, strName) > 0 Then
                                .RowHeight(intCount) = .RowHeight(0)
                                strExportDate = VBGetPrivateProfileString(.TextMatrix(intCount, 2), "导出日期", strFile)
                                .TextMatrix(intCount, 3) = strExportDate
                            End If
                        Else
                            If InStr(strUnConStr, strName) > 0 Then
                                .RowHeight(intCount) = .RowHeight(0)
                                strExportDate = VBGetPrivateProfileString(.TextMatrix(intCount, 2), "导出日期", strFile)
                                .TextMatrix(intCount, 3) = strExportDate
                            End If
                        End If
                    #End If
                Else
                    .RowHeight(intCount) = 0
                    .TextMatrix(intCount, 1) = ""
                End If
            Next
        End With
        gstrImportBaseStartDate = VBGetPrivateProfileString("帐套", "启用会计期", strFile)
        gstrImportBaseStartDate = Left(gstrImportBaseStartDate, 4) & "-" _
            & Mid(gstrImportBaseStartDate, 5, 2) & "-" & Mid(gstrImportBaseStartDate, 7, 2)
    End If
End Function