地图分幅编号C 语言编程,[转载]地形图分幅与编号程序（VB）

地形图分幅与编号程序(VB)

徐州师范大学测绘学院 俞礼彬

基于数字测图原理与方法，本程序主要有两个模块组成，即由经纬度推算图幅编号，或由图幅编号推算经纬度，程序界面及运行情况如下所示：

运行结果：

程序代码(VB)：

Private Sub Command1_Click()

Dim j1 As Integer, j2 As Integer, j3 As Double, j As Double

Dim w1 As Integer, w2 As Integer, w3 As Double, w As Double

Dim a As Integer, astr As String

Dim b As Integer, bstr As String

Dim bili As String, daima As String, dj As Double, dw As

Double

Dim cmod As Double, dmod As Double

Dim c As Integer, d As Integer, dx As Double

If Text1(0) = "" Or Text1(1) = "" Or Text1(2) = "" Then

MsgBox

"请输入经度相关数据！", vbExclamation, "警告"

Exit

Sub

End If

If Text2(0) = "" Or Text2(1) = "" Or Text2(2) = "" Then

MsgBox

"请输入纬度相关数据！", vbExclamation, "警告"

Exit

Sub

End If

j1 = Val(Text1(0).Text): j2 = Val(Text1(1).Text): j3 =

Val(Text1(2).Text)

w1 = Val(Text2(0).Text): w2 = Val(Text2(1).Text): w3 =

Val(Text2(2).Text)

j = j1 + j2 / 60 + j3 / 3600

w = w1 + w2 / 60 + w3 / 3600

If j > 180 Or j < 0 Then

MsgBox

"经度不符合要求！", vbExclamation, "警告"

Exit

Sub

End If

If w > 90 Or w < 0 Then

MsgBox

"纬度不符合要求！", vbExclamation, "警告"

Exit

Sub

End If

a = Int(w1 / 4) + 1

b = Int(j1 / 6) + 31

astr = Chr(64 + a)

bstr = CStr(b)

Text3 = astr

Text4 = bstr

bili = Combo1.List(Combo1.ListIndex)

If bili = "" Then

MsgBox

"请选择比例尺！", vbExclamation, "警告"

Exit

Sub

End If

If bili = "1：100万" Then

Label5.Visible = False

Label6.Visible = False

Label7.Visible = False

Text5.Visible = False

Text6.Visible = False

Text7.Visible = False

Text8 = astr

+ bstr

Exit

Sub

ElseIf bili = "1：50万" Then

daima =

"B"

dj = 3

dw = 2

ElseIf bili = "1：25万" Then

daima =

"C"

dj =

1.3

dw = 1

ElseIf bili = "1：10万" Then

daima =

"D"

dj =

0.3

dw =

0.2

ElseIf bili = "1：5万" Then

daima =

"E"

dj =

0.15

dw =

0.1

ElseIf bili = "1：2.5万" Then

daima =

"F"

dj =

0.073

dw =

0.05

ElseIf bili = "1：1万" Then

daima =

"G"

dj =

0.0345

dw =

0.023

ElseIf bili = "1：5000" Then

daima =

"H"

dj =

0.01525

dw =

0.0115

End If

cmod = (w / 4 - Int(w / 4)) * 4

dmod = (j / 6 - Int(j / 6)) * 6

cmod = cmod * 3600

dmod = dmod * 3600

c = 4 * 3600 / switch(dw) - (cmod switch(dw))

d = dmod switch(dj) + 1

Text5 = Format(c, "000")

Text6 = Format(d, "000")

Text7 = daima

Text8 = astr + bstr + daima + Format(c, "000") + Format(d,

"000")

End Sub

Private Sub

Command2_Click()

Dim bianhao As String

Dim astr As String, bstr As String

Dim a As Integer, b As Integer, jint As Integer, wint As

Integer

Dim c As Integer, d As Integer, daima As String, bili As

String

Dim dj As Double, dw As Double

Dim jnum As Double, wnum As Double

Dim j1 As Integer, j2 As Integer, j3 As Double

Dim w1 As Integer, w2 As Integer, w3 As Double

bianhao = Text9.Text

astr = Left(bianhao, 1)

bstr = Mid(bianhao, 2, 2)

If Asc(astr) > 86 Or Asc(astr) < 65

Then

MsgBox

"地形图图号不准确，请重新输入！", vbExclamation, "警告"

Exit

Sub

End If

If Val(bstr) < 31 Then

MsgBox

"地形图图号不准确，请重新输入！", vbExclamation, "警告"

Exit

Sub

End If

a = Asc(astr) - 64

b = Val(bstr)

daima = Mid(bianhao, 4, 1)

If Asc(daima) > 72 Or Asc(daima) < 65

Then

MsgBox

"地形图图号不准确，请重新输入！", vbExclamation, "警告"

Exit

Sub

End If

wint = (a - 1) * 4

jint = (b - 31) * 6

If daima = "A" Then

bili =

"1：100万"

Text10(0).Text = jint

Text11(0).Text = wint

Text12.Text

= bili

Exit

Sub

ElseIf daima = "B" Then

bili =

"1：50万"

dj = 3

dw = 2

ElseIf daima = "C" Then

bili =

"1：25万"

dj =

1.3

dw = 1

ElseIf daima = "D" Then

bili =

"1：10万"

dj =

0.3

dw =

0.2

ElseIf daima = "E" Then

bili =

"1：5万"

dj =

0.15

dw =

0.1

ElseIf daima = "F" Then

bili =

"1：2.5万"

dj =

0.073

dw =

0.05

ElseIf daima = "G" Then

bili =

"1：1万"

dj =

0.0345

dw =

0.023

ElseIf daima = "H" Then

bili =

"1：5000"

dj =

0.01525

dw =

0.0115

End If

c = Mid(bianhao, 5, 3)

d = Right(bianhao, 3)

wnum = (4 * 3600 / switch(dw) - c) * switch(dw)

Call miaodu(wnum, w1, w2, w3)

Text11(0).Text = wint + w1

Text11(1).Text = w2

Text11(2).Text = Format(w3, "0.0")

jnum = (d - 1) * switch(dj)

Call miaodu(jnum, j1, j2, j3)

Text10(0).Text = jint + j1

Text10(1).Text = j2

Text10(2).Text = Format(j3, "0.0")

Text12.Text = bili

End Sub

Private Sub

Form_Load()

For i = 1 To 2

Load

Text1(i)

Load

Text2(i)

Load

Text10(i)

Load

Text11(i)

Text1(i).Left = Text1(i - 1).Left + Text1(i - 1).Width

Text1(i).Top

= Text1(i - 1).Top

Text1(i).Visible = True

Text2(i).Left = Text2(i - 1).Left + Text2(i - 1).Width

Text2(i).Top

= Text2(i - 1).Top

Text2(i).Visible = True

Text10(i).Left = Text10(i - 1).Left + Text10(i - 1).Width

Text10(i).Top = Text10(i - 1).Top

Text10(i).Visible = True

Text11(i).Left = Text11(i - 1).Left + Text11(i - 1).Width

Text11(i).Top = Text11(i - 1).Top

Text11(i).Visible = True

Next i

End Sub

Private Function

switch(ByVal x As Double) As Double

Dim a As Integer, b As Integer, c As Double

a = Fix(x)

b = Fix((x - a) * 100)

c = ((x - a) * 100 - b) * 100

switch = a * 3600 + b * 60 + c

End Function

Private Sub miaodu(x

As Double, a As Integer, b As Integer, c As Double)

a = x 3600

b = (x - a * 3600) 60

c = x - a * 3600 - b * 60

End Sub