1. Trang chủ
  2. » Luận Văn - Báo Cáo

thành lập bộ chương trình cân bằng mạng lưới tựa trọng lực và từ mặt đất; xử lý và quản lý số liệu đo đạc thực địa tài liệu trọng lực và từ; tính hiệu chỉnh ảnh hưởng địa hình trong công tác đo vẽ trọng lực

116 47 1
Tài liệu đã được kiểm tra trùng lặp

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 116
Dung lượng 806,59 KB

Nội dung

cục địa chất khoáng sản việt nam liên đoàn vật lý địa chất đề tài nghiên cứu kh&cn thành lập chơng trình cân mạng lới tựa trọng lực từ mặt đất xử lý quản lý số liệu đo đạc thực địa tài liệu trọng lực từ tính hiệu chỉnh ảnh hởng địa hình công tác đo vẽ trọng lực Chủ nhiệm đề tài: chu quốc khánh hớng dẫn sử dụng chơng trình 7016-3 25/10/2008 Hµ néi – 2007 MỤC LỤC TT Nội dung Trang Phần A Chương trình chung quản lý chương trình Chương trình quản lý chương trình, hướng dẫn sử dụng Phần B Các chương trình trọng lực Chương trình tính cân mạng lưới tựa trọng lực, mạng lưới điểm chuẩn từ mặt đất Chương trình xử lý tính tốn số liệu đo đạc tài liệu trọng lực mặt đất Chương trình tính hiệu chỉnh ảnh hưởng địa hình cơng tác trọng lực Chương trình quản lý sở liệu tài liệu trọng lực mặt đất Phần C Các chương trình từ Chương trình xử lý tính tốn số liệu đo đạc tài liệu từ mặt đất Chương trình quản lý sở liệu tài liệu từ mặt đất 5 5 10 12 14 21 21 26 Bộ chương trình xử lý tính tốn số liệu đo đạc tài liệu trọng lực từ gồm: Chương trình chung quản lý chương trình Chương trình quản lý chương trình, hướng dẫn sử dụng Các chương trình trọng lực: Chương trình tính cân mạng lưới điểm tựa trọng lực, mạng lưới điểm chuẩn từ mặt đất Chương trình xử lý tính tốn số liệu đo đạc tài liệu trọng lực mặt đất Chương trình tính hiệu chỉnh ảnh hưởng địa hình cơng tác trọng lực Chương trình quản lý CSDL tài liệu trọng lực mặt đất Các chương trình từ: Chương trình xử lý tính tốn số liệu đo đạc tài liệu từ mặt đất Chương trình quản lý CSDL tài liệu từ mặt đất PHẠM VI VÀ ĐIỀU KIỆN ÁP DỤNG Chương trình thành lập cở sở quy phạm hành công tác từ “Quy phạm kỹ thuật thăm dò từ mặt đất” trọng lực mặt đất “Quy phạm kỹ thuật cơng tác thăm dị trọng lực”; cở sở thiết bị sử dụng, công tác trọng lực loại máy GNU-KV, GNU-KC, Z400, …; công tác từ máy từ kế proton Minimag, MMP203,… Phạm vi điều kiện áp dụng chương trình cần phù hợp với sở Xin nêu số phạm vi điều kiện áp dụng chương trình Bộ chương trình sử dụng cơng tác đo vẽ trọng lực từ mặt đất với tỷ lệ khác Bộ chương trình thực tốt bước tiến hành công tác thực địa tuân thủ theo quy phạm kỹ thuật hành Các chuyến đo trọng lực phải xuất phát từ điểm tựa kết thúc điểm tựa Các chuyến đo từ phải xuất phát từ điểm chuẩn (hay KT) kết thúc điểm chuẩn (hay KT) Số liệu đo ghi vào sổ đo thực địa máy nêu loại máy có tính tương đương, phương pháp trọng lực giá trị đọc máy; số liệu đo từ, giá trị trường từ toàn phần (T) Số liệu đầu vào modul xử lý công nghệ đo – ghi tự động có định dạng định dạng số liệu từ máy Minimag PHẦN A CHƯƠNG TRÌNH QUẢN LÝ CÁC CHƯƠNG TRÌNH I CHƯƠNG TRÌNH QUẢN LÝ CÁC CHƯƠNG TRÌNH, HƯỚNG DẪN SỬ DỤNG Chương trình quản lý chương trình thành lập đóng gói thành cài đặt hồn chỉnh, độc lập Chương trình có chức quản lý chương trình Cài đặt chương trình - Vào Start menu/ Run Hoặc chạy tự động cài đặt (AutoRun) - Chọn setup.exe/ Open - Trả lời đường dẫn thư mục cài đặt chương trình Chương trình tự động thực việc cài đặt Hướng dẫn sử dụng chương trình Sách điện tử hướng dẫn sử dụng chương trình thành lập menu chương trình quản lý chương trình Hình Menu Hướng dẫn sử dụng giao diện chương trình PHẦN B CÁC CHƯƠNG TRÌNH TRỌNG LỰC II CHƯƠNG TRÌNH TÍNH CÂN BẰNG MẠNG LƯỚI ĐIỂM TỰA TRỌNG LỰC VÀ MẠNG LƯỚI ĐIỂM CHUẨN TỪ MẶT ĐẤT I/ Phạm vi điều kiện thực chương trình Chương trình áp dụng cho khảo sát trọng lực từ mặt đất II/ Các bước thực chương trình 1/ Cài đặt chương trình (CT): Chương trình dịch đóng gói thành cài đặt (Setup) Thực cài đặt chương trình cách nhấp đúp chuột vào file Setup exe, chương trình kích hoạt tự động cài đặt chương trình 2/ Kích hoạt chạy chương trình: Sau cài đặt, chương trình kích hoạt theo hệ thống Start Menu thông thường Window chương trình quản lý chương trình từ trọng lực (Modul quản lý chương trình) Chuẩn bị file số liệu xong, tiến hành tính cân bằng, theo phương pháp sau đây: 3/ Tính theo phương pháp giải phương trình 4/ Tính theo phương pháp Popov 5/ Tính theo phương pháp tuyến trục Trong menu phương pháp trình bày phần trên, có chức nhập số liệu, tính tốn cân bằng, thành lập vẽ, in vẽ, in kết dạng biểu bảng III/ Các chức chương trình 1/ Menu Cân mạng lưới tựa, có menu phụ: - Tính theo phương pháp giải phương trình - Tính theo phương pháp Popov - Tính theo phương pháp tuyến trục Menu có nhiệm vụ thực tính cân mạng lưới điểm chuẩn từ, mạng lưới điểm tựa trọng lực theo phương pháp tương ứng 2/ Menu Hướng dẫn sử dụng, có nhiệm vụ hướng dẫn sử dụng chương trình 3/ Menu phụ Tính theo phương pháp giải phương trình, có phím lệnh nhiệm vụ sau: - Phím Điểm tựa có nhiệm vụ nhập số liệu điểm tựa - Phím Đa giác có nhiệm vụ nhập số liệu đa giác - Phím HPTTT (hệ phương trình tuyến tính): có nhiệm vụ thực việc tính cân - Phím Bản vẽ có nhiệm vụ thành lập vẽ sơ đồ cân mạng lưới tựa - Phím Xem vẽ có nhiệm vụ hiển thị vẽ sơ đồ cân mạng lưới tựa - Phím Hướng dẫn sử dụng có nhiệm vụ hướng dẫn tính theo phương pháp giải phương trình - Phím Màn hình có nhiệm vụ kích hoạt hình - Phím Xuất sang Excel có nhiệm vụ xuất kết tính sang chương trình Excel để in 4/ Menu phụ Tính theo phương pháp Popov, có phím lệnh nhiệm vụ chúng sau: - Phím Điểm tựa, phím Đa giác có nhiệm vụ menu phụ tính theo phương pháp giải phương trình - Phím Popov có nhiệm vụ thực việc tính cân - Phím Bản vẽ, phím Xem vẽ, Hướng dẫn sử dụng, Màn hình chính, Xuất sang Excel có nhiệm vụ giống phương pháp giải phương trình 5/ Menu phụ Tính theo phương pháp tuyến trục, có phím lệnh nhiệm vụ chúng sau: - Phím Tựa có nhiệm vụ nhập số liệu tuyến tựa - Phím Thường có nhiệm vụ nhập số liệu tuyến thường - Phím Xử lý > Bản vẽ có nhiệm vụ thực việc xử lý, tính tốn cân tạo vẽ kết - Phím Kết tựa thực hiển thị kết tuyến tựa sau cân - Phím Kết thường thực hiển thị kết tuyến thường sau cân - Phím Xem vẽ thực hiển thị vẽ kết - Phím Xem in bảng thực hiển thị bảng kết in - Phím Hướng dẫn phím Màn hình có nhiệm vụ giống phương pháp khác IV/ Một số thao tác sử dụng chương trình 1/ Tính cân mạng lưới tựa theo phương pháp giải phương trình a Kích chuột vào menu Cân mạng lưới tựa / Tính theo phương pháp giải phương trình Giao diện chương trình tính theo phương pháp lên b Bấm phím Điểm tựa c Kích chuột vào hộp nhập có dịng chữ "Hãy bấm đúp vào để gọi tên liệu mới" Một giao diện mở file lên, chọn tên file bấm Open, số liệu điểm tựa lên bảng Hoặc nhập số liệu trực tiếp vào bảng bấm vào hộp nhập “Hãy bấm đúp vào để xuất liệu tệp”, giao diện Save As File lên, đặt tên file bấm save để ghi số liệu điểm tựa nhập file d Bấm phím Đa giác e Kích chuột vào hộp nhập có dịng chữ "Hãy bấm đúp vào để gọi tên liệu mới" Một giao diện mở file lên, chọn tên file bấm Open, số liệu đa giác lên bảng Hoặc nhập số liệu trực tiếp vào bảng bấm vào hộp nhập “Hãy bấm đúp vào để xuất liệu tệp”, giao diện Save As File lên, đặt tên file bấm save để ghi số liệu đa giác nhập file f Bấm phím Trước cân để cập nhật số liệu bảng g Bấm phím HPTTT (hệ phương trình tuyến tính) Chương trình thực việc tính cân h Bấm phím Bản vẽ, chương trình tạo vẽ i Bấm phím Xem vẽ xem, chỉnh sửa vẽ, in vẽ k Bấm phím Xuất sang Excel xem, chỉnh sửa, in kết dạng biểu bảng 2/ Tính cân mạng lưới tựa theo phương pháp Popov Các bước theo tác tương tự tính cân mạng lưới tựa theo phương pháp giải phương trình 3/ Tính cân mạng lưới tựa theo phương pháp tuyến trục a Kích chuột vào menu Cân mạng lưới tựa b Kích chuột vào menu phụ PP - tuyến tụa chuẩn c Bấm phím Tựa, kích chuột vào hộp nhập có dịng chữ "Hãy bấm đúp vào để gọi tên liệu mới" Một giao diện mở file lên, chọn tên file số liệu tuyến tựa bấm Open, số liệu điểm tựa lên bảng a Bấm phím Thường, kích chuột vào hộp nhập có dịng chữ "Hãy bấm đúp vào để gọi tên liệu mới" Một giao diện mở file lên, chọn tên file số liệu tuyến thường bấm Open, số liệu điểm tựa lên bảng b Bấm phím Xử lý - Bản vẽ, Thực tính cân kết xuất sang vẽ c Bấm phím Kết tựa, kết tuyến tựa d Bấm phím Kết thường, kết tuyến thường e Bấm phím xem vẽ, để xem vẽ III CHƯƠNG TRÌNH XỬ LÝ TÍNH TỐN SỐ LIỆU ĐO ĐẠC TÀI LIỆU TRỌNG LỰC MẶT ĐẤT I/ Phạm vị điều kiện thực chương trình Chương trình áp dụng cho đo đạc trọng lực mặt đất Mỗi chuyến đo bặt đầu từ điểm tựa, kết thúc điểm tựa II/ Các bước thực chương trình Chương trình dịch thành file dạng *.exe độc lập, chạy máy vi tính 1/ Cài đặt chương trình Chương trình: "Xử lý, tính tốn số liệu đo đạc tài liệu trọng lực" gọi tắt chương trình tính trọng lực (TTL), dịch đóng gói thành cài đặt Kích chuột biểu tượng Setup exe, chương trình cài đặt kích hoạt chạy, người sử dụng trả lời câu hỏi đưa đường dẫn tên thư mục 2/ Cài đặt đường dẫn đến file quản lý đề án trọng lực Chương trình (CT) kết nối với chương trình quản lý đề án (QLCĐA) trọng lực nên trước sử dụng chương trình cần cài đặt đường dẫn đến file quản lý đề án trọng lực Khi cài đặt xong, chương trình tính trọng lực mở đề án trọng lực mà "Chương trình quản lý đề án trọng lực" (CTQLCĐATL) quản lý Trường hợp không cài đặt đường dẫn này, chương trình khơng mở đề án trọng lực mà chương trình quản lý đề án trọng lực quản lý, mà mở đề án chọn 3/ Thành lập đề án Trước nhập số liệu đo đạc tài liệu thuộc đề án, cần thực việc thành lập đề án Việc thành lập đề án thực việc thành lập thư mục gốc đề án, hệ thống thư mục phụ, tạo file hạt giống, đường dẫn, 4/ Mở đề án Có hai cách mở đề án: a Mở đề án sau cài đặt đường dẫn đến file quản lý đề án trọng lực, cách chọn mở đề án quản lý b Mở đề án Trường hợp thành lập đề án làm việc với đề án này, trường hợp công tác thực địa 5/ Làm việc với đề án Sau chọn tên mở đề án, giao diện làm việc với đề án mở 6/ Tạo danh sách người thi công Mở danh sách người thi công, nhập tên người đo máy, mã hiệu người 7/ Tạo danh sách điểm tựa giá trị Mở danh sách tựa, nhập tên điểm tựa giá trị Có thể nhập từ file có sẵn sản từ chương trình cân mạng lưới tựa Hình 1: Giao diện làm việc với đề án trọng lực 8/ Tạo danh sách máy đo Mở danh sách máy đo, nhập tên máy đo hệ số máy Hoặc nhập tên máy hệ số máy thực việc nhập số liệu đo tính chuyến đo, chuẩn máy (Menu phụ đo chuẩn máy), giá trị hệ số máy tự động cập nhật vào danh sách 9/ Nhập tính chuyến đo chuẩn máy Sau nhập tính chuyến đo chuẩn máy, hệ số máy cập nhật vào danh sách máy đo 10/ Nhập tính chuyến đo tựa Kết giá trị gia số cạnh tựa 11/ Nhập tính chuyến đo điểm thường trọng lực Kết quản file chứa giá trị trọng lực quan sát (gqs) 12/ Kiểm tra bảng thành trọng lực Thực việc tra cứu, tìm kiếm, xắp xếp, lọc giá trị trọng lực quan sát 13/ Ghép kết trọng lực với kết trắc địa hiệu chỉnh ảnh hưởng địa hình Thực menu trọng lực - trắc địa Thực tạo tính tốn từ bảng trắc địa, tạo bảng hiệu chỉnh địa hình, hiển thị kết trọng lực - trắc địa 14/ Tính sai số điểm đo thường trọng lực tồn đề án Tính menu sai số đề án III/ Các menu chương trình Chương trình có menu menu phụ sau: Chuyến đo: - Đo chuẩn máy - Chuyến đo tựa - Chuyến đo thường Tựa Máy Người thi công Trọng lực Trọng lực - trắc địa Sai số đề án Thốt Menu phụ đo chuẩn máy có nhiệm vụ nhập số liệu đo tính chuyến đo chuẩn máy trọng lực Kết chuẩn máy hệ số máy chuẩn, giá trị cập nhật vào file thông tin máy đo Menu phụ chuyến đo tựa có nhiệm vụ nhập số liệu đo tính chuyến đo tựa trọng lực Kết giá trị gia số điểm tựa (cạnh tựa), ghi file caccanhtua.txt File sử dụng chương trình cân mạng lưới tựa Menu phụ chuyến đo thường có nhiệm vụ nhập số liệu đo tính chuyến đo thường trọng lực Kết file số liệu đo, tính chuyến đo, thông tin chuyến đo ghi file chuyenđo.txt kết gqs ghi file thanhqua.txt Menu tựa có nhiệm vụ hiển thị, cập nhập giá trị điểm tựa trọng lực Menu máy có nhiệm vụ hiển thị, cập nhật máy trọng lực sử dụng đề án Menu người thi cơng có nhiệm vụ hiển thị, cập nhật danh sách người thi công 10 Menu trọng lực có nhiệm vụ hiển thị giá trị trọng lực quan sát (gqs) Menu trọng lực - trắc địa có nhiệm vụ ghép kết trọng lực với kết trắc địa, ghép kết hiệu chỉnh địa hình, tính tốn giá trị Fai, Bughê Menu sai số đề án có nhiệm vụ tính giá trị sai số đo đạc điểm thường trọng lực tồn đề án Menu có nhiệm vụ thoát khỏi giao diện làm việc với đề án, giao diện chương trình IV/ Một số thao tác sử dụng chương trình Sau chương trình, đường dẫn cài đặt, nhập tên người đo, tên máy, tiến hành nhập số liệu đo tính tốn số liệu theo số bước sau: 1/ Đo chuẩn máy Để tính tốn giá trị hệ số máy làm sau: a Kích chuột vào Chuyến đo / Đo chuẩn máy / Xoá ghi bảng tính sai số chuẩn máy b Kích chuột vào Chuyến đo / Đo chuẩn máy / Tính toán chuyến đo / Chuyến Thực việc nhập số liệu vào ô Ngày đo, Máy đo, Người đo, Chuyến đo, Tên điểm (Tên điểm chuẩn), H60 (thời gian đo, SoM (Giá trị đọc), Delta G (Gia số hai điểm chuẩn) c Bấm phím Tính tốn d Bấm phím Ghi tệp e Bấm phím Bảng SS, bảng sai số f Bấm phím Thốt Thực lặp lại bước từ b đến f để thực việc nhập tính cho tồn chuyến đo chuẩn máy máy g Kích chuột vào Chuyến đo / Đo chuẩn máy / Tính tốn sai số Chương trình tính tốn xong cho việc chuẩn máy trọng lực Công việc thực lặp lại từ a đến g chuẩn máy trọng lực khác 2/ Chuyến đo điểm tựa trọng lực Để tính toán giá trị gia số cạnh tựa làm sau: a Kích chuột Chuyến đo / Chuyến đo tựa / Xố ghi bảng tính sai số đo tựa b Kích chuột vào Chuyến đo / Chuyến đo tựa / Tính tốn chuyến đo tựa c Bấm phím Chuyến mới, tiến hành nhập thơng tin số liệu chuyến đo tựa (Ngày đo, Máy đo, Người đo, Chuyến đo, Tên điểm (tựa), H60 (Thời gian), SoM (Số đọc máy)) d Bấm phím Tính tốn e Bấm phím Ghi tệp f Bấm phím Bảng SS, bảng sai số g Bấm phím Thốt 11 End Sub Private Sub cmdDelete_Click() With datPrimaryRS.Recordset Delete MoveNext If EOF Then MoveLast End With End Sub Private Sub CmdInDiemtua_Click() Set DataEnvironmentCBDG = Nothing DataEnvironmentCBDG.Data79_97.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Data79_97.mdb" + ";Persist Security Info=False;" If (Printer.Orientation = cdlPortrait) And (Printer.PaperSize = 8) Then Load DataReportDiemtua Else MsgBox "Please, Set your printer to [A3 & Portrait-orienttation] to open the report!" End If End Sub Private Sub CmdIntuatreo_Click() Set DataEnvironmentCBDG = Nothing DataEnvironmentCBDG.Data79_97.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Data79_97.mdb" + ";Persist Security Info=False;" If (Printer.Orientation = cdlPortrait) And (Printer.PaperSize = 8) Then Load DataReportTuaTreo Else MsgBox "Please, Set your printer to [A3 & Portrait-orienttation] to open the report!" End If End Sub Private Sub cmdRefresh_Click() datPrimaryRS.Refresh End Sub Private Sub cmdUpdate_Click() datPrimaryRS.UpdateRecord datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified End Sub Private Sub cmdClose_Click() Screen.MousePointer = vbDefault Unload Me End Sub Private Sub Command1_Click() datPrimaryRSTreo.Refresh End Sub Private Sub Command2_Click() 'db.Synchronize db.Close End Sub Private Sub Command3_Click() Call setdatabase1 End Sub Private Sub datPrimaryRS_Error(DataErr As Integer, Response As Integer) MsgBox "Data error event hit err:" & Error$(DataErr) Response = 'Throw away the error End Sub Private Sub datPrimaryRS_Reposition() Screen.MousePointer = vbDefault On Error Resume Next datPrimaryRS.Caption = "Record: " & (datPrimaryRS.Recordset.AbsolutePosition + 1) End Sub Private Sub datPrimaryRS_Validate(Action As Integer, Save As Integer) 'This is where you put validation code 'This event gets called when the following actions occur Select Case Action Case vbDataActionMoveFirst Case vbDataActionMovePrevious Case vbDataActionMoveNext Case vbDataActionMoveLast Case vbDataActionAddNew Case vbDataActionUpdate Case vbDataActionDelete Case vbDataActionFind Case vbDataActionBookmark Case vbDataActionClose Screen.MousePointer = vbDefault End Select Screen.MousePointer = vbHourglass End Sub Private Sub datPrimaryRSTreo_Reposition() Screen.MousePointer = vbDefault On Error Resume Next datPrimaryRSTreo.Caption = "Record: " & (datPrimaryRSTreo.Recordset.AbsolutePosition + 1) End Sub Private Sub Form_Activate() 'Call setdatabase1 'DataEnvironmentCBDG.Data79_97.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Data79_97.mdb" + ";Persist Security Info=False;" 'Set db = datPrimaryRS.Database End Sub Private Sub Form_Load() 'Set DataEnvironmentCBDG.Connections.Item("Data79_97") = Nothing 'DataEnvironmentCBDG.Connections.Item("Data79_97").Close 'DataEnvironmentCBDG.Connections.Item("Data79_97").Mode = adModeShareExclusive 'DataEnvironmentCBDG.Connections.Item("Data79_97").Open 'MsgBox DataEnvironmentCBDG.Connections.Item("Data79_97").IsolationLevel 'MsgBox DataEnvironmentCBDG.Connections.Item("Data79_97").Attributes 'MsgBox DataEnvironmentCBDG.Connections.Item("Data79_97").ConnectionString 'MsgBox DataEnvironmentCBDG.Connections.Item("Data79_97").Mode datPrimaryRS.DatabaseName = tencsdl1() DataDiemGoc.DatabaseName = tencsdl1() 'CurDir+"\data79_97.mdb" datPrimaryRS.RecordSource = "Select [ttdinh],[shdiem],[X],[Y],[giatriTruocCB],[giatriSauCB],[loaitua],[vungCT],[ghic hu] from [diemtua] Order by loaitua,[ttdinh]" datPrimaryRS.Refresh datPrimaryRSTreo.DatabaseName = tencsdl1() 'CurDir "\data79_97.mdb" datPrimaryRSTreo.RecordSource = "tuatreo" datPrimaryRSTreo.Refresh TxtSodiemtua = db.TableDefs("diemtua").RecordCount Txtsodiemtuatreo = db.TableDefs("tuatreo").RecordCount End Sub Private Sub Form_Unload(Cancel As Integer) Screen.MousePointer = vbDefault End Sub Private Sub Form_Resize() On Error Resume Next End Sub Private Sub Text1_DblClick() Dim i As Integer, x1, y1, shd1, sodiemtua, sodiemtuatreo, ii As Integer Dim goc1 As Integer, treo1 As Integer, deltag1 As Double Dim tg As Recordset Set DataEnvironmentCBDG = Nothing tenbang = datPrimaryRS.RecordSource db.Execute "Cleandiemtua", dbInconsistent Set t1 = db.OpenRecordset(tenbang) With FileTXT Filter = "*.txt" DialogTitle = "Open file *.txt" FilterIndex = Flags = FileOpenConstants.cdlOFNHideReadOnly '.cdlOFNOverwritePrompt '.cdlOFNHideReadOnly ShowOpen End With If Len(FileTXT.FileName) > Then Text1.Text = FileTXT.FileName If InStr(1, Text1.Text, ".txt") = Then Text1.Text = Text1.Text + ".txt" End If Else Exit Sub End If db.Execute "Clean_GocDiem", dbInconsistent Set tg = db.OpenRecordset("GocDiem") Open pathTofile(Text1) + "GocDiem.txt" For Input As #1 Line Input #1, sodiemtua For i = To sodiemtua Input #1, ii, shd1 tg.AddNew tg("stt") = ii tg("SHdiem_Goc") = shd1 tg.Update Next tg.Close Close #1 thumucData = pathTofile(Text1) 'Open App.Path + "\duongdan.txt" For Output As #1 'Print #1, pathTofile(Text1) 'Close #1 Open Text1 For Input As #1 Input #1, sodiemtua For i = To sodiemtua Input #1, ii, x1, y1 Input #1, shd1 t1.AddNew t1("ttdinh") = ii t1("shdiem") = shd1 tentua(i) = shd1 t1("X") = x1 x(i) = x1 t1("Y") = y1 y(i) = y1 t1("ghichu") = True t1("loaitua") = t1.Update Next Input #1, shd1 t1.Close db.Execute "Cleantuatreo", dbInconsistent Set t = db.TableDefs(datPrimaryRSTreo.RecordSource) Set t1 = t.OpenRecordset Line Input #1, sodiemtuatreo For i = To sodiemtuatreo Input #1, treo1, goc1, deltag1 t1.AddNew t1("stt") = i t1("shdiemtuatreo") = tentua(treo1) t1("giasoTreo_goc") = deltag1 t1("X") = x(treo1) t1("Y") = y(treo1) t1("shdiemtuagoc") = tentua(goc1) t1("loaitua") = t1("ghichu") = "" t1.Update Next t1.Close Close #1 't.Close db.QueryDefs.Refresh db.Execute "UpdateDiemtuaTreo", dbInconsistent db.TableDefs.Refresh db.Close Unload frmdiemtua Call setdatabase11 'db.Close Call setdatabase1 Load frmdiemtua datPrimaryRS.Refresh datPrimaryRSTreo.Refresh DataDiemGoc.Refresh MsgBox "Hi!" Set DataEnvironmentCBDG = Nothing DataEnvironmentCBDG.Data79_97.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Data79_97.mdb" + ";Persist Security Info=False;" datPrimaryRS.Refresh datPrimaryRSTreo.Refresh DataDiemGoc.Refresh End Sub Private Sub Text2_DblClick() Dim i As Integer, x1, y1, shd1, sodiemtua, sodiemtuatreo, ii As Integer Dim goc1 As Integer, treo1 As Integer, deltag1 As Double Dim tg As Recordset tenbang = datPrimaryRS.RecordSource 'db.Execute "Cleandiemtua", dbInconsistent Set t1 = db.OpenRecordset(tenbang) With FileTXT Filter = "*.txt" DialogTitle = "Save to *.txt" FilterIndex = FileName = "dinh.txt" Flags = FileOpenConstants.cdlOFNOverwritePrompt '.cdlOFNHideReadOnly '.cdlOFNOverwritePrompt '.cdlOFNHideReadOnly ShowSave End With If Len(FileTXT.FileName) > Then Text2.Text = FileTXT.FileName If InStr(1, Text2.Text, ".txt") = Then Text2.Text = Text2.Text + ".txt" End If Else Exit Sub End If Open Text2 For Output As #1 t1.MoveLast sodiemtua = t1.RecordCount t1.MoveFirst Print #1, sodiemtua Print #1, "1" & Chr$(9) & Format$(t1("X"), "0.##") & Chr$(9) & Format$(t1("Y"), "0.##") Print #1, t1("SHdiem") For i = To sodiemtua t1.MoveNext Print #1, str$(i) & Chr$(9) & Format$(t1("X"), "0.##") & Chr$(9) & Format$(t1("Y"), "0.##") Print #1, t1("SHdiem") Next Print #1, Chr$(34) & "Treo" & Chr$(34) t1.Close Set t1 = db.OpenRecordset("treoImExport") t1.MoveLast Print #1, str$(t1.RecordCount) t1.MoveFirst Print #1, str$(t1("sttTreo")) & Chr$(9) & t1("sttGoc") & Chr$(9) & Format$(t1("giasoTreo_goc"), "0.##") For i = To t1.RecordCount t1.MoveNext Print #1, str$(t1("sttTreo")) & Chr$(9) & t1("sttGoc") & Chr$(9) & Format$(t1("giasoTreo_goc"), "0.##") Next t1.Close Close #1 FileCopy App.Path & "\GocDiem.txt", pathTofile(Text2) & "GocDiem.txt" If Text2 "Text2" Then MsgBox "Hi!" & "Here your file " & Text2 End If End Sub Private Sub DataHCthuong_Reposition() DataHCthuong.Caption = "Record: " & CStr(DataHCthuong.Recordset.AbsolutePosition + 1) End Sub Private Sub DataThuongChuaHC_Reposition() DataThuongChuaHC.Caption = "Record: " & CStr(DataThuongChuaHC.Recordset.AbsolutePosition + 1) End Sub Private Sub Form_Activate() On Error GoTo n1: Call setdatabase 'Set db = OpenDatabase(CurDir + "\minimagData97.mdb") If IsNull(db) = True Then Call setdatabase 'Set db = OpenDatabase(CurDir + "\minimagData97.mdb") End If n1: TxtSoluong = db.TableDefs("thuongMN").RecordCount Set grdDataGrid.DataSource = datPrimaryRS.Recordset("ChildCMD").UnderlyingValue TxtSotuyenthuongHC = DataHCthuong.Recordset.RecordCount TxtThuongChuaHC = DataThuongChuaHC.Recordset.RecordCount End Sub Private Sub Form_Initialize() On Error Resume Next DataHCthuong.DatabaseName = tencsdl() DataThuongChuaHC.DatabaseName = tencsdl() DataThuongChuaHC.RecordSource = "ChuaHCThuong" 'DataHCthuong.DatabaseName = CurDir + "\minimagData97.mdb" DataHCthuong.RecordSource = "HCthuong" datPrimaryRS.ConnectionString = ConnectionStr() 'datPrimaryRS.ConnectionString = "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" + "D:\_doan79" + "\minimagData97.mdb;" datPrimaryRS.RecordSource = "SHAPE {select stt,tuyen,loaituyen,ghichu,vungCT from QLtuyenThuong Order by stt} AS ParentCMD APPEND ({select stt,x,y,dT,TUYEN,T,T0,tuyen1,HCtuachuan,dTHC from thuongMN } AS ChildCMD RELATE tuyen TO TUYEN) AS ChildCMD" datPrimaryRS.Refresh End Sub Private Sub Form_Load() On Error Resume Next DataHCthuong.DatabaseName = tencsdl() DataHCthuong.RecordSource = "HCthuong" DataThuongChuaHC.DatabaseName = tencsdl() DataThuongChuaHC.RecordSource = "ChuaHCThuong" datPrimaryRS.ConnectionString = ConnectionStr() 'datPrimaryRS.ConnectionString = "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" + "D:\_doan79" + "\minimagData97.mdb;" datPrimaryRS.RecordSource = "SHAPE {select stt,tuyen,loaituyen,ghichu,vungCT from QLtuyenThuong Order by stt} AS ParentCMD APPEND ({select stt,x,y,dT,TUYEN,T,T0,tuyen1,HCtuachuan,dTHC from thuongMN } AS ChildCMD RELATE tuyen TO TUYEN) AS ChildCMD" datPrimaryRS.Refresh On Error GoTo n1: Call setdatabase 'Set db = OpenDatabase(CurDir + "\minimagData97.mdb") If IsNull(db) = True Then Call setdatabase 'Set db = OpenDatabase(CurDir + "\minimagData97.mdb") End If n1: Set grdDataGrid.DataSource = datPrimaryRS.Recordset("ChildCMD").UnderlyingValue End Sub Private Sub Form_Resize() On Error Resume Next 'This will resize the grid when the form is resized 'grdDataGrid.Width = Me.ScaleWidth 'grdDataGrid.Height = Me.ScaleHeight - grdDataGrid.Top datPrimaryRS.Height - 30 - picButtons.Height End Sub Private Sub Form_Unload(Cancel As Integer) Screen.MousePointer = vbDefault End Sub Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean) 'This is where you would put error handling code 'If you want to ignore errors, comment out the next line 'If you want to trap them, add code here to handle them Print "Wait, please " End Sub Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) 'This will display the current record position for this recordset datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition) End Sub Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) 'This is where you put validation code 'This event gets called when the following actions occur Dim bCancel As Boolean Select Case adReason Case adRsnAddNew Case adRsnClose Case adRsnDelete Case adRsnFirstChange Case adRsnMove Case adRsnRequery Case adRsnResynch Case adRsnUndoAddNew Case adRsnUndoDelete Case adRsnUndoUpdate Case adRsnUpdate End Select If bCancel Then adStatus = adStatusCancel End Sub Private Sub cmdAdd_Click() On Error GoTo AddErr datPrimaryRS.Recordset.AddNew Exit Sub AddErr: MsgBox Err.Description End Sub Private Sub cmdDelete_Click() On Error GoTo DeleteErr With datPrimaryRS.Recordset Delete MoveNext If EOF Then MoveLast End With Exit Sub DeleteErr: MsgBox Err.Description End Sub Private Sub cmdRefresh_Click() 'This is only needed for multi user apps On Error GoTo RefreshErr datPrimaryRS.Refresh Set grdDataGrid.DataSource = datPrimaryRS.Recordset("ChildCMD").UnderlyingValue Exit Sub RefreshErr: MsgBox Err.Description End Sub Private Sub cmdUpdate_Click() On Error GoTo UpdateErr datPrimaryRS.Recordset.UpdateBatch adAffectAll Exit Sub UpdateErr: MsgBox Err.Description End Sub Private Sub cmdClose_Click() Unload Me End Sub Private Sub TxtFileThuong_DblClick() Dim stt1 As Long, x1 As Double, y1 As Double, tt1 As Double Dim t01 As Double, dt1 As Double, tuyen1a As String, tuyena As String Dim str1 As String, t1 As Recordset, str2 As String Dim GT As Variant db.Execute "Deletechonsl", dbInconsistent Set t1 = db.OpenRecordset("chonsl") With CMDL Filter = "*.txt" DialogTitle = "Open file *.txt" FilterIndex = Flags = FileOpenConstants.cdlOFNHideReadOnly ShowOpen End With If Len(CMDL.FileName) > Then TxtFileThuong.Text = CMDL.FileName 'If InStr(1, TxtFileThuong.Text, ".txt") = Or InStr(1, TxtFileThuong.Text, ".TXT") = Then 'TxtFileThuong.Text = TxtFileThuong.Text + ".txt" 'End If Else Exit Sub End If Open TxtFileThuong For Input As #1 Do While EOF(1) = False Line Input #1, str2 GT = Split(str2, ",", -1, vbTextCompare) stt1 = Val(GT(0)) x1 = Val(GT(1)) y1 = Val(GT(2)) tt1 = Val(GT(3)) t01 = Val(GT(4)) dt1 = Val(GT(5)) tuyen1a = GT(6) tuyena = GT(7) t1.AddNew t1("stt") = stt1 t1("x") = x1 t1("y") = y1 t1("T") = tt1 t1("T0") = t01 t1("dT") = dt1 If Left$(tuyen1a, 1) = Chr$(34) Then t1("tuyen1") = Right$(Left$(tuyen1a, Len(tuyen1a) - 1), Len(tuyen1a) - 2) t1("TUYEN") = Right$(Left$(tuyena, Len(tuyena) - 1), Len(tuyena) - 2) Else t1("tuyen1") = tuyen1a t1("TUYEN") = tuyena End If t1.Update Loop TxtSoluong = t1.RecordCount t1.Close Close #1 db.Execute "DeleteQLtuyenThuong", dbInconsistent db.Execute "chonslToQLThuong", dbInconsistent db.Execute "DeletethuongMN", dbInconsistent db.Execute "chonslToThuong", dbInconsistent datPrimaryRS.Refresh grdDataGrid.Refresh datPrimaryRS.Recordset.MoveFirst datPrimaryRS.Recordset.Fields("stt") = datPrimaryRS.Recordset.Update For i = To datPrimaryRS.Recordset.RecordCount datPrimaryRS.Recordset.MoveNext datPrimaryRS.Recordset.Fields("stt") = i datPrimaryRS.Recordset.Update Next datPrimaryRS.Recordset.MoveFirst txtFields(0).Refresh txtFields(1).Refresh txtFields(2).Refresh txtFields(3).Refresh txtFields(4).Refresh MsgBox "Hi!" End Sub Private Sub TextFileHC_DblClick() Dim i As Integer, j As Integer Dim t As Recordset, str As String Dim retval Dim path1 As String Dim EXCEL1 As Object With CMDL Filter = "*.txt" DialogTitle = "Save to file *.txt" FilterIndex = Flags = FileOpenConstants.cdlOFNOverwritePrompt '.cdlOFNOverwritePrompt '.cdlOFNHideReadOnly ShowSave End With If Len(CMDL.FileName) > Then TextFileHC.Text = CMDL.FileName If InStr(1, TextFileHC.Text, ".") = Then TextFileHC.Text = TextFileHC.Text + ".txt" End If Else Exit Sub End If Open TextFileHC For Output As #1 Set t = db.OpenRecordset("HCthuong") With t MoveFirst str = t(1).Name For j = To t.Fields.Count - str = str & ", " & t(j).Name Next Print #1, str Do While Not EOF str = t(1) For j = To t.Fields.Count - str = str & ", " & t(j) Next Print #1, str MoveNext Loop Close End With Close #1 Set EXCEL1 = CreateObject("Word.Application") path1 = EXCEL1.Path + "\WinWord.exe" 'MsgBox Chr$(34) + path1 + Chr$(34) + " " + Chr$(34) + TextTenFile + Chr$(34) retval = Shell(Chr$(34) + path1 + Chr$(34) + " " + Chr$(34) + TextFileHC + Chr$(34), 1) End Sub Private Sub TextTenFile_DblClick() Dim i As Integer, j As Integer Dim t As Recordset, str As String Dim retval Dim path1 As String Dim EXCEL1 As Object With CMDL Filter = "*.txt" DialogTitle = "Open file *.txt" FilterIndex = Flags = FileOpenConstants.cdlOFNOverwritePrompt '.cdlOFNOverwritePrompt '.cdlOFNHideReadOnly ShowSave End With If Len(CMDL.FileName) > Then TextTenFile.Text = CMDL.FileName If InStr(1, TextTenFile.Text, ".") = Then TextTenFile.Text = TextTenFile.Text + ".txt" End If Else Exit Sub End If Open TextTenFile For Output As #1 'datPrimaryRS.Recordset("ChildCMD").UnderlyingValue 'Set t = db.OpenRecordset(datPrimaryRS.Recordset("ChildCMD").UnderlyingValue) Set t = db.OpenRecordset("thuongMN") With t MoveFirst str = t(0).Name For j = To t.Fields.Count - str = str & ", " & t(j).Name Next Print #1, str Do While Not EOF str = t(0) For j = To t.Fields.Count - str = str & ", " & t(j) Next Print #1, str MoveNext Loop Close End With Close #1 Set EXCEL1 = CreateObject("Word.Application") path1 = EXCEL1.Path + "\WinWord.exe" 'MsgBox Chr$(34) + path1 + Chr$(34) + " " + Chr$(34) + TextTenFile + Chr$(34) retval = Shell(Chr$(34) + path1 + Chr$(34) + " " + Chr$(34) + TextTenFile + Chr$(34), 1) End Sub

Ngày đăng: 04/10/2023, 21:17

TỪ KHÓA LIÊN QUAN

TÀI LIỆU CÙNG NGƯỜI DÙNG

TÀI LIỆU LIÊN QUAN

w