Nghiên cứu ứng dụng hệ phần mềm xử lý số liệu khí tượng bề mặt và hệ phần mềm xử lý số liệu thuỷ văn vùng sông không ảnh hưởng triều hồ sơ kỹ thuật phần mềm xử lý số liệu khí tượng bề mặt

Private Sub txtSTNO_KeyPressKeyAscii As Integer Select Case KeyAscii Case vbKey0 To vbKey9, 8, 47, 67, 99, 80, 112 Private Sub txtSTNO_LostFocus If txtSTNO.Text "" And txtYear.Text

Trang 1

BỘ TÀI NGUYÊN VÀ MÔI TRƯỜNG

TRUNG TÂM KHÍ TƯỢNG THỦY VĂN QUỐC GIA

BÁO CÁO TỔNG KẾT ĐỀ TÀI NGHIÊN CỨU KHOA HỌC VÀ CÔNG NGHỆ CẤP BỘ:

Trang 2

CHƯƠNG TRÌNH NGUỒN

Chương trình in:

1 In trang bìa BKT1:

Option Explicit

Option Compare Text

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtSTNO.Text) = "" Or Trim(txtYear.Text) = "" Or Trim(txtMonth.Text) = "" Then Exit Sub

Private Sub cmdSave_Click()

If Trim(txtSTNO.Text) = "" Then Exit Sub

Save Trim(txtSTNO.Text)

End Sub

Private Sub txtMonth_LostFocus()

If txtSTNO.Text <> "" And txtYear.Text <> "" And txtMonth.Text <> "" Then

Show_Data txtSTNO, CInt(txtYear.Text), CByte(txtMonth.Text)

Trang 3

Private Sub txtSTNO_KeyPress(KeyAscii As Integer)

Select Case KeyAscii

Case vbKey0 To vbKey9, 8, 47, 67, 99, 80, 112

Private Sub txtSTNO_LostFocus()

If txtSTNO.Text <> "" And txtYear.Text <> "" And txtMonth.Text <> "" Then Show_Data txtSTNO, CInt(txtYear.Text), CByte(txtMonth.Text)

Trang 4

Case vbKey0 To vbKey9, 8

Private Sub txtMonth_KeyPress(KeyAscii As Integer)

Trang 5

Sub Save(ByVal STNO As String)

Dim rsStation_mas As dao.Recordset

strSQL = strSQL & "FROM STATION_MAS "

strSQL = strSQL & "WHERE (((STATION_MAS.STNO)='" & STNO & "'));" Set rsStation_mas = db.OpenRecordset(strSQL)

With rsStation_mas

Trang 6

If Not EOF Then

Dim datEnMonth As Date

Dim rsInstruments As dao.Recordset

Trang 7

Dim rsObservator As dao.Recordset

strSQL = strSQL & "FROM (STATION_MAS INNER JOIN AREA "

strSQL = strSQL & "ON STATION_MAS.AreaID = AREA.AreaID) "

strSQL = strSQL & "INNER JOIN PROVINCE ON STATION_MAS.ProvinceID = PROVINCE.ProvinceID "

strSQL = strSQL & "WHERE (((STATION_MAS.STNO)='" & STNO & "'));"

Set rsStation_mas = db.OpenRecordset(strSQL)

With rsStation_mas

If RecordCount > 0 Then

'If Not IsNull(!AreaName) Then rsCover!Region = !AreaName

If Not IsNull(!ProvinceName) Then

If Not IsNull(!AL) Then

txtAL.Text = !AL & " m"

Trang 8

If Not IsNull(!Lon) Then

Set rsStation_mas = Nothing

strSQL = "select * from istruments "

Trang 9

strSQL = strSQL & "where stno='" & STNO & "'"

Select Case !InstrID

Case 1 'nhiet ke kho

If Not IsNull(!InstrType) Then txtAtmos_Type.Text = !InstrType

If Not IsNull(!InstrMadeIn) Then txtAtmos_Madein.Text = !InstrMadeIn

If Not IsNull(!InstrCorr) Then txtAtmosCorrection.Text = !InstrCorr

If Not IsNull(!InstrHeight) Then txtAtmosHeight.Text = !InstrHeight & " m"

Trang 10

Set rsInstruments = Nothing

strSQL = "SELECT * FROM observators"

strSQL = strSQL & " Where (STNO ='" & STNO & "')"

Set rsObservator = db.OpenRecordset(strSQL)

Trang 11

Sub ObservatorDefine(OBS As String, OBS1 As String, OBS2 As String, _

OBS3 As String, LineCount As Integer)

Dim intHyphenPos As Integer

Dim intOBSNumber As Integer

Dim intBeginString As Integer

For intHyphenPos = 1 To Len(OBS)

If Mid(OBS, intHyphenPos, 1) = "," Then

Dim intX As Integer

