Nghiên cứu và thành lập bộ chương trình hiệu chỉnh và liên kết tài liệu từ phổ gamma hàng không 1

bộ tài nguyên và môi trờng
cục địa chất và khoáng sản việt nam
liên đoàn vật lý địa chất
_______________________________________



đề tài

Nghiên cứu và thành lập bộ chơng trình hiệu chỉnh
và liên kết tài liệu từ phổ gamma hàng không


Chủ nhiệm : Ks Kiều Trung Thuỷ




Phụ lục 1
M Chơng trình









6322-1

22/3/2007




Hà Nội 2006




1

MụC LụC



Trang
1 Chuyên đề 1: Gắn toạ độ 2
2 Chuyên đề 2: Cắt bay vòng 16
3 Chuyên đề 3: Hiệu chỉnh deviaxia và biến thiên
từ
23
4 Chuyên đề 4: Tính sai phân từ, cân bằng mạng
lới tựa.
30
5 Chuyên đề 5: Liên kết các tuyến thờng 52
6 Chuyên đề 6: Tính sai số tài liệu từ 59
7 Chuyên đề 7: Tính dị thờng từ 65
8 Chuyên đề 8, 9, 10, 11: Liên kết tài liệu phổ
gamma theo tuyến kiểm tra, hiệu chỉnh compton,

hiệu chỉnh độ cao, tính chuyển hàm lợng.
69
9 Chuyên đề 12: Lọc tài liệu phổ gamma 79
10 Chuyên đề 13: Tính sai số tài liệu xạ phổ gamma 84
11 Chuyên đề 14: Liên kết tài liệu xạ phổ gamma
dựa vào tuyến tựa,
90
12 Chuyên đề 15: Tính sai số tài liệu xạ phổ
gamma.
101
13 Chuyên đề 16: Mã hoá và phân loại dị thờng 112


2
I. Chuyên đề 1 : Gắn toạ độ
I.1 Chuyển format WGS84 -> CTranfer
Private Sub Ctranfer_Click()
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String

With List1
Screen.MousePointer = vbHourglass
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
ProBar1.Max = .ListCount
ProBar1.Visible = True

For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\" & Left$(List1.List(Index),
(Len(List1.List(Index)) - 4)) & ".c84"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path & Left$(List1.List(Index), (Len(List1.List(Index)) - 4))
& ".c84"
End If
FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 4))
& ".c84"
Call W84(filespec, filespeckq)
ProBar1.Value = Index + 1
Next

End If
Screen.MousePointer = vbDefault
FrmKetqua.Label1.Caption = " Ket qua chua trong thu muc : " & LCase(Dir1.Path)
FrmKetqua.Show vbModal
ProBar1.Visible = False
End With
Call Dir1_Change

End Sub
Private Function W84(filespec As String, filespeckq As String)
Dim modefile As Boolean
modefile = False
On Error GoTo MsgError

3

Dim strOUT(25000) As String
Dim strin(25000) As String
Dim j As Integer, numvals As Integer, sodd As Integer
Dim myvar As Variant

Dim ngay(), Gio(), VD(), KD(), docao() As String

If LCase(Right$(filespec, 3)) = LCase("W84") Then
'khoi doc file text
numvals = 0
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim fso_G As New FileSystemObject
Dim ts_G As TextStream
Dim tam_STR As String
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
strin(numvals) = ts.ReadLine
Loop
ts.Close
sodd = numvals
ReDim ngay(sodd - 1), Gio(sodd - 1), VD(sodd - 1), KD(sodd - 1), docao(sodd - 1)
If sodd <= 20000 Then
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 22 To sodd - 1
Dim i As Integer

Dim toado As String
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)

Next
Dim KDdo, KDphut, KDgiay, VDdo, VDphut, VDgiay As String
Dim VDKD, tam1(2), tam2(2) As String
Dim tam As Double

If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
Dim SPL As Variant
Dim m As Integer
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)

4
tam1(m) = SPL(m)
Next
'vido
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60

If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)

tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)

5
End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"
KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
Else

Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 22 To 10000
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)

Next
If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)
tam1(m) = SPL(m)
Next
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)

6
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60

End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)

End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"
KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else

7
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
filespeckq = filespeckq + "A"
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 10001 To sodd - 1
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)

Next

If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)
tam1(m) = SPL(m)
Next
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"

