Przykład 5 Azymut i kąt ze współrzędnych.
Projekt: (można
zmodyfikować projekt P4)
Obiekty mają zmienione
następujące wartości cech:
Położenie i wielkość obiektów
(w przybliżeniu) zgodnie z
wyglądem w oknie programu
Cecha NAME:
Przyciski mają nazwy
odpowiednio 
KONIEC_PRZ,;
AZYMUT_PRZ, KAT_PRZ,
WYCZYŚĆ_PRZ
Etykiety mają nazwy
odpowiednio  AUTOR_ETY,
K
T_ETY, AZYMUT_L_ETY,
AZYMUT_P_ETY a pozostałe
LABEL (1-9 - bez zmiany
nazwy)
Pola tekstowe mają nazwy
odpowiednio  .XL_TXT,
YL_TXT, XC_TXT, YC_TXT,
XP_TXT, YP_TXT
Pole obrazu ma nazwę
RYSUNEK
Cecha TEXT - wszystkie obiekty zgodnie z wyglądem w oknie programu
Cecha TEXTALIGN - wszystkie pola tekstowe mają ustawioną wartość na = Center
Cecha BORDERSTYLE etykiety K
T_ETY, AZYMUT_L_ETY, AZYMUT_P_ETY
mają ustawioną wartość na = FixedSingle
Dodatkowo:
Obiekt RYSUNEK ma zmienioną cechę: IMAGE  wstawiony szkic (plik typu *.JPG stworzony poza VB).
Zmiany koloru tła i koloru napisu, oraz zmiany czcionki według własnego uznania.
Pozostałe cechy obiektów zachowują wartości początkowe.
Kod programu:
Wpisujemy kod oznaczony kolorem czarnym, pozostała część jest tworzona automatycznie przez VB.
 Kolor zielony (poprzedzony Apostrofem) oznacza tekst komentarza.
Public Class P5
Dim xl, xc, xp As Single
Dim yl, yc, yp As Single
Dim azymut_l, azymut_p As Double
Private Sub koniec_prz_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles koniec_prz.Click
End
End Sub
Private Sub wyczyść_prz_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles wyczyść_prz.Click
xl_txt.text = ""
yl_txt.Text = ""
xc_txt.Text = ""
yc_txt.Text = ""
xp_txt.Text = ""
yp_txt.Text = ""
Azymut_l_ety.Text = ""
Azymut_p_ety.Text = ""
kąt_ety.Text = ""
End Sub
Private Sub azymut_prz_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles azymut_prz.Click
Dim dxl, dyl, dxp, dyp As Single  Obliczenie azymutu boku lewego
If xl_txt.Text = "" Or xc_txt.Text = "" Or xp_txt.Text = "" Or yl_txt.Text = "" Or yc_txt.Text = "" Or yp_txt.Text = "" Then
MsgBox(" Co najmniej jedna współrzędna nie została wpisana!!!", 16, "BA

D WSPÓA
RZ
DNYCH")
Exit Sub
End If
If xl_txt.Text = xc_txt.Text And yl_txt.Text = yc_txt.Text Then
MsgBox(" Błąd, nie ma lewego azymutu !!!", 16, "BA

D WSPÓA
RZ
DNYCH")
 Exit Sub
ElseIf xp_txt.Text = xc_txt.Text And yp_txt.Text = yc_txt.Text Then
MsgBox(" Błąd, nie ma prawego azymutu !!!", 16, "BA

D WSPÓA
RZ
DNYCH")
Exit Sub
End If
xl = Val(xl_txt.Text)
xc = Val(xc_txt.Text)
xp = Val(xp_txt.Text)
yl = Val(yl_txt.Text)
yc = Val(yc_txt.Text)
yp = Val(yp_txt.Text)
dxl = xl - xc
dyl = yl - yc
If dxl = 0 And dyl > 0 Then
Azymut_l = 100
ElseIf dxl = 0 And dyl < 0 Then
Azymut_l = 300
ElseIf dxl > 0 And dyl = 0 Then
Azymut_l = 0
ElseIf dxl < 0 And dyl = 0 Then
Azymut_l = 200
ElseIf dxl <> 0 And dyl <> 0 Then
Azymut_l = Math.Atan (dyl / dxl)
Azymut_l = azymut_l * 200 / Math.PI
If azymut_l < 0 Then azymut_l = -azymut_l
If dxl < 0 And dyl > 0 Then azymut_l = 200 - azymut_l
If dxl < 0 And dyl < 0 Then azymut_l = 200 + azymut_l
If dxl > 0 And dyl < 0 Then azymut_l = 400 - azymut_l
End If
azymut_l_ety.Text = Format(azymut_l, " 0.0000 gradów ")
dxp = xp  xc  Obliczenie azymutu boku prawego
dyp = yp - yc
If dxp = 0 And dyp > 0 Then
azymut_p = 100
ElseIf dxp = 0 And dyp < 0 Then
azymut_p = 300
ElseIf dxp > 0 And dyp = 0 Then
azymut_p = 0
ElseIf dxp < 0 And dyp = 0 Then
azymut_p = 200
ElseIf dxp <> 0 And dyp <> 0 Then
azymut_p = Math.Atan(dyp / dxp)
azymut_p = azymut_p * 200 / Math.PI
If azymut_p < 0 Then azymut_p = -azymut_p
If dxp < 0 And dyp > 0 Then azymut_p = 200 - azymut_p
If dxp < 0 And dyp < 0 Then azymut_p = 200 + azymut_p
If dxp > 0 And dyp < 0 Then azymut_p = 400 - azymut_p
End If
Azymut_p_ety.Text = Format(azymut_p, " 0.0000 gradów ")
If dxl = 0 And dyl = 0 Or dxp = 0 And dyp = 0 Then
azymut_l_ety.Text = " błąd współrzędnych "
azymut_p_ety.Text = " błąd współrzędnych "
End If
Kąt_ety.Text = ""
End Sub
Private Sub kąt_prz_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles kąt_prz.Click
Dim kąt As Double
If azymut_l = 0 And azymut_p = 0 Then Exit Sub
Kąt = azymut_p - azymut_l
If kąt < 0 Then kąt = kąt + 400
Kąt_ety.Text = Format(kąt, " 0.0000 gradów ")
End Sub
End Class
Jan Ruchel
Kraków, paz
dziernik 2011