frmimport.frm

金算盘软件代码

                SetSelectRow i, True
            End If
        Next
    Case 4
        For i = 1 To GrdCol.Rows - 1
'            If GrdCol.TextMatrix(i, 1) <> "" Then
                SetSelectRow i, False
'            End If
        Next
    Case 5
        RowExchange True
    Case 6
        RowExchange False
    Case 7
        On Error Resume Next
        Dim strTmp As String
        With DlgPath
            .InitDir = mstrInPath
            .ShowOpen
            If Err Then Exit Sub
            strTmp = .FileName
            strTmp = GetFilePath(strTmp)
            If strTmp Like "%:\" Then
                mstrInPath = strTmp
            Else
                strTmp = Left(strTmp, Len(strTmp) - 1)
                mstrInPath = GetFilePath(strTmp)
            End If
            GetRowData
            SetGridFromArr
        End With
    Case 8
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.RowHeight(i) > 0 Then
                If Trim(GrdCol.TextMatrix(i, 1)) <> "" Then
                    Exit For
                End If
            End If
        Next
    
        If ShowMsg(Me.hWnd, "您确实要删除选择的项目吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "提示信息") = vbNo Then Exit Sub
        DelSelectItem
    End Select
End Sub
Private Sub DelSelectItem()
    Dim i As Long
    
    On Error GoTo ErrHandle
    Me.MousePointer = vbHourglass
    GrdCol.Redraw = False
    For i = GrdCol.Rows - 1 To 1 Step -1
        If GrdCol.RowHeight(i) > 0 Then
            If Trim(GrdCol.TextMatrix(i, 1)) <> "" Then
                Select Case DelAItem(i)
                Case 0  '成功
                    If GrdCol.Rows > 2 Then
                        GrdCol.RemoveItem i
                    Else
                        GrdCol.Rows = 1
                    End If
                Case 1  '失败、退出
                    GoTo EndProc
                Case 2  '失败、其他
                Case Else
                End Select
            End If
        End If
    Next
EndProc:
    GrdCol.Redraw = True
    Me.MousePointer = vbDefault
    Exit Sub
ErrHandle:
    GoTo EndProc
End Sub
Private Function DelAItem(ByVal lngRowno As Long) As Long
    Dim strItem As String
    Dim strPath As String
    Dim strDataFile As String
    Dim i As Long
    
    On Error GoTo ErrHandle
    strItem = RowPropertys(GrdCol.RowData(lngRowno)).strData(2)
    strPath = RowPropertys(GrdCol.RowData(lngRowno)).strPath
    strDataFile = strPath & "\" & VBGetPrivateProfileString(strItem, "文件名", strPath & "\format.ini")
    If Dir(strDataFile) <> "" Then
        Kill strDataFile
    End If
    Select Case ItemName2NO(strItem)
    '"货币"
    Case 0
        strDataFile = strPath & "\" & "Rate.dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    '"科目"
    Case 1
        strDataFile = strPath & "\" & "AcntCur.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    '部门"
    Case 2
    '职员类别"
    Case 3
    '职员"
    Case 4
    '单位类别"
    Case 5
    '单位"
    Case 6
    '统计核算"
    Case 7
    '项目核算"
    Case 8
    '商品性质"
    Case 9
    '商品类别"
    Case 10
    '商品"
    Case 11
        strDataFile = strPath & "\" & "PartItem.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
        strDataFile = strPath & "\" & "QuanDisc.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    '商品单位"
    Case 12
    '货位"
    Case 13
    '工程类别"
    Case 14
    '工程"
    Case 15
    '自定义项目0"
    Case 16
    '自定义项目1"
    Case 17
    '自定义项目2"
    Case 18
    '自定义项目3"
    Case 19
    '自定义项目4"
    Case 20
    '自定义项目5"
    Case 21
    '凭证类别"
    Case 22
    '单据模板"
        strDataFile = strPath & "\" & "Font.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
        strDataFile = strPath & "\" & "TScheme.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
        strDataFile = strPath & "\" & "PSetup.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    Case 23
    '固资方式"
    Case 24
    '固资类别"
    Case 25
    '企业收发地址"
    Case 26
    '企业开户银行"
    Case 27
    '单位收发地址"
    Case 28
    '单位开户银行"
    Case 29
    '凭证"
    Case 30
    '余额"
    Case 31
    '科目期初"
    Case 32
    '应收应付余额"
    Case 33
    '应收应付期初"
    Case 34
    '现金银行余额"
    Case 35
    '银行对帐单"
    Case 36
    '银行帐期初"
    Case 37
    '固资变动"
'        strDataFile = strPath & "\" & "FixedAlter.Dat"
'        If Dir(strDataFile) <> "" Then
'            Kill strDataFile
'        End If
    Case 38
    '财务预算"
        strDataFile = strPath & "\" & "BudgetAc.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    Case 39
    '经营预算"
        strDataFile = strPath & "\" & "BudgetIt.Dat"
        If Dir(strDataFile) <> "" Then
            Kill strDataFile
        End If
    Case 40
    '采购订单"
    Case 41
    '商品采购"
    Case 42
    '直运采购"
    Case 43
    '受托入库"
    Case 44
    '受托结算"
    Case 45
    '加工入库"
    Case 46
    '加工费用"
    Case 47
    '采购发票"
    Case 48
    '自制入库"
    Case 49
    '盘盈入库"
    Case 50
    '其他入库"
    Case 51
    '销售订单"
    Case 52
    '商品销售"
    Case 53
    '直运销售"
    Case 54
    '委托出库"
    Case 55
    '委托结算"
    Case 56
    '加工出库"
    Case 57
    '分期出库"
    Case 58
    '分期结算"
    Case 59
    '销售发票"
    Case 60
    '领用出库"
    Case 61
    '成本调整"
    Case 62
    '盘亏出库"
    Case 63
    '其他出库"
    Case 64
    '代销调拨"
    Case 66
    '商品调拨"
    Case 68
    '商品调价"
    Case 69
    '商品组装"
    Case 70
    '商品拆卸"
    Case 71
    '商品盘点"
    Case 73
    '应付贷项"
    Case 74
    '应付借项"
    Case 75
    '应收借项"
    Case 76
    '应收贷项"
    Case 77
    '应收计息"
    Case 78
    '付款单"
    Case 79
    '收款单"
    Case 80
    '库存期初"
    Case 82
    '受托期初"
    Case 83
    '委托期初"
    Case 84
    '分期期初"
    Case 85
    '直运期初"
    Case 86
    '加工期初"
    Case 87
    '暂估期初"
    Case 92
    '固资期初"
    Case 93
'        strDataFile = strPath & "\" & "QuanDisc.Dat"
'        If Dir(strDataFile) <> "" Then
'            Kill strDataFile
'        End If
    '拜访客户资料"
    Case 94
    '现金项目
    Case 95
    '地区
    Case 96    
    End Select

    For i = 1 To GrdCol.Rows - 1
        If i <> lngRowno Then
            If RowPropertys(GrdCol.RowData(i)).strPath = strPath Then
                Exit For
            End If
        End If
    Next
    If i = GrdCol.Rows Then
        Kill strPath & "\" & "*.*"
        RmDir strPath
    End If
    DelAItem = 0
    Exit Function
ErrHandle:
    Dim errDel As ErrDealType
    errDel = Errors.ErrorsDeal
    If errDel = edtResume Then
        Resume
    ElseIf errDel = edtCanNotKnown Then
       cMsgBox "未知错误，不能删除文件“" & strDataFile & "”！"
    End If
    Err.Clear
    If ShowMsg(Me.hWnd, "您要继续删除选择的其他项目吗？", _
        MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL, "提示信息") = vbNo Then
        DelAItem = 1
    Else
        DelAItem = 2
    End If
End Function

Private Function ColName(ByVal lngCol As Long) As String
    Dim strTmp As String
    
    strTmp = GrdCol.TextMatrix(0, lngCol)
    
    If InStr(strTmp, "↑") <> 0 Or InStr(strTmp, "↓") <> 0 Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
    End If
    ColName = strTmp
End Function

Private Sub SetSelectRow(ByVal lngRowno As Long, ByVal blnSelect As Boolean)
    If blnSelect Then
        GrdCol.TextMatrix(lngRowno, 1) = "√"
    Else
        GrdCol.TextMatrix(lngRowno, 1) = ""
    End If
End Sub

Private Sub cMsgBox(ByVal strText As String, Optional ByVal strTitle As String = "提示信息")
    ShowMsg Me.hWnd, strText, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

Private Function blnRowIsSelected(ByVal lngRow As Long) As Boolean
    If GrdCol.TextMatrix(lngRow, 1) = "" Then
        blnRowIsSelected = False
    Else
        blnRowIsSelected = True
    End If
End Function

Private Sub SetGridFromList()
    Dim i As Long
    Dim blnRedrawBak As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim strTranData() As String
    
    With GrdCol
        blnRedrawBak = .Redraw
        .Redraw = False
        If mclsList.ListID = 0 Then
            AddList
        End If