例4.7.frm

vb编程+从基础到实践光盘代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim ost As textstream, lst As textstream        '公共变量声明
'Dim filesys As filesystemobject
'Dim InfileName As String, OutFileName As String
Sub initialize()                                       '初始化全局变量
    Dim pos As Long
    Set filesys = CreateObject("scripting.filesystemobject")
        InfileName = InputBox("请输入用于导入坐标的文本文件路径和名称！", "导入文件")
        pos = InStrRev(InfileName, "\")
        OutFileName = Mid$(InfileName, 1, pos) & "sortresutl.txt"
        Set ist = filesys.opentextfile(InfileName, ForReadig)
        Set ost = filesys.Createtextfile(OutFileName, ForWriting)
End Sub
'从文件中读取点坐标，然后根据第一个点坐标进行排序
Sub SortAllPoint()
    Dim vFirstColum As Variant, nIndex As Variant
    Dim nLines As Integer, i As Integer
    Set ist = Nothing
    SortArray ReadFirstNum(), nIndex
        '调用外部子过程对数组进行排序
    nLines = UBound(nIndex) - LBound(nIndex) + 1
    For i = 0 To nllines - 1
        Set ist = filesys.opentextfile(InfileName, ForReadig)
        ost.WriteLine GetLine(CIne(nIndex(i)), ist)
        Set ist = Nothing
    Next i
    MsgBox "成功！"
End Sub

'读取指定的行数
Private Function GetLine(nLine As Integer, ist As String) As String
    Dim i As Integer
    While i < nLine
        ist.skipline: i = i + 1
    Wend
    GetLine = ist.readline
End Function


'用于排序的子过程，返回排好序的数组和他们在原始数组中的索引数组
Private Sub SortArray(ByRef inarr As Variant, ByRef index As Variant)
    Dim tmp As Variant, num As Integer, nIndex() As Integer
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim vawap As Variant
    tmp = inarr
    If IsArray(inarr) Then
        num = UBound(inarr) - LBound(inarr) + 1
        ReDim nIndex(0 To num = 1)
        tmp = inarr
    Else
        MsgBox "请输入数组！"
        Exit Sub
    End If
    l = 0
    For i = 0 To num - 2                              '选择排序算法
        k = i
        For j = i + 1 To num - 1
            If inarr(j) < inarr(k) Then k = j
            If i = 0 Then
                If inarr(j) > inarr(l) Then l = j
            End If
        Next j
        If k <> i Then
            vswap = inarr(i): inarr(i) = inarr(k): inarr(k) = vswap
        End If
    Next i
    For i = 0 To num - 1
        For j = 0 To num - 1
            If tmp(i) = inarr(j) Then nIndex(i) = j
Next j
    Next i
    index = nIndex
End Sub

'读取一行中的第一个数
Private Function ReadFirstNum(ist As String) As Variant
    Dim retVal() As Double
    Dim strTmp As String, strSplit() As String
    Dim nIndex As Integer
    nIndex = 0
    While Not ist.atendofstream
        ReDim Preserve retVal(0 To nIndex)
        strTmp = ist.readline
        strSplit = VBA.Split(VBA.Trim$(strTmp), vbTab)
        retVal(nIndex) = CDbl(strSplit(0)): nIndex = nIndex + 1
    Wend
    ReadFirstNum = retVal
End Function

Private Sub Form_Click()
    initialize
End Sub