Dim intY As Integer

Dim intTopMargin As Integer

Dim intLeftMargin As Integer

Trang 12

Dim intRightMargin As Integer

Dim intBottomMargin As Integer

Dim intLineSpace As Integer

Dim intLeftSpace As Integer

Dim intRowHeight As Integer

Trang 13

Dim strOBS As String

Dim strOBS1 As String

Dim intObsLine As Integer

intY = intY + intRowHeight

If Trim(txtObservator.Text) <> "" Then

strOBS = Trim(txtObservator.Text)

ObservatorDefine strOBS, strOBS1, strOBS2, strOBS3, intObsLine

Trang 14

Printer.CurrentX = intLeftMargin + intLeftSpace + 130 Printer.CurrentY = intY

Printer.Print strOBS1

If strOBS2 <> "" Then

Printer.Print Trim(strOBS2)

End If

intY = intY + (4 - intObsLine) * intRowHeight

'intY = intY + intRowHeight

Trang 17

If InStr(1, txtDayVV.Text, Chr(13)) > 0 Then

Printer.CurrentX = intLeftMargin + intLeftSpace + 85

Printer.CurrentY = intY

Printer.Print Mid(txtDayVV.Text, 1, InStr(1, txtDayVV.Text, Chr(13)))

Trang 18

Dim intCHR13 As Integer

Dim intCHR13_1 As Integer

intCHR13 = InStr(intCHR13_1, txtNote.Text, Chr(13))

End If

Else

Trang 19

Dim strPrinter As String

Dim intX As Integer

Dim intY As Integer

Trang 20

Printer.Line (intLeftMargin + intLineSpace, intTopMargin +

intLineSpace)-(intRightMargin - intLineSpace, intTopMargin + intLineSpace)

intLineSpace)-(intLeftMargin + intLineSpace, intBottomMargin - intLineSpace)

Printer.Line (intRightMargin - intLineSpace, intTopMargin +

intLineSpace)-(intRightMargin - intLineSpace, intBottomMargin - intLineSpace)

Printer.Line (intLeftMargin + intLineSpace, intBottomMargin - (intRightMargin - intLineSpace, intBottomMargin - intLineSpace)

Trang 21

Printer.CurrentX = intLeftMargin + intLeftSpace Printer.CurrentY = intY

Trang 22

Printer.Print "Họ, tên tr-ỏng trạm: "

Printer.Print "Họ, tên quan trắc viên: "

Printer.Print "Hiệu chính khí cụ:"

Printer.Print "Độ cao chậu khí áp trên mặt biển: "

Printer.Print "Máy gió Vild số:"

Printer.Print "Độ cao trên mặt đất: "

Printer.Print "Máy gió tự báo số:"

Trang 23

Printer.Print "Máy gió tự ghi số:"

Printer.Print "Thùng đo m-a số: "

Printer.Print "ống đo bốc hơi Piche số: "

Trang 24

Printer.Print "NhiÖt kÕ tèi cao sè: "

Printer.CurrentX = intLeftMargin + intLeftSpace

Printer.Print "trong lÒu"

Printer.Print "NhiÖt kÕ tèi cao sè: "

Printer.Print "NhiÖt kÕ tèi thÊp sè:"

Printer.Print "§ång hå kiÓu: §Ó bµn §iÒu chØnh theo giê: §µi TiÕng nãi ViÖt Nam"

Printer.Print "C¸c tiªu ®iÓm tÇm nh×n ngang: "

Printer.Print "- Lóc trêi tèi:"

Printer.Print "- Lóc trêi s¸ng:"

intY = intY + 2 * intRowHeight

Trang 25

Printer.FontSize = 12

Printer.Print "Ghi chú: (Thay đổi vị trí trạm, v-ờn quan trắc, máy thiết bị hoặc

điều chỉnh máy tự ghi v.v )"

Printer.FontSize = 13

Printer.Print "Họ tên ng-ời lập bảng: "

Printer.Print "Họ tên và nhận xét của tr-ởng trạm "

Printer.Print "Họ tên và nhận xét của kiểm soát viên: "

Printer.Print "Họ tên và nhận xét của ng-ời kiểm tra cuối cùng: "

End Sub

Private Sub txtYear_LostFocus()

End If

End Sub

Trang 26

2 In bìa BKT10:

Option Explicit

Option Compare Text

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtSTNO.Text) = "" Or Trim(txtYear.Text) = "" Or Trim(txtMonth.Text) = "" Then Exit Sub

Private Sub cmdSave_Click()

If Trim(txtSTNO.Text) = "" Then Exit Sub

Save Trim(txtSTNO.Text)

End Sub

Private Sub txtMonth_LostFocus()

Trang 27

Private Sub txtSTNO_KeyPress(KeyAscii As Integer)

Case vbKey0 To vbKey9, 8, 47, 67, 99, 80, 112

