frmimport.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmImport 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据导入"
   ClientHeight    =   5460
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8775
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5460
   ScaleWidth      =   8775
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "删    除(&D)"
      Height          =   350
      Index           =   8
      Left            =   7500
      TabIndex        =   7
      Top             =   2490
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin MSComDlg.CommonDialog DlgPath 
      Left            =   7830
      Top             =   4110
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DialogTitle     =   "查找导出数据"
      Filter          =   "数据导出配置文件(FORMAT.INI)|FORMAT.INI"
      Flags           =   4
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "浏    览(&B)"
      Height          =   350
      Index           =   7
      Left            =   7500
      TabIndex        =   6
      Top             =   2100
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "下    移(&D)"
      Height          =   350
      Index           =   6
      Left            =   7500
      TabIndex        =   9
      Top             =   2490
      UseMaskColor    =   -1  'True
      Visible         =   0   'False
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "上    移(&U)"
      Height          =   350
      Index           =   5
      Left            =   7500
      TabIndex        =   8
      Top             =   2100
      UseMaskColor    =   -1  'True
      Visible         =   0   'False
      Width           =   1210
   End
   Begin VB.CheckBox chkShowALL 
      Caption         =   "全部显示(&H)"
      Height          =   255
      Left            =   7500
      TabIndex        =   10
      Top             =   5130
      Width           =   1365
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "全部取消(&C)"
      Height          =   350
      Index           =   4
      Left            =   7500
      TabIndex        =   5
      Top             =   1710
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "全部选择(&A)"
      Height          =   350
      Index           =   3
      Left            =   7500
      TabIndex        =   4
      Top             =   1320
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "栏目设置(&S)"
      Height          =   350
      Index           =   2
      Left            =   7500
      TabIndex        =   3
      Top             =   930
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Height          =   350
      Index           =   1
      Left            =   7500
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Height          =   350
      Index           =   0
      Left            =   7500
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin MSFlexGridLib.MSFlexGrid GrdCol 
      Bindings        =   "frmImport.frx":0000
      Height          =   5295
      Left            =   60
      TabIndex        =   0
      Top             =   90
      Width           =   7365
      _ExtentX        =   12991
      _ExtentY        =   9340
      _Version        =   393216
      Cols            =   20
      FixedCols       =   0
      RowHeightMin    =   270
      BackColorBkg    =   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483640
      AllowBigSelection=   0   'False
      FocusRect       =   0
      GridLinesFixed  =   0
      AllowUserResizing=   1
   End
End
Attribute VB_Name = "frmImport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strCurrDec As String
Private strPriceDec As String
Private strSelectItem As String
Private blnSucceed As Boolean
Private mclsList As ListSet
Attribute mclsList.VB_VarHelpID = -1
Private mclsGrid As Grid
Private blnCancelOK As Boolean
Private Const mlngViewID = 1218
Dim mintYear As Integer
Dim mbytPeriod As Byte
Private Type ColProperty
    lngListFieldID As Long
    blnChoose As Boolean
    lngFirstNO As Long
End Type
Private Type RowProperty
    strPath As String
    strData(12) As String
End Type
Private ColPropertys(13) As ColProperty
Private RowPropertys() As RowProperty
Private mstrInPath As String

Public Function ShowMe() As Boolean
    On Error Resume Next
    blnSucceed = False
    Me.Show vbModal
    ShowMe = blnSucceed
End Function

Private Sub chkShowAll_Click()
    ShowAll
End Sub