8
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"

KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
End If
MsgError:

9
If modefile = False Then MsgBox ("Loi mo file. File : " & filespec & " Khong dung
format")

Else
MsgBox ("Chi lam viec voi file WGS84 !" & filespec)
Exit Function
End If

End Function

I.2 Chuyển format Ctranfer -> Btranfer

Private Sub Btranfer_Click()
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String

With List1
Screen.MousePointer = vbHourglass
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
ProBar1.Max = .ListCount
ProBar1.Visible = True

For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\" & Left$(List1.List(Index),
(Len(List1.List(Index)) - 3)) & ".B84"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path & Left$(List1.List(Index), (Len(List1.List(Index)) - 3))
& ".B84"
End If
FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 3))
& ".B84"
Call CTra_BTra(filespec, filespeckq)
ProBar1.Value = Index + 1
Next

End If
Screen.MousePointer = vbDefault
FrmKetqua.Label1.Caption = " Ket qua chua trong thu muc : " & LCase(Dir1.Path)
FrmKetqua.Show vbModal

10

ProBar1.Visible = False
End With
Call Dir1_Change

End Sub
Private Function CTra_BTra(filespec As String, filespeckq As String)
Dim modefile As Boolean
modefile = False
On Error GoTo MsgError

Dim j As Integer, numvals As Integer, sodd As Integer
Dim ngay() As String, Gio() As String, VD() As String, KD() As String, toado() As
String
Dim STT() As Integer
Dim strin(25000) As String
Dim myvar As Variant
If LCase(Right$(filespec, 3)) = LCase("rpt") Then
numvals = 0
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim fso_G As New FileSystemObject
Dim ts_G As TextStream

Dim tam_STR As String
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
strin(numvals) = ts.ReadLine
Loop
ts.Close
sodd = numvals

ReDim ngay(sodd - 1), Gio(sodd - 1), VD(sodd - 1), KD(sodd - 1), toado(sodd - 2)
ReDim STT(sodd - 1)

Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 10 To sodd - 6
Dim i As Integer
myvar = Split(strin(j), " ")
For i = LBound(myvar) To UBound(myvar)
Next
Gio(j) = Left$(Right$(myvar(0), 11), 8)
VD(j) = Right$(myvar(0), 2) + myvar(1) + Left$(myvar(2), 7)
KD(j) = Right$(myvar(2), 3) + myvar(3) + myvar(4)
KD(j) = Left$(KD(j), 11)
toado(j) = CStr(j - 9) + " " + Gio(j) + " " + VD(j) + " " + KD(j)

11
ts_G.WriteLine (toado(j))
modefile = True
Next
ts_G.Close
MsgError:

If modefile = False Then MsgBox ("Loi mo file. File : " & filespec & " Khong dung
format")

Else
MsgBox ("Chi xu ly file *.rpt !")
End If

End Function

I.3 Gắn toạ độ
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String
Dim modeOK As Integer
Dim sfilename As String
With List1
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
sfilename = CurDir & "\tuxakt.mdb"
sfilename = Dir(sfilename)
If sfilename <> vbNullString Then
ProBar1.Max = .ListCount
ProBar1.Visible = True

For Index = 0 To .ListCount - 1
If Index > 0 Then
If Right$(List1.List(Index), 3) <> Right$(List1.List(Index - 1), 3) Then

MsgBox ("Chi ghep cac file cung ten tuyen !")
Screen.MousePointer = vbDefault
Exit Sub
End If
End If
Next
Dim thumuc As String
If (Right$(Dir1.Path, 1) <> "\") Then
thumuc = Dir1.Path & "\"
Else
thumuc = Dir1.Path

12
End If

Frm_GanTD.Text1.Text = Left$(Right$(thumuc, 7), 6) & ".vn2"
Frm_GanTD.Show vbModal
modeOK = Frm_GanTD.Check1.Value
Select Case modeOK
Case 1:
Dim traloi As Integer
Dim tg() As Long, Tu() As Long
Dim Fid() As Integer, Tc() As Integer, Ka() As Integer, Ur() As Integer,
Th() As Integer, Alt() As Integer
Dim Td As String, fileTd As String, Dich_file As String, tentuyen As
String
Td = Frm_GanTD.Text1.Text
fileTd = thumuc & Td
Dich_file = thumuc & Frm_GanTD.Text2.Text & ".dat"
tentuyen = Frm_GanTD.Text2.Text

If Dir(fileTd) <> vbNullString Then
If tentuyen <> vbNullString Then
If Dir(Dich_file) <> vbNullString Then
traloi = MsgBox("Da co file: " & tentuyen & ".dat. Ban co muon ghi
de khong ?", vbOKCancel)
If traloi = vbCancel Then
MsgBox ("Chay lai chuong trinh gan toa do, nhap ten khac : " &
tentuyen)
Exit Sub
Else
Kill (Dich_file)
End If
End If
Dim ngay As String
Dim numvals As Integer, sodd As Integer, HesoTG As Integer
ngay = Left$(Td, 6)
Dim PA_str6 As String
Dim cnn6 As ADODB.Connection
Dim search6 As ADODB.Recordset
PA_str6 = "select * from Heso_TG where line =" + "'" & tentuyen +
"'" + " AND Date =" + "'" & ngay + "'"
Set cnn6 = New ADODB.Connection
cnn6.ConnectionString = "provider=microsoft.jet.oledb.4.0;"
cnn6.Open duongdan & "tuxakt.mdb"

Set search6 = New ADODB.Recordset
search6.Open PA_str6, cnn6, adOpenDynamic
If search6.EOF And search6.BOF Then
search6.Close

13
HesoTG = 13
Else
HesoTG = search6!hs_tg
End If
cnn6.Close
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim STRline(10000) As String
Dim tam_STR As String

numvals = 0
For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
Else
filespec = Dir1.Path & List1.List(Index)
End If
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
STRline(numvals) = ts.ReadLine
Loop
ts.Close
Next
sodd = numvals
ReDim tg(sodd), Fid(sodd), Tu(sodd), Tc(sodd), Ka(sodd), Ur(sodd),
Th(sodd), Alt(sodd)
Dim k As Integer
Dim myvar As Variant

For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
Else
filespec = Dir1.Path & List1.List(Index)
End If
Set ts = fso.OpenTextFile(filespec)
numvals = 0
Do While Not ts.AtEndOfStream
numvals = numvals + 1
STRline(numvals) = ts.ReadLine
Loop
ts.Close
Dim j As Integer
For j = 8 To numvals
Dim i As Integer

14
k = k + 1
myvar = Split(STRline(j), " ")
For i = LBound(myvar) To UBound(myvar)

Next
tg(k) = CLng(myvar(0))
Fid(k) = CLng(myvar(1))
Tu(k) = CLng(myvar(2))
Tc(k) = CLng(myvar(3))
Ka(k) = CLng(myvar(4))
Ur(k) = CLng(myvar(5))

Th(k) = CLng(myvar(6))
Alt(k) = CLng(myvar(7))
Next
Next
sodd = k
Dim TongFID As Integer
TongFID = k

Dim tam As String
'mo file toado
Dim numvalsTD As Long, SoddTD As Long, jTD As Long
Dim fso_TD As New FileSystemObject
Dim ts_TD As TextStream
Dim STRline_TD(50000) As String
Dim tam_STR_TD As String
Set ts_TD = fso_TD.OpenTextFile(fileTd)
numvalsTD = 0
Do While Not ts_TD.AtEndOfStream
numvalsTD = numvalsTD + 1
STRline_TD(numvalsTD) = ts_TD.ReadLine
Loop
ts_TD.Close
SoddTD = numvalsTD

Dim fso_G As New FileSystemObject
Dim ts_G As TextStream
Set ts_G = fso_G.CreateTextFile(Dich_file)

ReDim Giay(SoddTD), Gio(SoddTD), B(SoddTD), L(SoddTD),
X(SoddTD), Y(SoddTD)

For jTD = 16 To SoddTD - 10
Dim iTD As Integer
myvar = Split(STRline_TD(jTD), ".")
For i = LBound(myvar) To UBound(myvar)
Next

15

Gio(jTD) = Left$(Right$(myvar(0), 15), 8) 'chuoi(2)
If CInt(Left$(Gio(jTD), 2)) = 23 Then
Giay(jTD) = CLng(Left$(Gio(jTD), 2) + 7 - 24) * 3600 +
Mid$(Gio(jTD), 4, 2) * 60 + Right$(Gio(jTD), 2)
Else
Giay(jTD) = CLng(Left$(Gio(jTD), 2) + 7) * 3600 +
Mid$(Gio(jTD), 4, 2) * 60 + Right$(Gio(jTD), 2)
End If
If Giay(jTD) <= Giay(jTD - 1) Then
MsgBox ("Kiem tra lai thoi gian : " & Gio(jTD))
Exit Sub
End If
B(jTD) = Right$(myvar(0), 6) + "." + Left$(Left$(myvar(1),
(Len(myvar(1)) - 7)), 4)
L(jTD) = Right$(myvar(1), 7) + "." + Left$(Left$(myvar(2),
(Len(myvar(2)) - 7)), 4)
X(jTD) = Right$(myvar(2), 7) + "." + Left$(Left$(myvar(3),
(Len(myvar(3)) - 6)), 3)
Y(jTD) = Right$(myvar(3), 6) + "." + myvar(4)
For k = 1 To TongFID
If Giay(jTD) = tg(k) + HesoTG Then
tam = CStr(tg(k)) + " " + B(jTD) + " " + L(jTD) + " " +

X(jTD) + " " + Y(jTD) + " " + CStr(Fid(k)) + " " + CStr(Tu(k)) + " " + CStr(Tc(k)) + "
" + CStr(Ka(k)) + " " + CStr(Ur(k)) + " " + CStr(Th(k)) + " " + CStr(Alt(k)) + " " +
ngay + " " + tentuyen
ts_G.WriteLine (tam)
End If
Next
Next
ts_G.Close
Else
MsgBox ("Nhap ten file ket qua cua tuyen bay !")
Exit Sub
End If
Else
MsgBox ("Khong tim thay file : " & fileTd)
Exit Sub
End If

Case 0:
Exit Sub
End Select


For Index = 0 To .ListCount - 1

16
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\"
Else
filespec = Dir1.Path & List1.List(Index)

filespeckq = Dir1.Path
End If

ProBar1.Value = Index + 1
Next
Else
MsgBox ("Khong tim thay Tuxakt.mdb")
Exit Sub
End If
End If
Screen.MousePointer = vbDefault
MsgBox "Da xu ly song ! Ket qua chua trong : " & Dir1.Path, vbInformation +
vbOKOnly
ProBar1.Visible = False
End With
Call Dir1_Change
End Sub

II. Chuyên đề 2 : Cắt bay vòng
Private Sub catvong_Click()
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String
With List1
Screen.MousePointer = vbHourglass
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else

ProBar1.Max = .ListCount
ProBar1.Visible = True
For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path
End If

17
FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 3))
& "cvg"
Call catvong_f(filespec, filespeckq)
ProBar1.Value = Index + 1
Next
Screen.MousePointer = vbDefault
FrmKetqua.Label1.Caption = " Ket qua chua trong thu muc : " & LCase(filespeckq)
FrmKetqua.Show vbModal
ProBar1.Visible = False
End If
End With
Call Dir1_Change

End Sub
Private Function catvong_f(filespec As String, Tmuckq As String)
Dim modefile As Boolean
Dim j As Integer
modefile = False

On Error GoTo MsgError

Dim fileKQ As String
Dim sodd As Integer
Dim numvals As Integer
Dim TTg() As Long
Dim TB() As Double
Dim TL() As Double
Dim TY() As Double
Dim TX() As Double
Dim TFid() As Integer
Dim TTu() As Long
Dim TTC() As Long
Dim TTh() As Long
Dim TUr() As Long
Dim TKa() As Long
Dim TALT() As Long
Dim TNgay() As String
Dim TTuyen() As String

Dim tg() As Long
Dim B() As Double
Dim L() As Double
Dim Y() As Double
Dim X() As Double
Dim Fid() As Integer
Dim Tu() As Long
Dim Tc() As Long

18

Dim Th() As Long
Dim Ur() As Long
Dim Ka() As Long
Dim Alt() As Long
Dim ngay() As String
Dim tuyen() As String

Dim STRline(10000) As String
'split
Dim myvar As Variant
Dim KieuPC As Integer
Dim phancach As String
phancach = ","

numvals = 0
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim fso_G As New FileSystemObject
Dim ts_G As TextStream
Dim tam_STR As String
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
STRline(numvals) = ts.ReadLine
Loop
ts.Close
sodd = numvals
ReDim tg(sodd)
ReDim B(sodd)
ReDim L(sodd)

ReDim Y(sodd)
ReDim X(sodd)
ReDim Fid(sodd)
ReDim Tu(sodd)
ReDim Tc(sodd)
ReDim Th(sodd)
ReDim Ur(sodd)
ReDim Ka(sodd)
ReDim Alt(sodd)
ReDim ngay(sodd)
ReDim tuyen(sodd)

ReDim TTg(sodd)
ReDim TB(sodd)
ReDim TL(sodd)
ReDim TY(sodd)

19
ReDim TX(sodd)
ReDim TFid(sodd)
ReDim TTu(sodd)
ReDim TTC(sodd)
ReDim TTh(sodd)
ReDim TUr(sodd)
ReDim TKa(sodd)
ReDim TALT(sodd)
ReDim TNgay(sodd)
ReDim TTuyen(sodd)

KieuPC = InStr(1, STRline(2), phancach, 1)

For j = 1 To sodd
Dim i As Integer
If KieuPC = 0 Then
myvar = Split(STRline(j), " ")
For i = LBound(myvar) To UBound(myvar)
Next
Else
myvar = Split(STRline(j), ",")
For i = LBound(myvar) To UBound(myvar)
Next
End If
TTg(j) = CLng(myvar(0))
TB(j) = CDbl(myvar(1))
TL(j) = CDbl(myvar(2))
TY(j) = CDbl(myvar(3))
TX(j) = CDbl(myvar(4))
TFid(j) = CLng(myvar(5))
TTu(j) = CLng(myvar(6))
TTC(j) = CLng(myvar(7))
TKa(j) = CLng(myvar(8))
TUr(j) = CLng(myvar(9))
TTh(j) = CLng(myvar(10))
TALT(j) = CLng(myvar(11))
TNgay(j) = CStr(myvar(12))
TTuyen(j) = CStr(myvar(13))
Next
'
'cat lan 1
Dim X_dau As Double
Dim Y_dau As Double

Dim X_cuoi As Double
Dim Y_cuoi As Double
Dim TS_X As Double
Dim TS_Y As Double

20

Y_cuoi = TY(sodd)
X_cuoi = TX(sodd)

X_dau = TX(1)
Y_dau = TY(1)
TS_X = (X_cuoi - X_dau) / sodd
TS_Y = (Y_cuoi - Y_dau) / sodd

Dim m As Integer
Dim sodd_CV As Integer
Dim ModeY As Boolean
Dim ModeX As Boolean
Dim modecat() As Boolean
m = 0
'
For j = 1 To sodd
If j = 1 Then
m = m + 1
tg(m) = TTg(j)
B(m) = TB(j)
L(m) = TL(j)
Y(m) = TY(j)
X(m) = TX(j)

Fid(m) = TFid(j)
Tu(m) = TTu(j)
Tc(m) = TTC(j)
Ka(m) = TKa(j)
Ur(m) = TUr(j)
Th(m) = TTh(j)
Alt(m) = TALT(j)
ngay(m) = TNgay(j)
tuyen(m) = TTuyen(j)
Else
If Abs(TS_Y) > Abs(TS_X) Then
ModeY = True
If (TS_Y / (TY(j) - TY(j - 1))) > 0 Then
m = m + 1
tg(m) = TTg(j)
B(m) = TB(j)
L(m) = TL(j)
Y(m) = TY(j)
X(m) = TX(j)
Fid(m) = TFid(j)
Tu(m) = TTu(j)
Tc(m) = TTC(j)

21
Ka(m) = TKa(j)
Ur(m) = TUr(j)
Th(m) = TTh(j)
Alt(m) = TALT(j)
ngay(m) = TNgay(j)
tuyen(m) = TTuyen(j)

End If
Else
ModeX = True
If (TS_X / (TX(j) - TX(j - 1))) > 0 Then
m = m + 1
tg(m) = TTg(j)
B(m) = TB(j)
L(m) = TL(j)
Y(m) = TY(j)
X(m) = TX(j)
Fid(m) = TFid(j)
Tu(m) = TTu(j)
Tc(m) = TTC(j)
Ka(m) = TKa(j)
Ur(m) = TUr(j)
Th(m) = TTh(j)
Alt(m) = TALT(j)
ngay(m) = TNgay(j)
tuyen(m) = TTuyen(j)
End If
End If
End If
Next
sodd_CV = m
'cat lan 2
ReDim modecat(sodd)

modecat(1) = False
Dim tam As Double
For j = 1 To sodd_CV

If j = 1 Then
modecat(1) = True 'False
If ModeY = True Then
tam = Y(j)
End If
If ModeX = True Then
tam = X(j)
End If
End If
If j > 1 Then

22
If (tg(j) - tg(j - 1)) = 1 Then
modecat(j) = False
If ModeY = True Then
tam = Y(j)
End If
If ModeX = True Then
tam = X(j)
End If
Else
If ModeX = True Then
If X_dau < X_cuoi Then
If X(j) > tam Then
modecat(j) = False
Else
modecat(j) = True
End If
Else
If X(j) < tam Then

modecat(j) = False
Else
modecat(j) = True
End If
End If
End If
If ModeY = True Then
If Y_dau < Y_cuoi Then
If Y(j) > tam Then
modecat(j) = False
Else
modecat(j) = True
End If
Else
If Y(j) < tam Then
modecat(j) = False
Else
modecat(j) = True
End If
End If
End If
End If
End If
Next
'ghi file ket qua
fileKQ = Tmuckq & TTuyen(5) & ".cvg"
Set ts_G = fso_G.CreateTextFile(fileKQ)
For j = 1 To sodd_CV

23

If modecat(j) = False Then
tam_STR = CStr(tg(j)) + " " + CStr(B(j)) + " " + CStr(L(j)) + " " + CStr(Y(j)) +
" " + CStr(X(j)) + " " + CStr(Fid(j)) + " " + CStr(Tu(j)) + " " + CStr(Tc(j)) + " " +
CStr(Ka(j)) + " " + CStr(Ur(j)) + " " + CStr(Th(j)) + " " + CStr(Alt(j)) + " " +
CStr(ngay(j)) + " " + CStr(tuyen(j))
ts_G.WriteLine (tam_STR)
End If
Next
modefile = True
Close
MsgError:
If modefile = False Then MsgBox ("Loi mo file. File : " & filespec & " Khong dung
format")

End Function

III. Chuyên đề 3 : Hiệu chỉnh deviaxia và biến thiên từ
Private Sub BTT_DV_Click()
Dim Index As Integer
Dim filespec As String, sfilename As String
Dim filespeckq As String, thumuc As String
Dim modeOK As Boolean
With List1
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
sfilename = CurDir & "\tuxakt.mdb"
sfilename = Dir(sfilename)

If sfilename <> vbNullString Then
If (Right$(Dir1.Path, 1) <> "\") Then
thumuc = Dir1.Path & "\"
Else
thumuc = Dir1.Path
End If
Dim thumuc_BTT As String
FrmBTT_dialog.Text1.Text = thumuc
FrmBTT_dialog.Show vbModal
modeOK = FrmBTT_dialog.Check1.Value
ModeBTTK = FrmBTT_dialog.Option1.Value
thumuc_BTT = FrmBTT_dialog.Text1.Text
Select Case modeOK
Case 1:
Call Bienthientu(thumuc_BTT)
Case 0:

24
Exit Sub
End Select
Screen.MousePointer = vbDefault
ProBar1.Visible = False
Else
MsgBox ("Khong tim thay Tuxakt.mdb")
Exit Sub
End If

End If
End With
Call Dir1_Change

End Sub
Public Sub Bienthientu(thumuc_BTT As String)
Dim Index As Integer
Dim filespec As String, filespeckq As String
With List1
ProBar1.Max = .ListCount
ProBar1.Visible = True
For Index = 0 To .ListCount - 1
If LCase(Right$(List1.List(Index), 3)) = LCase("DAT") Or
LCase(Right$(List1.List(Index), 3)) = LCase("CVG") Or
LCase(Right$(List1.List(Index), 3)) = LCase("LKX") Then
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path
End If
Dim modefile As Boolean
Dim j As Integer
modefile = False

Dim sodd As Integer
Dim numvals As Integer
Dim tg() As Long
Dim B() As Double
Dim L() As Double
Dim Y() As Double
Dim X() As Double

Dim Fid() As Integer
Dim Tu() As Long
Dim Tc() As Long
Dim Th() As Long