Private Sub txtSTNO_LostFocus()

Private Sub txtYear_KeyPress(KeyAscii As Integer)

Trang 28

Private Sub txtMonth_KeyPress(KeyAscii As Integer)

Trang 29

Sub Save(ByVal STNO As String)

strSQL = strSQL & "FROM STATION_MAS "

strSQL = strSQL & "WHERE (((STATION_MAS.STNO)='" & STNO & "'));" Set rsStation_mas = db.OpenRecordset(strSQL)

Trang 30

Sub ShowCorDF24OfLstDay(ByVal STNO As String, ByVal Year As Integer, _

ByVal Month As Byte)

Dim bytDay As Byte

strSQL = strSQL & "') AND (DDAY=" & bytDay

strSQL = strSQL & ") AND (mMonth=" & Month

strSQL = strSQL & ") AND (yYear=" & Year

strSQL = strSQL & ") AND (HOUR=24))"

Sub Show_Data(STNO As String, Year As Integer, Month As Integer)

Trang 31

Dim rsInstruments As dao.Recordset

Dim rsObservator As dao.Recordset

strSQL = strSQL & "FROM (STATION_MAS INNER JOIN AREA "

strSQL = strSQL & "ON STATION_MAS.AreaID = AREA.AreaID) "

strSQL = strSQL & "INNER JOIN PROVINCE ON STATION_MAS.ProvinceID = PROVINCE.ProvinceID "

strSQL = strSQL & "WHERE (((STATION_MAS.STNO)='" & STNO & "'));"

Set rsStation_mas = db.OpenRecordset(strSQL)

With rsStation_mas

If RecordCount > 0 Then

'If Not IsNull(!AreaName) Then rsCover!Region = !AreaName

If Not IsNull(!ProvinceName) Then

If Not IsNull(!AL) Then

txtAL.Text = !AL & " m"

Trang 32

Set rsStation_mas = Nothing

strSQL = "SELECT * FROM ISTRUMENTS"

Trang 33

If Not IsNull(!InstrMadeIn) Then txtAuto_write_wind_madein.Text =

Set rsInstruments = Nothing

strSQL = "SELECT * FROM observators"

Set rsObservator = db.OpenRecordset(strSQL)

Trang 34

Sub Page_BKT10_1(STNO As String, Name As String, Year As Integer, Month As Integer)

Dim strPrinter As String

Dim intX As Integer

Dim intY As Integer

intLineSpace)-(intRightMargin - intLineSpace, intTopMargin + intLineSpace)

Trang 35

Printer.Line (intLeftMargin + intLineSpace, intTopMargin + (intLeftMargin + intLineSpace, intBottomMargin - intLineSpace)

Printer.Line (intRightMargin - intLineSpace, intTopMargin + (intRightMargin - intLineSpace, intBottomMargin - intLineSpace)

Printer.Line (intLeftMargin + intLineSpace, intBottomMargin - (intRightMargin - intLineSpace, intBottomMargin - intLineSpace)

Trang 36

Printer.Print "§é cao v-ên quan tr¾c trªn mÆt biÓn:"

Printer.Print "M¸y giã tù ghi sè:"

Printer.Print "Hä, tªn tr-áng tr¹m: "

Trang 37

Printer.Print "Hä, tªn quan tr¾c viªn: "

Printer.Print "TrÞ sè 24h ngµy cuèi th¸ng tr-íc:"

Printer.Print "Ghi chó:"

Printer.Print "Hä tªn ng-êi lËp b¶ng: "

Dim intX As Integer

Dim intY As Integer

Trang 38

Trang 39

If Trim(txtStationManeger.Text) <> "" Then

Trang 40

Dim strOBS As String

Dim intObsLine As Integer

End If

Dim intCHR13 As Integer

Dim intCHR13_1 As Integer

If Trim(txtNote.Text) <> "" Then

intCHR13 = InStr(1, txtNote.Text, Chr(13))

If intCHR13 > 0 Then

Tiêu đề	Nghiên cứu Ứng dụng Hệ Phần Mềm Xử Lý Số Liệu Khí Tượng Bề Mặt Và Hệ Phần Mềm Xử Lý Số Liệu Thuỷ Văn Vùng Sông Không Ảnh Hưởng Triều Hồ Sơ Kỹ Thuật Phần Mềm Xử Lý Số Liệu Khí Tượng Bề Mặt
Trường học	National Center for Meteorology and Hydrology (Trung tâm Khí tượng Thủy văn Quốc gia)
Chuyên ngành	Meteorology and Hydrology
Thể loại	báo cáo tổng kết đề tài nghiên cứu khoa học và công nghệ cấp bộ
Năm xuất bản	2007
Thành phố	Hà Nội

Định dạng
Số trang	1.423
Dung lượng	1,64 MB