Private Sub Form_Activate()
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Me.ActiveControl Is GrdCol Then
        Else
            BKKEY Me.ActiveControl.hWnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim i As Long
    Dim j As Long
    Dim lngTmp As Long

    Screen.MousePointer = vbHourglass
    Utility.LoadFormResPicture Me
    Me.HelpContextID = 21001
    strCurrDec = FormatString(gclsBase.NaturalCurDec)
    strPriceDec = FormatString(gclsBase.PriceDec)
    
    GrdCol.Redraw = False
    Set mclsList = New ListSet
    mclsList.ViewId = mlngViewID
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    mclsGrid.ListSet.ViewId = 99999999
    mstrInPath = App.Path & "\inout\"
    GetRowData
    SetGridFromList
    
    Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
    GrdCol.MousePointer = flexDefault
    If GrdCol.ColWidth(0) <> 0 Then
        GrdCol.ColWidth(0) = 0
    End If
    GrdCol.Redraw = True
    Screen.MousePointer = vbDefault
    ListModule.mblnAccountInit = False
    ListModule.mblnCustomerInit = False
    ListModule.mblnItemInit = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Me.MousePointer = vbHourglass Then
        Cancel = 1
        Exit Sub
    End If
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
    Utility.RemoveFormResPicture 2001
    Erase RowPropertys
    Set mclsList = Nothing
    Set mclsGrid.Grid = Nothing
    Set mclsGrid = Nothing
End Sub

Private Sub GrdCol_KeyPress(KeyAscii As Integer)
    With GrdCol
        If KeyAscii = vbKeySpace Then
            If .Row >= .FixedRows Then
                Select Case .TextMatrix(0, .col)
                Case Else
                    If .TextMatrix(.Row, 1) = "" Then
                        SetSelectRow .Row, True
                    Else
                        SetSelectRow .Row, False
                    End If
                End Select
            End If
        End If
    End With
End Sub

Private Sub grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Long
    
    With GrdCol
        If y > .RowHeight(0) Then
            If x < .ColWidth(1) Then
                If y > .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) Then
                    .MousePointer = flexDefault
                Else
                    .MousePointer = 99
                End If
            Else
                .MousePointer = flexDefault
            End If
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                lngRowBak = GrdCol.RowData(GrdCol.MouseRow)
                GrdCol.Row = 0
                GrdCol.col = i

                If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                    
                    GrdCol.Sort = flexSortStringNoCaseDescending
                Else
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                    
                    GrdCol.Sort = 5
                End If

                For j = 1 To GrdCol.Rows - 1
                    If GrdCol.RowData(j) = lngRowBak Then
                        GrdCol.Row = j
                        If Not GrdCol.RowIsVisible(j) Then
                            GrdCol.TopRow = j
                        End If
                        Exit For
                    End If
                Next
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        GrdCol.Redraw = True
    Else
        If y <= GrdCol.RowPos(GrdCol.Rows - 1) + GrdCol.RowHeight(GrdCol.Rows - 1) Then
            If GrdCol.MouseRow >= GrdCol.FixedRows Then
                Select Case GrdCol.TextMatrix(0, GrdCol.col)
                Case Else
                    If GrdCol.MouseCol = 1 Then
                        If GrdCol.TextMatrix(GrdCol.MouseRow, 1) = "" Then
                            SetSelectRow GrdCol.MouseRow, True
                        Else
                            SetSelectRow GrdCol.MouseRow, False
                        End If
                    End If
                End Select
            End If
        End If
    End If
End Sub

Private Sub FirstGrdColWidth()
    Dim i As Integer
    
    For i = 1 To GrdCol.Cols - 1
        GrdCol.ColWidth(i) = IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 11, StrLen(GrdCol.TextMatrix(0, i)) + 1) * Me.TextWidth("A")
    Next
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    If Me.MousePointer = vbHourglass Then
        Exit Sub
    End If
    
    Dim i As Long
    
    Select Case Index
    Case 0
        blnCancelOK = False
        If blnCancelOK Then
            Exit Sub
        End If
        If cmdOK_Click() Then
            Unload Me
        End If
    Case 1
        blnSucceed = False
        Unload Me
    Case 2
        SaveGrdColWidth
        mclsList.ViewId = mlngViewID
        If mclsList.ShowListSet(mlngViewID) = True Then
            SetGridFromList
        End If
    Case 3
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.RowHeight(i) <> 0 Then