Przykłady prostych programów geodezyjnych w Basicu

1. Obliczenie azymutu ze współrzędnych

1) Metoda bez czwartaków

Wersja 1a)
' Program az1.bas
' Obliczenie azymutu ze wspolrzednych
' Podaje sie wspolrzednie 2 punktow
' x1, y1
' x2, y2

 pi = 4.0 * ATN(1.0)   ' Obliczenie Pi
 rg = 200.0 / pi         ' Ro gradowe
 rs = 180.0 / pi         ' Ro stopniowe

CLS

PRINT "Oblliczenie azymutu ze wspolrzednych 2 punktow: "
PRINT "Dane: x1, y1,  x2, y2"
PRINT

 INPUT "x1 "; x1        ' wprowadzenie danych x1 punktu 1-go
 INPUT "y1 "; y1        ' wprowadzenie danych y1 punktu 1-go

 INPUT "x2 "; x2        ' wprowadzenie danych x2 punktu 2-go
 INPUT "y2 "; y2        ' wprowadzenie danych y2 punktu 2-go

DX = x2 - x1            ' Obl. DX
dy = y2 - y1            ' Obl. DY

PRINT
PRINT "Obliczenia i wydruki kontrolne - testowanie cwiartek wspolrzednych"
PRINT

IF DX = 0 THEN  ' 1)  Warunek gdy dx = 0

 PRINT "poczatek dx=0"  ' Wydruk

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0

 PRINT "Koniec dx=0"

' END IF ' 1) dx=0


ELSE            ' dx <> 0

 PRINT "else - poczatek dx<>0"

 a = ATN(dy / DX)

   IF DX < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
    PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0

END IF        ' 1 dx <>0
azg = a * rg
azs = a * rs
PRINT
PRINT "Wyniki obliczen"
PRINT "dx = "; DX
PRINT "dy="; dy
PRINT
PRINT "az [grad] = "; azg
PRINT "az [stopn] = "; azs
PRINT
INPUT "Nacisnij Enter"; a$


Wersja 1b)

' Program az.bas
' Obliczenie azymutu ze wspolrzednych
' Podaje sie wspolrzednie 2 punktow
' x1, y1
' x2, y2
 pi = 4.0 * ATN(1.0)   ' Obliczenie Pi
 rg = 200.0 / pi         ' Ro gradowe
 rs = 180.0 / pi         ' Ro stopniowe
CLS
PRINT "Oblliczenie azymutu ze wspolrzednych 2 punktow: "
PRINT "Dane: x1, y1,  x2, y2"
PRINT
 INPUT "x1 "; x1        ' wprowadzenie danych x1 punktu 1-go
 INPUT "y1 "; y1        ' wprowadzenie danych y1 punktu 1-go
 INPUT "x2 "; x2        ' wprowadzenie danych x2 punktu 2-go
 INPUT "y2 "; y2        ' wprowadzenie danych y2 punktu 2-go
DX = x2 - x1            ' Obl. DX
dy = y2 - y1            ' Obl. DY
PRINT
PRINT "Obliczenia i wydruki kontrolne - testowanie cwiartek wspolrzednych"
PRINT

IF DX = 0 THEN  ' 1)  Warunek gdy dx = 0
 PRINT "poczatek dx=0"  ' Wydruk
  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0

 PRINT "Koniec dx=0"

ELSE            ' dx <> 0

 PRINT "else - poczatek dx<>0"
 a = ATN(dy / DX)
   IF DX < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
    PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0

END IF        ' 1 dx <>0

azg = a * rg    ' Przeliczenie azymutu z radianow na grady
azs = a * rs    ' Przeliczenie azymutu z radianow na stopnie (i ulamki stopnia)
' Koniec obliczen - wydruki wynikoe
PRINT    ' Wydruk pustej linii
PRINT "Wyniki obliczen"
PRINT "dx = "; DX
PRINT "dy="; dy
PRINT
PRINT "az [grad]  = "; azg
PRINT "az [stopn] = "; azs
PRINT
INPUT "Nacisnij Enter"; a$     ' Oczekiwanie na nacisniecie klawisza

END ' Koniec programu

2) Obliczenie azymutu ze wspolrzednych - metoda czwartaków

'Program az2.bas
'Obliczenie azymutu ze wspolrzednych - metoda czwartaków
 pi = 4.0*atn(1.0) ' Obliczenie Pi
 rg=200/pi         ' Ro gradowe
 rs=180/pi         ' Ro stopniowe

Input "x1 " ;x1    ' Wprowadzanie danych
input "y1 " ; y1
input "x2 "; x2
input "y2 "; y2
dx=x2-x1            ' Obl. DX
dy=y2-y1
print "dx=";dx
print "dy=";dy

if dx=0 then        ' Warunek gdy DX=0

  if dy> 0 then
    az = pi/2
   else
   az=1.5*pi
  end if

else                ' Gdy DX <> 0

czw= atn(dy/dx)    ' Obl. czwartaka w radianach
czw=abs(czw)
czwg=czw*rg        ' Zamiana na grady
czws=czw*rs        ' Zamiana na stopnie
print "pi=";pi     ' Wydruk Pi
print "czwart=";czwg; "[grad] ="; czws; "[st]"

if dx>0 and dy>0 then cw=1
if dx<0 and dy>0 then cw=2
if dx<0 and dy<0 then cw=3
if dx>0 and dy<0 then cw=4

select case cw        ' Wariant ćwiartki
 case 1
  az=czw                ' ćwiartka I
  print "case="; cw
 case 2                 ' ćwiartka II
   az=pi-czw
   print "case=";cw
 case 3
   az=pi+czw
    print "case=";cw
 case 4
   az=2*pi-czw        ' ćwiartka IV
    print "case=";cw
 end select
end if

azg=az*rg        ' Zamina na grady
azs=az*rs        ' Zamiana azymutu na stopnie dziesietne
print "dx = ";dx
print "dy="; dy
print "azg[grad]=";azg
print "azs[st]  =";azs

END

Długość i azymut ze współrzednych

Wersja QBasic

DECLARE SUB czekaj (lancuch1$)
DECLARE SUB Dlugosci ()
DECLARE SUB Azymut ()
DECLARE SUB Dlfun ()
DECLARE FUNCTION dlug! (dx!, dy!)

mm$ = LEFT$(DATE$, 2): dd$ = MID$(DATE$, 4, 2): yy$ = RIGHT$(DATE$, 4)
dato$ = yy$ + "." + mm$ + "." + dd$  ' data oblicz
fk$ = "####.####"

koniec = 0

 CLS
 PRINT "Data: "; dd$; "-"; mm$; "-"; yy$
 PRINT
 PRINT " Program DlugAz.bas"
 PRINT
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "

DO

  DO
   PRINT "      0  Koniec obliczen "
   PRINT "      1  Dlugosci ze wspolrzednych"
   PRINT "      2  Azymut ze wspolrzednych"
   PRINT "      3  Dlugosc z funkcji"
   PRINT
   INPUT "Wybierz wariant: 0..2 ==>  "; iw
  LOOP UNTIL iw >= 0 AND iw <= 3

     SELECT CASE iw
      CASE 0: koniec = -1
      CASE 1: CALL Dlugosci
      CASE 2: CALL Azymut
      CASE 3: CALL Dlfun
     END SELECT

 LOOP UNTIL koniec = -1

CLS

END  'Programu glownego


SUB Azymut

 pi = 4! * ATN(1!)
 rg = 200! / pi
 rs = 180! / pi
 CLS
 PRINT "Obliczenie azymutu ze wspolrzednych"
 INPUT "x1 "; x1
 INPUT "y1 "; y1
 INPUT "x2 "; x2
 INPUT "y2 "; y2
dx = x2 - x1
dy = y2 - y1

IF dx = 0 THEN  ' 1) dx = 0

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0
 'PRINT "Koniec dx=0"

 END IF ' 1) dx=0


IF dx <> 0 THEN    ' 10) dx <>0
 ' PRINT "Poczatek dx<>0"
 a = ATN(dy / dx)

   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
   ' PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0

END IF        ' 10 dx <>0

azg = a * rg
azs = a * rs
PRINT "dx = "; dx
PRINT "dy = "; dy
PRINT "Azymut azg="; azg; " [grad]"
PRINT "Azymut azs="; azs; " [stopni]"
PRINT "Odlegl z funnkcji  = "; dlug(dx, dy);
PRINT
strD1$ = "Koniec obl. azymutu . Nacisnij enter"

CALL czekaj(strD1$)

END SUB


SUB czekaj (lancuch1$)
 PRINT lancuch1$
 INPUT a$
 CLS
END SUB


SUB Dlfun
CLS
PRINT "SUB Dlfun"
PRINT "Obliczenie dlugosci z funkcji Dlfun";
PRINT
INPUT "x1= "; x1
INPUT "y1= "; y1
INPUT "x2= "; x2
INPUT "y2= "; y2
dx1 = x2 - x1
 dy1 = y2 - y1
odl = dlug(dx1, dy1)
PRINT "Odlegl = "; odl
INPUT a$
strD1$ = "Koniec obl. dlugosci z funkcji. Nacisnij enter"
CALL czekaj(strD1$)
END SUB



FUNCTION dlug (dx, dy)
 d2 = dx * dx + dy * dy
 d = SQR(d2)
 dlug = d
END FUNCTION


SUB Dlugosci
CLS
 PRINT "Oblicenie dlugosci ze wspolrzednych "
 INPUT "x1= "; x1
 INPUT "y1= "; y1
 INPUT "x2= "; x2
 INPUT "y2= "; y2
 dx = x2 - x1
 dy = y2 - y1
 d1 = SQR(dx * dx + dy * dy)
 d2 = SQR(dx ^ 2 + dy ^ 2)
 PRINT
 PRINT "d1= "; d1
 PRINT "d2= "; d2
 PRINT
 strD1$ = "Koniec obl. dlugosci. Nacisnij enter"
 CALL czekaj(strD1$)
END SUB


Długość i azymut ze współrzednych

Wersja Just Basic

' Program DlugAzJB.bas - wersja Just Basic

 koniec = 0

 CLS
 PRINT "Data: "; dd$; "-"; mm$; "-"; yy$
 PRINT
 PRINT " Program DlugAz.bas"
 PRINT
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "

DO

  DO

   PRINT "      0  Koniec obliczen "
   PRINT "      1  Dlugosci ze wspolrzednych"
   PRINT "      2  Azymut ze wspolrzednych"
   PRINT "      3  Dlugosc z funkcji"
   PRINT
   INPUT "Wybierz wariant: 0..2 ==>  "; iw
  LOOP UNTIL iw >= 0 AND iw <= 3

     SELECT CASE iw
      CASE 0: koniec = -1
      CASE 1: CALL Dlugosci
      CASE 2: CALL Azymut
      CASE 3: CALL Dlfun
     END SELECT

 LOOP UNTIL koniec = -1

CLS
END  'Progr glow



SUB Azymut
 pi = 4.0 * ATN(1.0)
 rg = 200.0 / pi
 rs = 180.0 / pi
 cls

 Print "Obliczenie azymutu ze wspolrzednych"
 INPUT "x1 "; x1
 INPUT "y1 "; y1
 INPUT "x2 "; x2
 INPUT "y2 "; y2
 dx = x2 - x1
 dy = y2 - y1

IF dx = 0 THEN  ' 1) dx = 0

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0
 'PRINT "Koniec dx=0"
 END IF ' 1) dx=0

IF dx <> 0 THEN    ' 10) dx <>0
 ' PRINT "Poczatek dx<>0"
 a = ATN(dy / dx)
   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
   ' PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0

END IF        ' 10 dx <>0

azg = a * rg
azs = a * rs
PRINT "dx = "; dx
PRINT "dy = "; dy
PRINT "Azymut azg="; azg; " [grad]"
PRINT "Azymut azs="; azs; " [stopni]"
print "Odlegl z funnkcji  = "; dlug(dx,dy);
print
strD1$="Koniec obl. azymutu . Nacisnij enter"
call  czekaj strD1$

END SUB


SUB Dlugosci
CLS
 PRINT "Oblicenie dlugosci ze wspolrzednych "
 INPUT "x1= ";x1
 INPUT "y1= ";y1
 INPUT "x2= ";x2
 INPUT "y2= ";y2
 dx=x2-x1
 dy=y2-y1
 d1=sqr(dx*dx+dy*dy)
 d2=sqr(dx^2+dy^2)
 print
 print "d1= ";d1
 print "d2= ";d2
 print
 strD1$="Koniec obl. dlugosci. Nacisnij enter"
 call  czekaj strD1$
END SUB


SUB Dlfun
cls
print "SUB Dlfun"
print "Obliczenie dlugosci z funkcji Dlfun";
print
INPUT "x1= ";x1
INPUT "y1= ";y1
INPUT "x2= ";x2
INPUT "y2= ";y2
dx1=x2-x1
dy1=y2-y1
odl=dlug(dx1, dy1)
print "Odlegl = ";odl
input a$
strD1$="Koniec obl. dlugosci z funkcji. Nacisnij enter"
call  czekaj strD1$
END SUB

sub czekaj lancuch1$
 print lancuch1$
 input a$
 cls
end sub


function dlug(dx,dy)
 d2=dx*dx+dy*dy
 d=sqr(d2)
 dlug = d
end function


Oprogramowanie obliczenia azymutu w Visual Basicu - do aplikacji Excel'a

Przykład obliczenia długości i azymutu w Excelu z wykorzystaniem funkcji Visual Basic
(met. 1 z powyższych schematów oblicz. azymutu - bez czwartaków)

1) Przykład obliczeń w arkuszu Excela

Dlugość i azymut

2. Listingi programów

Attribute VB_Name = "Module1"

Sub odleg()
' Oblicenie odleglosi i azymutu ze wspolrzednych
' Procedura odleg

 Dim x1, y1, x2, y2 As Double ' wspolrzedne
 Dim n1, n2 As Integer ' numery punktow
 Dim opis As String ' lancuch liter

 opis = "Podaj nr 1"
 n1 = CSng(InputBox(opis))
 opis = "Podaj nr 2"
 ' n2 = CSng(InputBox("Wpisz Nr pktu 2-go "))
 n2 = CSng(InputBox(opis))
 x1 = CDbl(InputBox("Podaj x1"))
 y1 = CDbl(InputBox("Podaj y1"))
 x2 = CDbl(InputBox("Podaj x2"))
 y2 = CDbl(InputBox("Podaj y2"))

 'MsgBox dlug(x1, y1, x2, y2) - okno odpowiedzi
 MsgBox "Odleglosc " & n1 & " - " & n2 & " = " & dlug(x1, y1, x2, y2)

 dx = x2 - x1
 dy = y2 - y1

 MsgBox "Azymut " & n1 & " - " & n2 & " = " & az(x1, y1, x2, y2)

End Sub



'Funkcja dlug(x1, y1, x2, y2) as double

Function dlug(x1, y1, x2, y2)
 
 dl = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
 dlug = dl

End Function



' Funkcja az(x1, y1, x2, y2) As Double

Function az(x1, y1, x2, y2) As Double

Dim pi, rg, rs As Double

pi = 4# * Atn(1)
 rg = 200# / pi
 rs = 180# / pi

 dx = x2 - x1: dy = y2 - y1

If dx = 0 Then  ' T (dx = 0)

 ' Print "poczate dx=0"

  If dy > 0 Then     ' dy>0 T
   a = pi / 2
   Else              ' dy >0 N
   a = 1.5 * pi
  End If             ' Koniec dy >0

 ' Print "Byl Koniec dx=0"

Else            ' N (dx=0) czyli dx <>0


a = Atn(dy / dx)

  If dx < 0 Then  ' dx  <0
     ' Print "dx < 0 "
    a = a + pi
   Else          ' dx >0

     If dy < 0 Then
      a = a + 2 * pi
     End If         ' Koniec dy<0

  End If 'dx <0

End If  ' Koniec dx = 0

azg = a * rg ' azymut w gradach
azs = a * rs ' azymut w stopniach
az = azg ' Azymut w gradach

End Function


Funkcje można uruchomic z poziomu Visual Basic - makro (procedura odleg()) 
lub z arkusza kalkulacyjnego - wykorzystując zdefiniowane funkcje -  tutaj dlug(x1,y1,x2,y2) i az(x1,y1,x2,y2)


W języku Visual Basic wystepuje m.in.




Długość, azymut, współrzędne z domiarów prostokątnych

1) Wersja QBasic

' Program DADQB.bas
'Obliczenie dlugosi, azymutów i współrzednych z domiarów prostokatnych
' wersja QBasic
DECLARE SUB czekaj (lancuch1$)
DECLARE SUB Dlugosci ()
DECLARE SUB Azymut ()
DECLARE SUB Dlfun ()
DECLARE SUB Wspoldom ()
DECLARE FUNCTION dlug! (dx!, dy!)
DECLARE FUNCTION azymg! (dx!, dy!)


mm$ = LEFT$(DATE$, 2): dd$ = MID$(DATE$, 4, 2): yy$ = RIGHT$(DATE$, 4)
dato$ = yy$ + "." + mm$ + "." + dd$  ' data oblicz


' fk$ = "####.####"

il = 50
DIM lnry(il), xy(il, 2)
koniec = 0

 CLS
 PRINT "Data: "; dd$; "-"; mm$; "-"; yy$
 PRINT
 PRINT " Program DADQB.bas"
 PRINT
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "
 PRINT

DO ' 1)

  DO  ' 2)
   PRINT "      0  Koniec obliczen "
   PRINT "      1  Dlugosci ze wspolrzednych"
   PRINT "      2  Azymut ze wspolrzednych"
   PRINT "      3  Dlugosc z funkcji"
   PRINT "      4  Wspolrzedne z domiarow"
   PRINT
   INPUT "Wybierz wariant: 0..2 ==>  "; iw
  LOOP UNTIL iw >= 0 AND iw <= 4  '2)

     SELECT CASE iw
      CASE 0: koniec = -1
      CASE 1: CALL Dlugosci
      CASE 2: CALL Azymut
      CASE 3: CALL Dlfun
      CASE 4: CALL Wspoldom
     END SELECT

LOOP UNTIL koniec = -1 ' 1)

CLS

END  'Progr glow ==================



FUNCTION azymg (dx, dy)
 pi = 4! * ATN(1!)
 rg = 200! / pi
 rs = 180! / pi

IF dx = 0 THEN  ' 1) dx = 0

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0

  END IF ' 1) dx=0

IF dx <> 0 THEN    ' 10) dx <>0
  a = ATN(dy / dx)
   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
     END IF         '11  Koniec dx < 0

END IF        ' 10 dx <>0


azg = a * rg
azymg = azg
END FUNCTION


SUB Azymut
 pi = 4! * ATN(1!)
 rg = 200! / pi
 rs = 180! / pi
 CLS
 PRINT "Obliczenie azymutu ze wspolrzednych"
 INPUT "x1 "; x1
 INPUT "y1 "; y1
 INPUT "x2 "; x2
 INPUT "y2 "; y2
 dx = x2 - x1
 dy = y2 - y1

IF dx = 0 THEN  ' 1) dx = 0

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0

 'PRINT "Koniec dx=0"

 END IF ' 1) dx=0

IF dx <> 0 THEN    ' 10) dx <>0
 ' PRINT "Poczatek dx<>0"
 a = ATN(dy / dx)
   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
   ' PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0
END IF        ' 10 dx <>0

azg = a * rg
azs = a * rs
PRINT "dx = "; dx
PRINT "dy = "; dy
PRINT "Azymut azg="; azg; " [grad]"
PRINT "Azymut azs="; azs; " [stopni]"
PRINT "Odlegl z funkcji  = "; dlug(dx, dy)
PRINT "Azymut z funkcji  = "; azymg(dx, dy); "[grad]"
PRINT
strD1$ = "Koniec obl. azymutu . Nacisnij enter"
CALL czekaj(strD1$)

END SUB ' ----------------------


SUB czekaj (lancuch1$)
 PRINT lancuch1$
 INPUT a$
 CLS
END SUB


SUB Dlfun ' -------------------------
CLS
PRINT "SUB Dlfun"
PRINT "Obliczenie dlugosci z funkcji Dlfun";
PRINT
INPUT "x1= "; x1
INPUT "y1= "; y1
INPUT "x2= "; x2
INPUT "y2= "; y2
dx1 = x2 - x1
 dy1 = y2 - y1
odl = dlug(dx1, dy1)
PRINT "Odlegl z funkcji dlug  = "; odl
PRINT "Azymut z funkcji azymg = "; azymg(dx, dy); "[grad]"
INPUT a$
strD1$ = "Koniec obl. dlugosci z funkcji. Nacisnij enter"
CALL czekaj(strD1$)
END SUB


FUNCTION dlug (dx, dy)
 d2 = dx * dx + dy * dy
 d = SQR(d2)
 dlug = d
END FUNCTION '--------------------------


SUB Dlugosci '----------
CLS
 PRINT "Oblicenie dlugosci ze wspolrzednych "
 INPUT "x1= "; x1
 INPUT "y1= "; y1
 INPUT "x2= "; x2
 INPUT "y2= "; y2
 dx = x2 - x1
 dy = y2 - y1
 d1 = SQR(dx * dx + dy * dy)
 d2 = SQR(dx ^ 2 + dy ^ 2)
 PRINT
 PRINT "d1= "; d1
 PRINT "d2= "; d2
 PRINT "Azymut z funkcji  = "; azymg(dx, dy); "[grad]"
 PRINT
 strD1$ = "Koniec obl. dlugosci. Nacisnij enter"

CALL czekaj(strD1$)
END SUB '------------------

SUB Wspoldom  'Oblicz, wspol. z domiarow
SHARED lnry(), xy()
PRINT "    Obliczenie wspolrzednych z domiarow prostokatnych "
PRINT
PRINT "   Nr pkt      Odcieta       Rzedna          X            Y    "
PRINT
lnr = 1
DO WHILE lnr <> 0
CLS
PRINT "Nr punktu pocz A  lub 0 gdy koniec obliczen "
INPUT "Nr pocz A: "; lnr
IF lnr <> 0 THEN
 la = lnr
INPUT "Xa "; xa
INPUT "Ya "; ya
 PRINT "Xa="; xa, " Ya="; ya
 PRINT "Nr  nr punktu konc  B   "
 INPUT "Nr konc. B "; lnr
 lb = lnr
 INPUT "Xb "; xb
 INPUT "Yb "; yb
 PRINT " xa="; xa
 PRINT " ya="; ya
 PRINT " xb="; xb
 PRINT " yb="; yb
 dx1 = xb - xa
 dy1 = yb - ya
 PRINT "Dx="; dx1
 PRINT "Dy="; dy1
 dob = SQR(dx1 * dx1 + dy1 * dy1)
 PRINT "dx="; dx1, " dy="; dy1, " Dobl="; dob
 INPUT "Dlug. pomierz A-B "; dp
 c = dx1 / dp: s = dy1 / dp
 PRINT "c=Dx/Dp"; c, " s=Dy/Dp"; s
  lnp = 1
  DO WHILE lnp <> 0
' 200
  PRINT "Nr punktu na domiarze prost. P  lub 0 gdy koniec obliczen linii pomiar"
  INPUT lnp
  IF lnp <> 0 THEN
   INPUT "Odcieta d: "; d
   INPUT "Rzedna  h: "; h
   dx = c * d - h * s
   dy = s * d + h * c
   PRINT "dx="; dx, " dy="; dy
   x = xa + dx
   y = ya + dy
   PRINT "Xp="; x, " Yp="; y
   ip = ip + 1
   ' lnry(ip) = lnp
   xy(ip, 1) = x
   xy(ip, 2) = y
   PRINT "Nr Pkt          D           H          Xobl           Yobl"                                                        
   PRINT USING "#######"; lnp;
   PRINT USING "#########.###"; d; h; x; y
  END IF
  LOOP
 PRINT xb; yb
 PRINT
 PRINT "Dpom = "; dp
 PRINT
 PRINT "   Dobl=";
 PRINT dob
 PRINT
 PRINT
 INPUT "Nacisnij Enter "; a$
END IF
LOOP
END SUB '--------------



---------------------------------------------------------------

Długość, azymut, współrzędne z domiarów prostokątnych


2) Wersja Just Basic

mm$ = LEFT$(DATE$, 2): dd$ = MID$(DATE$, 4, 2): yy$ = RIGHT$(DATE$, 4)
dato$ = yy$ + "." + mm$ + "." + dd$  ' data oblicz
il=50
DIM lnry(il), xy(il, 2)
koniec = 0

 CLS
 print date$("yyyy/mm/dd")
 PRINT
 PRINT " Program DlugAz.bas"
 PRINT
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "
 PRINT

DO ' 1)

  DO  ' 2)
   PRINT "      0  Koniec obliczen "
   PRINT "      1  Dlugosci ze wspolrzednych"
   PRINT "      2  Azymut ze wspolrzednych"
   PRINT "      3  Dlugosc z funkcji"
   PRINT "      4  Wspolrzedne z domiarow"
   PRINT
   INPUT "Wybierz wariant: 0..2 ==>  "; iw
  LOOP UNTIL iw >= 0 AND iw <= 4  '2)
     SELECT CASE iw
      CASE 0: koniec = -1
      CASE 1: CALL Dlugosci
      CASE 2: CALL Azymut
      CASE 3: CALL Dlfun
      CASE 4: CALL Wspoldom
     END SELECT
LOOP UNTIL koniec = -1 ' 1)

CLS
END  'Progr glow

SUB Azymut
 pi = 4.0 * ATN(1.0)
 rg = 200.0 / pi
 rs = 180.0 / pi
 cls
 Print "Obliczenie azymutu ze wspolrzednych"
 INPUT "x1 "; x1
 INPUT "y1 "; y1
 INPUT "x2 "; x2
 INPUT "y2 "; y2
 dx = x2 - x1
 dy = y2 - y1

IF dx = 0 THEN  ' 1) dx = 0

  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0
 'PRINT "Koniec dx=0"

 END IF ' 1) dx=0

IF dx <> 0 THEN    ' 10) dx <>0
 ' PRINT "Poczatek dx<>0"

 a = ATN(dy / dx)
   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
   ' PRINT "Koniec dx <> 0"
    END IF         '11  Koniec dx < 0

END IF        ' 10 dx <>0


azg = a * rg
azs = a * rs
PRINT "dx = "; dx
PRINT "dy = "; dy
PRINT "Azymut azg="; azg; " [grad]"
PRINT "Azymut azs="; azs; " [stopni]"
print "Odlegl z funkcji  = "; dlug(dx,dy)
print "Azymut z funkcji  = "; azymg(dx, dy); "[grad]"
print
strD1$="Koniec obl. azymutu . Nacisnij enter"

call  czekaj strD1$

END SUB


SUB Dlugosci
CLS
 PRINT "Oblicenie dlugosci ze wspolrzednych "
 INPUT "x1= ";x1
 INPUT "y1= ";y1
 INPUT "x2= ";x2
 INPUT "y2= ";y2
 dx=x2-x1
 dy=y2-y1
 d1=sqr(dx*dx+dy*dy)
 d2=sqr(dx^2+dy^2)
 print
 print "d1= ";d1
 print "d2= ";d2
 print "Azymut z funkcji  = "; azymg(dx, dy); "[grad]"
 print
 strD1$="Koniec obl. dlugosci. Nacisnij enter"
call  czekaj strD1$
END SUB


sub Dlfun
cls
print "SUB Dlfun"
print "Obliczenie dlugosci z funkcji Dlfun";
print
INPUT "x1= ";x1
INPUT "y1= ";y1
INPUT "x2= ";x2
INPUT "y2= ";y2
dx1=x2-x1
dy1=y2-y1

odl=dlug(dx1, dy1)
print "Odlegl z funkcji dlug  = ";odl
print "Azymut z funkcji azymg = "; azymg(dx,dy); "[grad]"
input a$

strD1$="Koniec obl. dlugosci z funkcji. Nacisnij enter"
call  czekaj strD1$
end sub



sub czekaj lancuch1$
 print lancuch1$
 input a$
 cls
end sub



function dlug(dx,dy)
 d2=dx*dx+dy*dy
 d=sqr(d2)
 dlug = d
end function


function azymg(dx, dy)
 pi = 4.0 * ATN(1.0)
 rg = 200.0 / pi
 rs = 180.0 / pi

IF dx = 0 THEN  ' 1) dx = 0
  IF dy > 0 THEN     ' 2) dy>0 T
   a = pi / 2
   ELSE
   a = 1.5 * pi
  END IF            ' 2)  Koniec dy >0
  END IF ' 1) dx=0

IF dx <> 0 THEN    ' 10) dx <>0
  a = ATN(dy / dx)
   IF dx < 0 THEN  ' 11) dx  <0
     a = a + pi
    ELSE          ' dx >0
      IF dy < 0 THEN  '12
       a = a + 2 * pi
      END IF          ' 12) dy <0
     END IF         '11  Koniec dx < 0
END IF        ' 10 dx <>0

azg = a * rg
azymg=azg
end function



SUB Wspoldom  'Oblicz, wspol. z domiarow
PRINT  "    Obliczenie wspolrzednych z domiarow prostokatnych "
PRINT
PRINT  "   Nr pkt      Odcieta       Rzedna          X            Y    "
PRINT
lnr = 1
DO WHILE lnr <> 0
CLS
PRINT "Nr punktu pocz A  lub 0 gdy koniec obliczen "
INPUT "Nr pocz A: "; lnr
IF lnr <> 0 THEN
 la = lnr
input "Xa "; xa
input "Ya ";ya
 PRINT "Xa="; xa, " Ya="; ya
 PRINT "Nr  nr punktu konc  B   "
 INPUT "Nr konc. B "; lnr
 lb = lnr
 input "Xb "; xb
 input "Yb ";yb
 print " xa=";xa
 print " ya=";ya
 print " xb=";xb
 print " yb=";yb
 dx1 = xb - xa
 dy1 = yb - ya
 print "Dx="; dx1
 print "Dy="; dy1
 dob = SQR(dx1*dx1 + dy1*dy1)
 PRINT "dx="; dx, " dy="; dy, " Dobl="; dob
 INPUT "Dlug. pomierz A-B "; Dp
 c = dx1 / Dp: s = dy1 / Dp
 PRINT "c=Dx/Dp"; c, " s=Dy/Dp"; s
  lnp = 1
  DO WHILE lnp <> 0
' 200
  PRINT "Nr punktu na domiarze prost. P  lub 0 gdy koniec obliczen linii pomiar"
  INPUT lnp
  IF lnp <> 0 THEN
   INPUT "Odcieta d: "; d
   INPUT "Rzedna  h: "; h
   dx = c * d - h * s
   dy = s * d + h * c
   PRINT "dx="; dx, " dy="; dy
   x = xa + dx
   y = ya + dy
   PRINT "Xp="; x, " Yp="; y
   ip = ip + 1
   lnry(ip) = lnp
   xy(ip, 1) = x
   xy(ip, 2) = y
   PRINT lnp;
   PRINT  d; h; x; y
  END IF
  LOOP
 PRINT  xb; yb
 PRINT
 PRINT  "Dpom = ";dp
 PRINT
 PRINT  "   Dobl=";
 PRINT  dob
 PRINT
 PRINT
 INPUT "Nacisnij Enter "; a$
END IF
LOOP
END SUB

Kąty ze współrzędnych - wersja Just Basic


'Program KATynJB.BAS - wersja Just Basic
' Komentarze
' Definicje stalych

il = 2000            ' Ilosc obliczen maks.
pi = 4.0 * ATN(1.0)  ' Pi
rg = 200.0 / pi      ' Ro[grad]
rs = 180.0 / pi      ' Ro[stopn]

'Program glowny
ip = 0 'Ilosc punktow o danych wspolrz

CLS     ' Kasowanie ekranu

DO
[menu]
 CLS
 PRINT "Data: "; date$("yyyy/mm/dd")
 PRINT "Godz : "; time$()
 PRINT
 PRINT " Program KATY2.BAS QBASIC  wersja szkolna"
 PRINT
 PRINT "                MENU"
 PRINT "  ======================================"
 PRINT
 PRINT "      1  Katy ze wspolrzednych"
 PRINT "      0  Koniec obliczen "
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "
 PRINT

 DO
  INPUT "Wybierz wariant: 0..1 ==>  "; iw
 LOOP UNTIL iw >= 0 AND iw <= 7

 SELECT CASE iw
      CASE 1: CALL Katy
      CASE 0: GOTO [koniec]

 END SELECT

LOOP UNTIL iw = 0

[koniec]
CLS
END  'Program glowny



FUNCTION ANaz(dx, dy) ' azymut w gradach
 print "Funkcja ANAz(dx, dy) - obliczenie azymutu "
 pi = 4.0 * ATN(1.0)        ' Pi = 3.14....
'Wydruk kontrolny
 print " pi= ";pi
 rg = 200.0 / pi    ' Ro [grad]
 print "rg= "; rg

 IF dx = 0 AND dy = 0 THEN
  PRINT "Dx=DY  blad danych"
  ar=0
  GOTO [Koniec1]    ' Skocz do etykiety [Koniec1]
 END IF

 IF dx <> 0  THEN
  ar   = ATN(dy/dx)
  PRINT "0)  dx <> 0  ar= atn(dy/dx) ="; ar
 END IF

 IF dy = 0 and dx > 0 THEN
  ar = 0         ' 1
  print "1) dy =0 and dx > 0  ar = "; ar
 END IF

 IF dy = 0 and dx < 0 THEN
  ar = pi        ' 2
  PRINT "2)  dy=0 and dx >0  ar = "; ar
 END IF

 IF dx = 0 and dy > 0 THEN
  ar = 0.5*pi     ' 3
  PRINT "3)  dx=0 and dy>0  ar = "; ar
 END IF

 IF dx = 0 and dy < 0 THEN
  ar= 1.5*pi    ' 4
  pRINT " 4) dx =0 and dy < 0  ar = ";ar
 END iF

 IF dx < 0 AND dy <> 0 THEN
  ar = pi + ar   ' 6
  print "6)  dx <0 and  dy <> 0  ar = "; ar
 END IF

 iF dx > 0 and dy < 0 THEN
  ar = 2.0*pi + ar
  print "7)  dx > 0 and dy<0  ar = ";ar
 END IF

 [Koniec1]

 azyg = ar * rg ' w gradach

 print "dx= "; dx
 print "dy= "; dy
 print "azyg [grad] = "; azyg

 ANaz = azyg ' w gradach

END FUNCTION


'Procedura Katy

SUB Katy
' SHARED fk$

fd$ = "#######.###"
PRINT "        Obliczenie katow i dlugosci ze wspolrzednych "
PRINT

lnr = 1

DO
CLS
PRINT "Wprowadz nr punktu lewego L   lub 0 gdy koniec wprowdz. ";
INPUT nrl

IF nrl <> 0 THEN
 INPUT "Wprowadz XL  "; xl
 INPUT "Wprowadz YL  "; yl
 PRINT
 PRINT "Wprowadz nr punktu prawego P  ";
 INPUT nrp
 INPUT "Wprowadz XP  "; xp
 INPUT "Wprowadz YP  "; yp
 PRINT
 PRINT "Wprowadz nr punktu centralnego C  ";
 INPUT nrc
 INPUT "Wprowadz XC  "; xc
 INPUT "Wprowadz YC  "; yc
 dx1 = xl - xc: dy1 = yl - yc
 dl1 = SQR(dx1 * dx1 + dy1 * dy1)
 PRINT
 a1 = ANaz(dx1, dy1) ' azymut boku lewego
 dx2 = xp - xc: dy2 = yp - yc
 dl2 = SQR(dx2 * dx2 + dy2 * dy2)
 PRINT
 a2 = ANaz(dx2, dy2) ' azymut boku prawego
 PRINT "Przyrosty wspolrzednych i dlugosci:"
 PRINT "  dx (C-L)="; : PRINT  dx1;
 PRINT "  dy (C-P)="; : PRINT  dy1;
 PRINT "  dL (C-L)="; : PRINT  dl1
 PRINT "  dx (C-P)="; : PRINT  dx2;
 PRINT "  dy (C-P)="; : PRINT  dy2;
 PRINT "  dL (C-P)="; : PRINT  dl2
 ang = a2 - a1 ' kat z roznicy azymutow w gradach
 IF ang < 0 THEN ang = ang + 400.0
  PRINT
  PRINT "Azymuty [grad]"
  PRINT "Az ("; nrc; "-"; nrl; ") = ";
  PRINT  a1
  PRINT "Az ("; nrc; "-"; nrp; ") = ";
  PRINT  a2
' Obliczenie kata bezposrednio
  yyy = dx1 * dy2 - dy1 * dx2
  xxx = dx1 * dx2 + dy1 * dy2
  angle = ANaz(xxx, yyy)
  PRINT
  PRINT "KATY w gradach"
  PRINT "Kat z roznicy azymutow : "; nrl; "-"; nrc; "-"; nrp; " = ";
  PRINT  ang
  PRINT "Kat wg form Hausbrandta: "; lnr; "-"; cnr; "-"; pnr; " = ";
  PRINT  angle

  PRINT
  INPUT "Nacisnij Enter ... "; a$
 END IF

LOOP WHILE nrl <> 0
PRINT
PRINT
CLS

END SUB ' Koniec procedury KATY

Wcięcie kątowe w przód

' program wckat.bas - wersja QBasic
' Wersja szkolna
' Deklaracje

DECLARE SUB wydruk ()
DECLARE SUB dane ()
DECLARE SUB wc ()
DECLARE SUB oblicz ()
DEFDBL P, R, W-Y
DEFINT I-J, M
DEFLNG N

COMMON SHARED a, b, x, y, rg, f$, xa, ya, xb, yb, mw, mk, Na, Nb

f$ = "#############.###"

m = 100
pi = 4# * ATN(1#)
rg = 200# / pi

OPTION BASE 1
DIM SHARED nr(m), w(m, 2), alfa(m), beta(m)

' Program glowny
 CLS
 PRINT "     Wciecie katowe w przod "
 PRINT "       (C)  K. R. "
 PRINT "      Wersja szkolna "
 PRINT
 CALL dane
 CALL wydruk
END   ' Program glowny


'Procedury

SUB dane
PRINT
INPUT "Nr , X, Y  pktu nawiazania A (prawego) "; Na, xa, ya
INPUT "Nr , X, Y  pktu nawiazania B (lewego)  "; Nb, xb, yb
PRINT
PRINT "Oznaczenia: Alfa - Kat na pkcie A,  Beta - na pkcie B "
PRINT
INPUT "Wersja katow: 1 - grady, 2 - stop,min,sek "; wk
PRINT "Ilosc wciec z bazy "; Na; "-"; Nb, : INPUT mw
PRINT "Podaj kolejno: Nr_pktu, Alfa, Beta ";
PRINT
FOR i = 1 TO mw
PRINT "Pkt wyznaczany nr "; i

IF wk = 1 THEN INPUT "Nr, Alfa[g], Beta[g] "; nr(i), alfa(i), beta(i)
IF wk = 2 THEN
 INPUT "Nr, A_st, A_mi, A_sek, B_st, B_mi, B-sek"; nr(i), a1, a2, a3, b1, b2, b3
  a = a1 + a2 / 60 + a3 / 3600: b = b1 + b2 / 60 + b3 / 3600
  a = a / .9: b = b / .9
  alfa(i) = a: beta(i) = b
 END IF

a = alfa(i): b = beta(i):
CALL wc
w(i, 1) = x
w(i, 2) = y
NEXT i
END SUB


'Wciecie
SUB wc
a = a / rg
b = b / rg
x1 = xa: y1 = ya
x2 = xb: y2 = yb
ca = COS(a) / SIN(a): cb = COS(b) / SIN(b)     ' ctg a, ctg b
PRINT "ctg A ="; ca; "  ctg B = "; cb
x = (x1 * cb + y1 + x2 * ca - y2) / (cb + ca)
y = (-x1 + y1 * cb + x2 + y2 * ca) / (cb + ca)
PRINT "x="; x; "  y="; y
INPUT a$
END SUB


SUB wydruk
CLS
INPUT "Nazwa pliku lub urzadz. wydruku (PRN-drukarka, SCRN: - ekran) "; fw$
CLS
OPEN "O", #1, fw$
PRINT #1, "             WCIECIE KATOWE W PRZOD"
PRINT #1,
PRINT #1, "      Punkty nawiazania: A, B"
PRINT #1, "     Nr            X               Y"
PRINT #1, USING "###########"; Na;
PRINT #1, USING f$; xa; ya
PRINT #1, USING "###########"; Nb;
PRINT #1, USING f$; xb; yb
PRINT
PRINT #1, "       Punkty wyznaczone wcieciem w przod: "
PRINT #1, "     Nr            Alfa        Beta               X               Y  "
PRINT #1, "                 g  c  cc      g  c  cc                             "
PRINT #1,

FOR i = 1 TO mw
PRINT #1, USING "###########"; nr(i);
PRINT #1, USING "########.#####"; alfa(i); beta(i);
PRINT #1, USING f$; w(i, 1); w(i, 2)
NEXT i
PRINT #1,
PRINT #1, "     Schemat wciecia w przod:          C"
PRINT #1, "    Pomierzone: Alfa, Beta.                   "
PRINT #1, "                                  Beta    Alfa "
PRINT #1, "                                 B-----------A"
PRINT #1,
END SUB




Przykład wyników



             WCIECIE KATOWE W PRZOD

      Punkty nawiazania: A, B
     Nr            X               Y
          1            0.000            0.000
          2           10.000           10.000
       Punkty wyznaczone wcieciem w przod:
     Nr            Alfa        Beta               X               Y 
                 g  c  cc      g  c  cc                            

         11      50.00000      60.00000           -0.000           11.584
         12      55.00000      80.00000           -1.238           15.726

     Schemat wciecia w przod:          C
    Pomierzone: Alfa, Beta.                  
                                  Beta    Alfa
                                 B-----------A

Podstawowe obliczenia geodezyjne - wersja QBAsic

Program bardziej zaawansowany, wyprowadzenia wyników do pliku, formatowanie wydruku, ustalenie dokładności wydruku,
zapis i odczyt współrzędnych ze zbioru, obsługa błędów

'Program POG.BAS - QBasic - wersja do testowania
' (C) K. R.
'DECLARE SUB Tytul ()
'DECLARE SUB tytul2 ()
'DECLARE SUB NAZPLIK ()
'DECLARE SUB Wspol ()
'DECLARE SUB Azym ()
'DECLARE SUB Wspoldom ()
'DECLARE SUB ZapisWsp ()
'DECLARE SUB Pole ()
'DECLARE SUB Katy ()
'DECLARE SUB opis ()
'DECLARE SUB koniec ()
'DECLARE SUB SPRNR ()
'DeCLARE SUB spr2 (lnp&)


DEFINT I-K, M-N
DEFLNG L
DEFDBL A-H, O-Z

MM$ = LEFT$(DATE$, 2): DD$ = MID$(DATE$, 4, 2): YY$ = RIGHT$(DATE$, 4)
dato$ = YY$ + "." + MM$ + "." + DD$  ' data oblicz

il% = 2000
pi = 4# * ATN(1#)  ' Liczba Pi
rg = 200# / pi     ' Ro [grad]   
rs = 180# / pi     ' Ro [stopn]  

fk$ = "######.#####"  ' Format zapisu katow
fp$ = "############" ' Format zapisu nrow (10 cyfr)

OPTION BASE 1        ' Tablice numerowane od 1 (normalnie od 0)
DIM lnry(il%), xy(il%, 2)  'Deklaracja tablic: nrow oraz wspolrz: x,y

' COMMON f$, fk$, fx$, fp$, x, y



DEF FNaz (dx, dy)       ' Funkcja na obliczenie azymutu
 IF dx = 0 AND dy = 0 THEN PRINT "Dx=DY  blad danych"
 IF dy = 0 THEN
   IF dx > 0 THEN azy = 0 ELSE azy = pi
 END IF
 IF dx <> 0 THEN ar = ATN(dy / dx) ' azymut w rad
 IF dx = 0 THEN
  IF dy > 0 THEN azy = pi / 2 ELSE azy = 1.5# * pi
 END IF
 IF dx > 0 AND dy <> 0 THEN
  IF dy > 0 THEN azy = ar ELSE azy = 2# * pi + ar
 END IF
 IF dx < 0 AND dy <> 0 THEN azy = pi + ar
kaz:
FNaz = azy * rg
END DEF




'Program glowny
ip = 0 'Ilos punktow o danych wspolrz

CLS
PRINT "Program POG - podstawowe obliczenia geodezyjne "
PRINT
INPUT "1 - monitor kolor kolorowy, 2 - mono "; imk
IF imk = 2 THEN GOTO 5

'ON ERROR GOTO 5
CALL Tytul: GOTO 10

5
CALL tytul2

10
CALL NAZPLIK ' wywolanie procedury
ON ERROR GOTO blad

iw = -1   'Wskaznik wyboru pozycji menu

DO
menu:
 CLS
 PRINT " Program POG  podstawowe obliczenia geodezyjne"
 PRINT
 PRINT
 PRINT "              MENU"
 PRINT " ======================================"
 PRINT
 PRINT "1  Wprowadzenie nrow i wspolrzednych"
 PRINT "2  Obliczenie azymutow i dlugosci "
 PRINT "3  Obliczenie wspolrz. na podstawie domiarow "
 PRINT "4  Zapis wspolrz. do pliku "
 PRINT "5  Obliczenie pola ze wspolrzednych "
 PRINT "6  Katy ze wspolrzednych"
 PRINT "7  Krotki opis"
 PRINT "0  Koniec obliczen "
 PRINT
 PRINT "Uwaga: Numery punktow - liczba max. 2147483647 (prakt. 9 cyfr)  "

 DO
  INPUT "Wybierz wariant: 0..7 ==>  "; iw
 LOOP UNTIL iw >= 0 AND iw <= 7
 SELECT CASE iw
      CASE 1:  CALL Wspol
      CASE 2
    CALL Azym
      CASE 3
    CALL Wspoldom
      CASE 4: CALL ZapisWsp
      CASE 5: CALL Pole
      CASE 6: CALL Katy
      CASE 7: CALL opis
      CASE 0
       CALL koniec
 END SELECT
LOOP UNTIL iw = 0

CLS
END 

blad:    'Etykieta - skacze tu gdy jest blad
CLS
PRINT "Blad .... "
CLOSE #1
END  'Progr glow





SUB Azym  ' Azymuty
SHARED lnr, ip, lnry(), xy(), spr, x, y, fk$, fp$, fx$, rs, rg
PRINT #1,
PRINT #1, "        Obliczenie azymutow i dlugosci ze wspolrzednych "
PRINT #1,
PRINT #1, "    Nr pocz           Xp             Yp        Dlugosci   Azymuty [grad] "
PRINT #1, "    Nr konc           Xk             Yk                   Azymuty [ř.' "; "] "
PRINT #1,
lnr = 1
DO WHILE lnr <> 0
CLS
PRINT "Wprowadz nr punktu pocz. A  lub 0 gdy koniec wprowdz. "
INPUT lnr
IF lnr <> 0 THEN
 CALL SPRNR
 la = lnr
 xa = x: ya = y
 PRINT "Xa="; xa, " Ya="; ya
 PRINT "Wprowadz nr punktu B  "
 INPUT lnr
 CALL SPRNR
 lb = lnr
 xb = x: yb = y
 dx1 = xb - xa: dy1 = yb - ya
 d = SQR(dx1 * dx1 + dy1 * dy1)
' d = dl(dx1, dy1)
 PRINT "dx="; dx1, " dy="; dy1, d
 a = FNaz(dx1, dy1)
 s = ABS(a / rg) * rs: s1% = INT(s + .0000001): sM = (s - s1%) * 60#
 mc% = INT(sM + .000001): sek = INT((sM - mc%) * 60# + .5)
IF sek = 60 THEN mc% = mc% + 1: sek = 0
a1s = s1% + mc% / 100 + sek / 10000
PRINT "st="; s1%, " Mi="; mc%, " sek="; sek
IF a < 0 THEN a1s = -a1s
 PRINT "Azymut "; la; "-"; lb; " = ";
 PRINT USING fk$; a;
 PRINT "[grad]";
 PRINT USING fk$; a1s; : PRINT "[ř.' '']"
 PRINT #1, USING fp$; la;
 PRINT #1, USING fx$; xa; ya; d;
 PRINT #1, USING fk$; a
 PRINT #1, USING fp$; lb;
 PRINT #1, USING fx$; xb; yb;
 PRINT #1, "              ";
 PRINT #1, USING "######"; a1s;
 PRINT #1, "ř";
 PRINT #1, USING "##"; mc%; : PRINT #1, "'";
 PRINT #1, USING "##.#"; sek; : PRINT #1, "''"
 PRINT #1,
 INPUT "Nacisnij Enter "; a$
END IF
LOOP
PRINT #1,
PRINT #1,
END SUB



SUB Katy
SHARED lnr, ip, lnry(), xy(), spr, x, y, fk$, fp$, fx$, rs, rg
PRINT #1,
PRINT #1, "        Obliczenie katow i dlugosci ze wspolrzednych "
PRINT #1,
PRINT #1, "    Nr lewy           Xl             Yl        Dlug L-C   Azymut C-L  [grad] "
PRINT #1, "    Nr cent           Xc             Yc             C-P   Azymut C-P  "
PRINT #1, "    Nr prawy          Xp             Yp             L-P   Kat L-C-P   "
PRINT #1,
lnr = 1
DO WHILE lnr <> 0
CLS
PRINT "Wprowadz nr punktu lewego L   lub 0 gdy koniec wprowdz. "
INPUT lnr
IF lnr <> 0 THEN
 CALL SPRNR
 ll = lnr
 xl = x: yl = y
 PRINT "Xl="; xl, " Yl="; yl

 PRINT "Wprowadz nr punktu prawego P  "
 INPUT lnr
 CALL SPRNR
 lp = lnr
 xp = x: yp = y
  PRINT "Xp="; xp, " Yp="; yp

 PRINT "Wprowadz nr punktu centralnego C  "
 INPUT lnr
 CALL SPRNR
 lc = lnr
 xc = x: yc = y
  PRINT "Xc="; xc, " Yc="; yc

 dx1 = xl - xc: dy1 = yl - yc
 dl1 = SQR(dx1 * dx1 + dy1 * dy1)

' d = dl(dx1, dy1)
 PRINT "dx(C-L)="; dx1, " dy(C-L)="; dy1, "  dl(C-L)="; dl1
 a1 = FNaz(dx1, dy1)

 dx2 = xp - xc: dy2 = yp - yc
 dl2 = SQR(dx2 * dx2 + dy2 * dy2)
' d = dl(dx1, dy1)
 PRINT "dx(C-P)="; dx2, " dy(C-P)="; dy2, " dl(C-P= "; dl2
 a2 = FNaz(dx2, dy2)

 ang = a2 - a1
 IF ang < 0 THEN ang = ang + 400

 yyy = dx1 * dy2 - dy1 * dx2
 xxx = dx1 * dx2 + dy1 * dy2
 angle = FNaz(xxx, yyy)

 dx3 = xp - xl: dy3 = yp - yl
 dl3 = SQR(dx3 * dx3 + dy3 * dy3)

 PRINT "Kat "; ll; "-"; lc; "-"; lp; " = ";
 PRINT USING fk$; ang;
 PRINT USING fk$; angle;

 PRINT "[grad]";
 PRINT #1, USING fp$; ll;
 PRINT #1, USING fx$; xl; yl; dl1;
 PRINT #1, USING fk$; a1
 PRINT #1, USING fp$; lc;
 PRINT #1, USING fx$; xc; yc; dl2;
 PRINT #1, USING fk$; a2
 PRINT #1, USING fp$; lp;
 PRINT #1, USING fx$; xp; yp; dl3;
 PRINT #1, USING fk$; ang
 PRINT #1, "                Kat L-C-P  = ";
 PRINT #1, USING fk$; angle
 PRINT #1,
 PRINT
 INPUT "Nacisnij Enter "; a$
END IF
LOOP
PRINT #1,
PRINT #1,
END SUB

SUB koniec  'Procedura konczaca program - zamyka plik wynikow
SHARED dato$
PRINT #1,
PRINT #1,
PRINT #1, "  Data obliczen  "; dato$
PRINT #1,
PRINT #1, "  Obliczyl ...........              Sprawdzil ..........."
PRINT #1, CHR$(12)
CLOSE #1
SCREEN 0
CLS
END SUB



SUB NAZPLIK  'Procedura na wprowadzenie pliku wynikow i dokl. wydruku
SHARED fx$, f$
20
CLS
PRINT "          PODSTAWOWE OBLICZENIA GEODEZYJNE "
PRINT "                Program POG  "
PRINT "          (C)  K. R.  05.1994 "
PRINT
PRINT
PRINT "Nazwa pliku/urzadzenia do wydruku wynikow: "
PRINT
PRINT "PRN lub LPT1 - drukarka 1, LPT2 - drukarka 2, "
PRINT "SCRN: lub <Enter> - ekran "
PRINT "Dowolna inna nazwa zgodnie z DOS - plik "
PRINT
PRINT "Podaj nazwe do wydruku wynikow i  nacisnij <Enter> ==>  "; ;
INPUT f$
IF f$ = "" THEN f$ = "scrn:"
OPEN f$ FOR OUTPUT AS 1
iwyd = 0
PRINT
DO
 INPUT "Dokladnosc wydruku wspolrz: 2 lub 3 : "; iwyd
LOOP UNTIL iwyd = 2 OR iwyd = 3

IF iwyd = 3 THEN fx$ = "###########.###" ELSE fx$ = "###########.##"
PRINT #1, "           PODSTAWOWE OBLICZENIA GEODEZYJNE "
PRINT #1,
PRINT #1, "                Program POG - rel. 1.1 "
PRINT #1, "        Autor programu K. R. 05.1994 "
PRINT #1,
PRINT #1,
CLS
END SUB



SUB opis
CLS
PRINT "  Krotki opis programu"
PRINT
PRINT "Program sluzy do podstawowych obliczen geodezyjnych"
PRINT "azymuty i dlugosci, wspolrz. z domiarow, pola pow., katy"
PRINT
PRINT "Max ilosc punktow obliczanych:  2000"
PRINT "Numery punktow max 9 cyfrowe "
PRINT "Dokl. wydruku bokow i wspolrz: 1 - cm lub  2 - mm"
PRINT "Wyniki obliczen moga byc wyprowadzane do pliku, na drukarke lub ekran"
PRINT "Podaje sie nazwe urzadzenia: PRN lub LPT1 albo LPT2 - drukarka"
PRINT "SCRN: - ekran, inna nazwa wg. DOS - plik (nazwa do 8 zn, rozsz. 3 zn)"
PRINT "Nazwa pliku moze byc poprzedzona nazwa dysku i sciezka dostepu"
PRINT
PRINT " Dane do obliczenia pol moga byc wczytane z klawiatury lub pliku "
PRINT " Przy podawaniu danych z klawaitury, dane oddziela sie przecinkiem"
PRINT " Dane w pliku moga byc oddzielone przecinkiem lub spacjami "
PRINT
PRINT " Dane w pliku do obl. pol: "
PRINT " Ilosc punktow: n"
PRINT " Nr(i)  X(i)  Y(i)  i=1..n"
PRINT
PRINT " <Nacisnij jakis klawisz>  ... "
DO: LOOP WHILE INKEY$ = ""
CLS
END SUB  ' Opis



SUB Pole  'Oblicz pola ze wspolrz
SHARED lnr, ip, lnry(), xy(), spr, x, y, fk$, fp$, fx$, sprp, il%
DIM ln(il%), px(il%), py(il%)

PRINT #1, "          OBLICZENIE POLA POWIERZCHNI ZE WSPOLRZEDNYCH"
PRINT #1,
PRINT #1, " Lp       Nr(i)         X(i)            Y(i)       D(i)-(i+1) "
PRINT #1,

lnr = 1
 np = 0: pO = 0: PP = 0: X0 = 0: Y0 = 0
      FOR i = 1 TO iln%
      ln(i) = 0
      px(i) = 0
      py(i) = 0
       NEXT i

CLS
PRINT "Obliczenie pola powierzchni ze wspolrzednych "
PRINT
'PRINT "fx$="; fx$
PRINT
PRINT " Dane (Nr X Y) :  1 - z klawiatury,  2 - ze zbioru:  ";
INPUT idp

IF idp = 2 THEN
 INPUT "Nazwa pliku danych "; fd$
 OPEN "I", #2, fd$
 INPUT #2, np
  FOR i = 1 TO np
    INPUT #2, ln(i), px(i), py(i)
   NEXT i
 CLOSE #2
END IF

IF idp = 1 THEN
 INPUT "Ilosc punktow "; np

 FOR i = 1 TO np
  INPUT " Nr pktu  "; lnr
  CALL SPRNR
  ln(i) = lnr
  px(i) = x:  py(i) = y
  PRINT "X="; x, " Y="; y
  ln(i) = lnr
 NEXT i
END IF

  px(np + 1) = px(1): py(np + 1) = py(1)
  pO = 0

  X0 = px(1): Y0 = py(1)

   FOR i = 1 TO np
     x1 = px(i) - X0: y1 = py(i) - Y0
     x2 = px(i + 1) - X0: y2 = py(i + 1) - Y0
     PP = x1 * y2 - y1 * x2: PP = PP / 2
     pO = pO + PP
     d = SQR((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
    PRINT #1, i; TAB(5);
    PRINT #1, USING fp$; ln(i);
    PRINT #1, TAB(20);
    PRINT #1, USING fx$; px(i); py(i); d

    PRINT i; TAB(5);
    PRINT USING fp$; ln(i);
    PRINT TAB(20);
    PRINT USING fx$; px(i); py(i); d

   NEXT i

   PRINT #1,
   PRINT #1, "   Ilosc punktow = "; np
   PRINT #1, "   Pole powierzchni = ";
   PRINT #1, USING fx$; pO;
   PRINT #1, "  [m^2]"
   PRINT "   Ilosc punktow = "; np
   PRINT "   Pole powierzchni = ";
   PRINT USING fx$; pO;
   PRINT "  [m^2]"

   PRINT #1,
   PRINT #1,
   PRINT #1,

  INPUT "Nacisnij Enter "; a$
END SUB



SUB spr2 (lnp) 'Sprawdza czy jest pkt o numerze lnp
SHARED x, y, sprp, ip, lnry(), xy()
sprp = 0
FOR i = 1 TO ip
 ' PRINT i, lnry(i), xy(i, 1), xy(i, 2)
 IF lnry(i) = lnp THEN
  sprp = 1
  BEEP
  PRINT "Jest juz punkt "; lnp
  EXIT FOR
 END IF
NEXT
END SUB

SUB SPRNR  'Sprawdza czy jest punkt
SHARED x, y, spr, lnr, ip, lnry(), xy()
spr = 0
FOR i = 1 TO ip
 ' ? i,lnry(i),xy(i,1),xy(i,2)
 IF lnry(i) = lnr THEN
  spr = 1
  x = xy(i, 1)
  y = xy(i, 2)
  PRINT "Jest pkt "; lnr
  PRINT "X="; x, " y="; y
  EXIT FOR
 END IF
NEXT
IF spr = 0 THEN
 ip = ip + 1
 lnry(ip) = lnr
 INPUT "X, Y ", x, y
 xy(i, 1) = x
 xy(i, 2) = y
 PRINT "ip="; ip
END IF
END SUB


SUB Tytul
  k2 = 7 ' napis
  k1 = 1 ' tlo
  SCREEN 9, 0
  COLOR k2, k1
  VIEW SCREEN (1, 1)-(637, 348)
  LINE (20, 14)-(625, 335), k2, B
  PAINT (2, 2), k2
  LOCATE 4, 10
  PRINT "PODSTAWOWE OBLICZENIA GEODEZYJNE "
  LOCATE 5, 10
  PRINT "Program POG "
  LOCATE 6, 10
  PRINT "Autor programu: K. R. 1994"
  LOCATE 10, 10
 PRINT "  Program realizuje nastepujace funkcje "
  LOCATE 11, 10
 PRINT " 1. Wprowadzenie numerow i wspolrzednych"
  LOCATE 12, 10
 PRINT " 2. Obliczenie azymutow i dlugosci "
  LOCATE 13, 10
 PRINT " 3. Obliczenie wspolrzednych na podstawie domiarow "
  LOCATE 14, 10
 PRINT " 4. Zapis wspolrzednych do pliku "
  LOCATE 15, 10
 PRINT " 5. Obliczenie pola ze wspolrzednych "
  LOCATE 16, 10
 PRINT " 6. Obliczenie katow ze wspolrzednych "


  LOCATE 20, 10
  PRINT "1 - obliczenia, 2 - opis, 3 - wyjscie "
  x$ = ""
  DO WHILE x$ = ""
    x$ = INKEY$
  LOOP
 SELECT CASE x$
      CASE "2"
     SCREEN 0
     COLOR 14, 0
     CLS
    CALL opis
      CASE "3"
    SCREEN 0
    COLOR 14, 0
    CLS
    END
 END SELECT

  SCREEN 0
  COLOR 14, 0
END SUB


SUB tytul2
  CLS
  LOCATE 3, 10
  PRINT "PODSTAWOWE OBLICZENIA GEODEZYJNE                "
  LOCATE 5, 10
  PRINT "Autor: K. R. 1994                          "
  LOCATE 7, 10
  LOCATE 9, 10
 PRINT "  Program realizuje nastepujace funkcje          "
  LOCATE 11, 10
 PRINT "  Wprowadzenie numerow i wspolrzednych           "
  LOCATE 12, 10
 PRINT "  Obliczenie azymutow i dlugosci                 "
  LOCATE 13, 10
 PRINT "  Obliczenie wspolrzednych na podstawie domiarow "
  LOCATE 14, 10
 PRINT "  Zapis wspolrzednych do pliku                   "
  LOCATE 15, 10
 PRINT "  Obliczenie pola ze wspolrzednych               "

  LOCATE 20, 10
  PRINT "1 - obliczenia, 2 - opis, 3 - wyjscie "
  x$ = ""

  DO WHILE x$ = ""
    x$ = INKEY$
  LOOP

 SELECT CASE x$
      CASE "2"
    SCREEN 0
    CLS
    CALL opis
      CASE "3"
    SCREEN 0
    CLS
    END
 END SELECT

  SCREEN 0
END SUB


SUB Wspol  'Wprowadz. wspolrz
SHARED lnr, ip, lnry(), xy(), spr, fp$, fx$
CLS
PRINT "Wprowadzenie wspolrzednych punktow"
INPUT "1 - z klawiatury, 2 - z pliku "; iwar%
IF iwar% = 1 THEN GOTO 100
INPUT "Nazwa pliku danych "; pld$

OPEN "i", #3, pld$

WHILE NOT EOF(3)
 INPUT #3, lnr, x, y
 ip = ip + 1
 PRINT ip,
 PRINT USING fp$; lnr;
 PRINT USING fx$; x; y
 lnry(ip) = lnr
 xy(ip, 1) = x
 xy(ip, 2) = y
WEND
CLOSE #3
PRINT
INPUT "Nacisnij Enter"; a$
CLS
GOTO 300

100
lnr = 1
DO
CLS
PRINT "Wprowadz nr punktu  lub 0 gdy koniec wprowdz. "
PRINT "Gdy nr <> 0 to wprowadz X, Y  (oddzielone przecinkiem) "
 INPUT lnr
 IF lnr <> 0 THEN
  CALL SPRNR
 END IF
LOOP UNTIL lnr = 0
300
END SUB


SUB Wspoldom  'Oblicz, wspol. z domiarow
SHARED lnr, ip, lnry(), xy(), spr, x, y, fk$, fp$, fx$, sprp
PRINT #1, "    Obliczenie wspolrzednych z domiarow prostokatnych "
PRINT #1,
PRINT #1, "    Nr pkt      Odcieta       Rzedna          X            Y    "
PRINT #1,
lnr = 1
DO WHILE lnr <> 0
CLS
PRINT "Nr punktu pocz A  lub 0 gdy koniec obliczen "
INPUT lnr
IF lnr <> 0 THEN
 CALL SPRNR
 la = lnr
 xa = x: ya = y
 PRINT "Xa="; xa, " Ya="; ya
 PRINT #1, USING fp$; la;
 PRINT #1, TAB(41);
 PRINT #1, USING fx$; xa; ya
 PRINT "Nr  nr punktu konc  B   "
 INPUT lnr
 CALL SPRNR
 lb = lnr
 xb = x: yb = y
 dx1 = xb - xa: dy1 = yb - ya
 dob = SQR(dx1 * dx1 + dy1 * dy1)
 PRINT "dx="; dx, " dy="; dy, " d="; dob
 INPUT "Dlug. pomierz A-B "; Dp
 c = dx1 / Dp: s = dy1 / Dp
 PRINT "c="; c, " s="; s
  lnp = 1
  DO WHILE lnp <> 0
200
  PRINT "Nr punktu na domiarze prost. P  lub 0 gdy koniec obliczen linii pomiar"
  INPUT lnp
  IF lnp <> 0 THEN
   CALL spr2(lnp)
   IF sprp = 1 GOTO 200
   INPUT "Odcieta d, rzedna h: "; d, h
   dx = c * d - h * s
   dy = s * d + h * c
   PRINT "dx="; dx, " dy="; dy
   x = xa + dx
   y = ya + dy
   PRINT "Xp="; x, " Yp="; y
   ip = ip + 1
   lnry(ip) = lnp
   xy(ip, 1) = x
   xy(ip, 2) = y
   PRINT #1, USING fp$; lnp;
   PRINT #1, USING fx$; d; h; x; y
  END IF
  LOOP
 PRINT #1, USING fp$; lb;
 PRINT #1, TAB(41);
 PRINT #1, USING fx$; xb; yb
 PRINT #1,
 PRINT #1, "  Dpom = ";
 PRINT #1, USING fx$; Dp;
 PRINT #1, "   Dobl=";
 PRINT #1, USING fx$; dob
 PRINT #1,
 PRINT #1,
 INPUT "Nacisnij Enter "; a$
END IF
LOOP
END SUB


SUB ZapisWsp    'Zapis wspolrz do zbioru
SHARED ip, lnry(), xy(), fp$, fx$, fw$
CLS
PRINT "Nazwa pliku do zapisu wspolrz (Enter - XY.txt) ";
INPUT fw$
IF (fw$ = "") THEN fw$ = "XY.txt"
OPEN fw$ FOR OUTPUT AS #2
FOR i = 1 TO ip
 PRINT #2, USING fp$; lnry(i);
 PRINT #2, USING fx$; xy(i, 1); xy(i, 2)
NEXT i
CLOSE #2
END SUB

Pole trojkata gdy dane dlugosci bokow a, b, c

' Program PTHeron.bas
' I. Proste obliczenia z geometrii
' Grupa 1. Pole trojkata gdy dane dlugosci bokow a, b, c
' Wzory
' Wzory Herona: Pole=sqr(p*(p-a)(p-b)*(p-c))
' gdzie p=0.5*(a+b+c) - polowa obwodu
' Dlakontroli liczymy wysokosci :
' ha=2*Pole/a    hb=2*Pole/b  hc=2*Pole/c
' Pa=a*ha/2   Pb=b*hb/2

DECLARE SUB Dane ()
DECLARE SUB oblicz ()
DECLARE SUB plik ()
DECLARE SUB druk ()

COMMON SHARED a, b, c, P, pole, ha, hb, hc, pa, pb, pc

fd$ = "###.###"
fp$ = "####.##"
DEFDBL A-C, H, P
DO
  CLS
  PRINT "Program PTHeron.bas      DATA (mc-dz-rok): "; DATE$; " Godz:"; TIME$
  PRINT
  PRINT "Pole trojkata gdy dane dlugosci bokow a, b, c"
  CALL Dane
  CALL oblicz
  CALL druk
  INPUT "Wydruk do pliku (T/N) "; w$
  IF w$ = "T" OR w$ = "t" THEN plik
  INPUT "Dalsze obliczenia (T/N) "; do$
LOOP UNTIL do$ = "N" OR do$ = "n"

END  'Koniec  programu glownego

SUB Dane
SHARED a, b, c
 PRINT
 PRINT "Procedura dane"
 PRINT "Podaj boki : a, b, c ";
 INPUT a, b, c
END SUB



SUB oblicz
 SHARED a, b, c, P, pole, ha, hb, hc, pa, pb, pc
 fd$ = "###.###"
 fp$ = "#####.##"
 PRINT
 PRINT "procedura oblicz"
 P = (a + b + c) / 2
 PRINT "a="; a
 PRINT "b="; b
 PRINT "c="; c
 PRINT "p="; P
 pole = SQR(P * (P - a) * (P - b) * (P - c))
 PRINT "Pole="; pole
 ha = 2 * pole / a
 hb = 2 * pole / b
 hc = 2 * pole / c
 pa = a * ha / 2
 pb = b * hb / 2
 pc = c * hc / 2
 PRINT
END SUB

SUB druk
 fd$ = "###.###"
 fp$ = "#####.##"
 PRINT
 PRINT "Procedura druk"
 PRINT "Boki a, b, c: ";
 PRINT USING fd$; a; b; c
 PRINT
 PRINT "Wyniki"
 PRINT "Pole z wzoru herona: ";
 PRINT USING fp$; pole
 PRINT "Wysokosci trojkata ha, hb, hc: ";
 PRINT USING fp$; ha; hb; hc
 PRINT "Pola obliczone dla kontroli z wysokosci ha, hb, hc "
 PRINT "Pa=a*ha=";
 PRINT USING fp$; pa
 PRINT "Pb=b*hb=";
 PRINT USING fp$; pb
 PRINT "Pc=c*hc=";
 PRINT USING fp$; pc
 PRINT
 INPUT "Nacisnij enter "; a$
 PRINT
END SUB

SUB plik
fd$ = "###.###"
fp$ = "#####.##"
PRINT
INPUT "Podaj nazwe pliku do wydruku:  "; f$
INPUT "Podaj nazwisko obliczajacego: "; Naz$
OPEN f$ FOR APPEND AS 1
PRINT #1,
PRINT #1, "         Program PTHeron.bas - wersja Qbasic"
PRINT #1,
PRINT #1, "   Obliczenie pola trojkata, gdy dane boki a, b, c"
PRINT #1, "Wzory Herona: pole=sqr(p*(p-a)*(p-b)-(p-c)), gdzie p=(a+b+c)/2"
PRINT #1,
PRINT #1, "Dane: boki trojkata "
PRINT #1, "a="; : PRINT #1, USING fd$; a;
PRINT #1, "   b="; : PRINT #1, USING fd$; b;
PRINT #1, "  c="; : PRINT #1, USING fd$; c
PRINT #1,
PRINT #1, "Wyniki obliczen:"
PRINT #1, "Wysokosci Ha, Hb, Hc: ";
PRINT #1, USING fd$; ha; hb; hc
PRINT #1,
PRINT #1, "Pole z wzoru Herona =";
PRINT #1, USING fp$; pole
PRINT #1,
PRINT #1, "Pola obliczone dla kontroli z wysokosci Ha, Hb, Hc: "
PRINT #1, "Pa=a*Ha = ";
PRINT #1, USING fp$; pa;
PRINT #1, "  Pb=b*Hb=";
PRINT #1, USING fp$; pb;
PRINT #1, "  Pc=c*Hc=";
PRINT #1, USING fp$; pc
PRINT #1,
PRINT #1, "Obliczyl: "; Naz$; "  Data (mc-dz-rok) "; DATE$; " Godz. "; TIME$
PRINT #1,: PRINT #1,
CLOSE #1
END SUB

Pole trojkata gdy dane 2 dlugosci bokow b, c i kat Alfa miedzy nimi w gradach

' Program PT2DKat,bas QBasic
'I. Proste obliczenia z geometrii

'Grupa 2. Gruszka, Nowak
' 1. Pole trojkata gdy dane 2 dlugosci bokow b, c i kat Alfa miedzy nimi w gradach

' Wzory
' Pole=0.5*b*c*sin(AlfaR), gdzia AlfaR - kąt w radianach
' AlfaR=Alfa/RoG
' Rog=200/Pi: Pi=4*ATN(1) - w Basicu
' Dla kontroli liczymy
' a=sqr(B^2+c^2-2*b*c*cos(AlfaR))
' ha=2*Pole/a
' hb=2*Pole/b
' hc=2*Pole/c
' Pa=a*ha/2
' Pb=b*hb/2
' Pc=c*hc/2

fd$ = "###.###"   ' format wydruku dlugosci
fp$ = "#####.##"  ' format wydruku pola
fk$ = "####.####"' format wydruku katow
DIM pole AS DOUBLE
DEFDBL A-C, H, P
pi = 4# * ATN(1#)
REM PRINT "Pi="; pi
RoG = 200# / pi ' RO[grad]


DO
 ' Poczatek petli DO
 CLS
 PRINT "Program PT2DKat.bas"
 PRINT "Pole trojkata gdy dane 2 dlugosci bokow b, c i kat Alfa[grad] miedzy nimi"
 PRINT
 PRINT "Podaj boki: b, c, Alfa[grad (oddzielone przecinkiem):   ";
 INPUT b, c, Alfa

'Obliczenia

 PRINT "RoG="; RoG
 AlfaR = Alfa / RoG
 PRINT "AlfaR="; AlfaR
 pole = .5# * b * c * SIN(AlfaR)
 a = SQR(b ^ 2 + c ^ 2 - 2 * b * c * COS(AlfaR))  ' bok a
 ha = 2 * pole / a
 hb = 2 * pole / b
 hc = 2 * pole / c
 pa = a * ha / 2
 pb = b * hb / 2
 pc = c * hc / 2

' Wydruki
 PRINT "Pole trokata o bokach ";
 PRINT USING fd$; b; c;
 PRINT " i kacie Alfa[grad] miedzy nimi ";
 PRINT USING fk$; Alfa;
 PRINT " = ";
 PRINT USING fp$; pole
 PRINT "Bok obliczony a = "; : PRINT USING fd$; a
 PRINT
 PRINT "Wysokosci ha, hb, hc";
 PRINT USING fd$; ha; hb; hc
 PRINT
 PRINT "Pola obliczone z wysokości "
 PRINT "Pa="; :  PRINT USING fp$; pa
 PRINT "Pb="; :  PRINT USING fp$; pb
 PRINT "Pc="; :  PRINT USING fp$; pc
 PRINT
 INPUT "Nacisnij Enter "; a$

 INPUT "Wydruk do pliku  (T/N) "; w$
 IF w$ = "T" OR w$ = "t" THEN
  INPUT "Podaj nazwe pliku do wydruku "; f$
  OPEN f$ FOR APPEND AS 1
  PRINT #1, "         Program PT2DKat.bas"
  PRINT #1, "Obliczenie pola trojkata, gdy dane 2 boki i kat miedzy nimi"
  PRINT #1,
  PRINT #1, "Dane: ";
  PRINT #1, "b=";
  PRINT #1, USING fd$; b;
  PRINT #1, "  c=";
  PRINT #1, USING fd$; c;
  PRINT #1, "  Alfa[grad]= ";
  PRINT #1, USING fk$; Alfa
  PRINT #1, "Bok obliczony a=";
  PRINT #1, USING fd$; a
  PRINT #1, "Wysokosci ha, hb, hc: ";
  PRINT #1, USING fd$; ha; hb; hc
  PRINT #1,
  PRINT #1, "Pole = ";
  PRINT #1, USING fp$; pole
  PRINT #1,
  INPUT "Podaj nazwisko obliczajacego: "; Naz$
  PRINT #1, "Obliczyl: "; Naz$; "    Data (mc-dz-rok) "; DATE$; " Godz. "; TIME$
  PRINT #1,
  END IF
 CLOSE #1

 do$ = "T"
 PRINT "Dalsze obliczenia (T/N) ";
 INPUT do$
LOOP UNTIL (do$ = "N" OR do$ = "n")  ' Koniec DO

END

Pole trojkata gdy dane wspolrzedne 3 punktow: x1,y1, x2,y2, x3,y3

DECLARE FUNCTION dlxy# (x1#, y1#, x2#, y2#)
DECLARE FUNCTION PHelm# (a!, b!, c!)
DECLARE FUNCTION dlugxy# (x1#, y1#, x2#, y2#)
' Program PTXY3p.bas QBasic
'I. Proste obliczenia z geometrii
'Grupa 3. Kaleta Gajewski
' 1. Pole trojkata gdy dane wspolrzedne 3 punktow: x1,y1, x2,y2, x3,y3
' Wzory
' dx12=x2-x1
' dy12=y2-y1
' dx13=x3-x1
' dy13=y3-y1
' p1=0.5*(dx12*dy13=dx13*dy12)
' p2=(x1*y2+x2*y3+x3*y1-x3*y2-x1*y3-x28y1)/2

fd$ = "####.###"   ' format wydruku dlugosci
fw$ = "#####.###"  ' format wydruku wspolrz
fp$ = "#####.##"   ' format pola
DEFDBL D, P, X-Y   ' Zmienne podwojnej dokladnosci
DEFLNG N

DO
 CLS  ' Poczatek petli DO
 PRINT "      Program PTXY3p.PAS"
 PRINT
 PRINT "Pole trojkata gdy dane wspolrzedne 3 punktow: x1,y1, x2,y2, x3,y3"
 PRINT
 INPUT "Podaj dane punktu 1: Nr1, X1, Y1 (oddzielone przecinkiem)"; N1, x1, y1
 INPUT "Podaj dane punktu 2: Nr2, X2, Y2 (oddzielone przecinkiem)"; N2, x2, y2
 INPUT "Podaj dane punktu 3: Nr3, X3, Y3 (oddzielone przecinkiem)"; N3, x3, y3
 dx12 = x2 - x1
 dy12 = y2 - y1
 dx13 = x3 - x1
 dy13 = y3 - y1
 PRINT "Wyniki"
 PRINT "DX12, DY12: "; dx12; dy12
 PRINT "DX13, DY13: "; dx13; dy13
 P1 = (dx12 * dy13 - dx13 * dy12) / 2 ' Pole metoda 1
 PRINT "P1="; P1
 P2 = (x1 * y2 + x2 * y3 + x3 * y1 - x3 * y2 - x1 * y3 - x2 * y1) / 2 ' Pole metoda 2
 PRINT "P2="; P2
 a = dlxy(x2, y2, x3, y3)
 b = dlxy(x1, y1, x3, y3)
 c = dlxy(x1, y1, x2, y2)
 P3 = PHelm(a, b, c)
 PRINT "P3=";
 PRINT USING "####.##"; P3
 PRINT
 INPUT "Nacisnij Enter"; a$
 ' Wydruki
 PRINT "Pole trojkata ze wspolrzednych 3 punktow  "
 PRINT "X1, Y1: ";
 PRINT USING fw$; x1; y1
 PRINT "X2, Y2: ";
 PRINT USING fw$; x2; y2
 PRINT "X3, Y3: ";
 PRINT USING fw$; x3; y3
 PRINT "Pola obliczone z przyrostow wspolrzednych    ";
 PRINT "P1="; :  PRINT USING fp$; P1
 PRINT "Pola obliczone bezposrednio ze wspolrzednych ";
 PRINT "P2="; : PRINT USING fp$; P2
 PRINT "Pola obliczone ze wzoru Herona               ";
 PRINT "P3="; : PRINT USING fp$; P3
 PRINT "Dlugosci bokow a, b, c ";
 PRINT USING fw$; a; b; c
 PRINT
 INPUT "Nacisnij Enter "; a$
 INPUT "Wydruk do pliku  (T/N) "; w$
 IF w$ = "T" OR w$ = "t" THEN
  INPUT "Podaj nazwe pliku do wydruku "; f$
  OPEN f$ FOR APPEND AS 1
  PRINT #1, "   Program PTXY3p.BAS"
  PRINT #1, "Pole trokata ze wspolrzednych 3 punktow  "
  PRINT #1, "Dane"
  PRINT #1, "Punkt Nr1, X1, Y1: ";
  PRINT #1, USING "#######"; N1;
  PRINT #1, USING fw$; x1; y1
  PRINT #1, "Punkt Nr2, X2, Y2: ";
  PRINT #1, USING "#######"; N2;
  PRINT #1, USING fw$; x2; y2
  PRINT #1, "Punkt Nr3, X3, Y3: ";
  PRINT #1, USING "#######"; N3;
  PRINT #1, USING fw$; x3; y3
  PRINT #1,
  PRINT #1, "Wyniki"
  PRINT #1, "Pole dzialki "; N1; "-"; N2; "-"; N3; ""
  PRINT #1, "Pola obliczone z przyrostow wspolrzednych    ";
  PRINT #1, "P1=";
  PRINT #1, USING fp$; P1
  PRINT #1, "Pola obliczone bezposrednio ze wspolrzednych ";
  PRINT #1, "P2=";
  PRINT #1, USING fp$; P2
  PRINT #1, "Pole obliczone ze wzoru Herona               ";
  PRINT #1, "P3=";
  PRINT #1, USING fp$; P3
  PRINT #1, "Dlugosci bokow a, b, c ";
  PRINT #1, USING fw$; a; b; c
  PRINT #1,
  INPUT "Nazwisko obliczajacego: "; obl$
  PRINT #1, "Obliczyl: "; Naz$; "    Data (mc-dz-rok) "; DATE$; " Godz. "; TIME$
  PRINT #1,
  PRINT #1,
 END IF
 CLOSE #1
 do$ = "T"
 PRINT "Dalsze obliczenia (T/N) ";
 INPUT do$
LOOP UNTIL (do$ = "N" OR do$ = "n") ' Koniec petli DO

END  ' Koniec programu glownego


' -- Funkcje --

FUNCTION dlxy (x1, y1, x2, y2)  ' Obliczenie dlugosci ze wspolzrednych
' PRINT "Dlxy"
dx = x2 - x1
dy = y2 - y1
d = SQR(dx ^ 2 + dy ^ 2)
' PRINT "d="; d
dlxy = d
END FUNCTION

FUNCTION PHelm (a, b, c)  ' Pole trojkata na podstawie dlugosci bokow - wzor Helmerta
p = (a + b + c) / 2
pole = SQR(p * (p - a) * (p - b) * (p - c))
PHelm = pole
END FUNCTION

Pole czworokata gdy dane wspolrzedne 4 punktow: x1,y1, x2,y2, x3,y3, x4,y4

DECLARE FUNCTION dlxy# (x1#, y1#, x2#, y2#)
DECLARE FUNCTION PHelm# (a#, b#, c#)
' Program PczwXY.bas QBasic
' I. Proste obliczenia z geometrii
' Grupa 4. Malecki, Zielinski
' 1. Pole czworokata gdy dane wspolrzedne 4 punktow: x1,y1, x2,y2, x3,y3, x4,y4
' Wzory
' dx13=x3-x1
' dy13=y3-y1
' dx24=x4-x2
' dy24=y4-y2
' p1=(dx13*dy24-dx24*dy13)/2
' p21=(dx12*dy13-dx13*dy12)/2
' p22=(dx13*dy13-dx14*dy13)/2
' p2=p21+p22

fd$ = "####.###"   ' format wydruku dlugosci
fw$ = "#####.###"  ' format wydruku wspolrz
fp$ = "#####.##"   ' format pola
DEFDBL A-E, P, X-Y  ' Zmienne rzeczywiste podwojnej dokladnosci

' ----  Program glowny ------
DO   ' Poczatek petli DO
 CLS
 'PRINT "Grupa 4, zad. 1 - Malecki, Zielinski;"
 PRINT "  Program  PczwXY.bas"
 PRINT
 PRINT "Pole czworoboku gdy dane wspolrzedne 4 punktow: x1,y1, x2,y2, x3,y3, x4, y4"
 PRINT
 INPUT "Podaj wspolrzedne punktu 1: X1, Y1 "; x1, y1
 INPUT "Podaj wspolrzedne punktu 2: X2, Y2 "; x2, y2
 INPUT "Podaj wspolrzedne punktu 3: X3, Y3 "; x3, y3
 INPUT "Podaj wspolrzedne punktu 4: X4, Y4 "; x4, y4
 dx12 = x2 - x1
 dy12 = y2 - y1
 dx13 = x3 - x1
 dy13 = y3 - y1
 dx14 = x4 - x1
 dy14 = y4 - y1
 dx24 = x4 - x2
 dy24 = y4 - y2
 P1 = (dx13 * dy24 - dx24 * dy13) / 2 ' Pole metoda 1
 p21 = (dx12 * dy13 - dx13 * dy12) / 2
 p22 = (dx13 * dy14 - dx14 * dy13) / 2
 P2 = p21 + p22
 PRINT "Wyniki"
 PRINT "P1="; P1
 PRINT "P2="; P2
 a = dlxy(x1, y1, x2, y2)
 b = dlxy(x2, y2, x3, y3)
 c = dlxy(x3, y3, x4, y4)
 d = dlxy(x4, y4, x1, y1)
 e = dlxy(x1, y1, x3, y3)
 f = dlxy(x2, y2, x4, y4)
 P31 = PHelm(a, b, e)
 P32 = PHelm(e, c, d)
 P3 = P31 + P32
 PRINT "P3="; P3
 INPUT "Nacisnij Enter"; a$
' Wydruki
 CLS
 PRINT "Pole czworokata ze wspolrzednych 4 punktow  "
 PRINT "X1, Y1: ";
 PRINT USING fw$; x1; y1
 PRINT "X2, Y2: ";
 PRINT USING fw$; x2; y2
 PRINT "X3, Y3: ";
 PRINT USING fw$; x3; y3
 PRINT "X4, Y4: ";
 PRINT USING fw$; x4; y4
 PRINT "Pola obliczone z przyrostow wspolrzednych czworokata   ";
 PRINT "P1="; :  PRINT USING fp$; P1
 PRINT "Pola obliczone z sum trojkatow 1-2-3 i 1-3-4           ";
 PRINT "P2="; : PRINT USING fp$; P2
 PRINT "Pola obliczone ze wzorow Herona                        ";
 PRINT "P3="; : PRINT USING fp$; P3
 PRINT "Dlugosci bokow a, b, c, d, przekatne 1-3, 2-4:   "
 PRINT USING fw$; a; b; c; d; e; f
 PRINT
 INPUT "Nacisnij Enter "; a$

 INPUT "Wydruk do pliku  (T/N) "; w$
 IF w$ = "T" OR w$ = "t" THEN  ' Wydruki do pliku
  INPUT "Podaj nazwe pliku do wydruku "; f$
  OPEN f$ FOR APPEND AS 1   ' Otwarcie pliku do zapisu w trybie dopisywania
  PRINT #1, "    Program PczwXY.bas"
  PRINT #1, "Pole czworokata ze wspolrzednych 4 punktow  "
  PRINT #1,
  PRINT #1, "Dane"
  PRINT #1, "X1, Y1: ";
  PRINT #1, USING fw$; x1; y1
  PRINT #1, "X2, Y2: ";
  PRINT #1, USING fw$; x2; y2
  PRINT #1, "X3, Y3: ";
  PRINT #1, USING fw$; x3; y3
  PRINT #1, "X4, Y4: ";
  PRINT #1,
  PRINT #1, "Wyniki"
  PRINT #1, USING fw$; x4; y4
  PRINT #1, "Pola obliczone z bezposrednio przyrostow wspolrzednych    ";
  PRINT #1, "P1=";
  PRINT #1, USING fp$; P1
  PRINT #1, "Pola obliczone z sum pol 2 trojkatow ze wspolrzednych     ";
  PRINT #1, "P2=";
  PRINT #1, USING fp$; P2
  PRINT #1, "Pole obliczone z sum pol 2 trojkatow z wzoru Herona       ";
  PRINT #1, "P3=";
  PRINT #1, USING fp$; P3
  PRINT #1,
  PRINT #1, "Dlugosci bokow a, b, c, d ";
  PRINT #1, USING fw$; a; b; c; d
  PRINT #1, "Przekatne 1-3, 2-4:  ";
  PRINT #1, USING fw$; e; f

  PRINT #1,
  INPUT "Nazwisko obliczajacego: "; obl$
  PRINT #1, "Obliczyl: "; obl$; "    Data (mc-dz-rok) "; DATE$; " Godz. "; TIME$
  PRINT #1,
  CLOSE #1  ' Zamkniecie pliku
 END IF

 do$ = "T"
 PRINT "Dalsze obliczenia (T/N) ";
 INPUT do$
LOOP UNTIL (do$ = "N" OR do$ = "n") ' Koniec petli DO

END 'Koniec programu glownego

' Funkcje

DEFSNG A-C, E
FUNCTION dlxy (x1, y1, x2, y2)  ' Obliczenie dlugosci ze wspolrzednych
dx = x2 - x1
dy = y2 - y1
d = SQR(dx ^ 2 + dy ^ 2)
dlxy = d
END FUNCTION

DEFDBL A-C
FUNCTION PHelm (a, b, c)  ' Pole trojkata na podstawie bokow - wzor Helmerta
P = (a + b + c) / 2
pole = SQR(P * (P - a) * (P - b) * (P - c))
PHelm = pole
END FUNCTION

Pole trojkata gdy dane 2 katy Alfa, Beta w gradach i dlugosc boku c


' Program PT2KD.bas QBasic
'I. Proste obliczenia z geometrii
' 1. Pole trojkata gdy dane 2 katy Alfa, Beta w gradach i dlugosc boku c
' Wzory
' Gamma=200-(Alfa+Beta)
' Pi=4*Atn(1)
' RoG=200/Pi
' AlfaR=Alfa/RoG
' BetaR=Bata/Rog
' hc1=a*sin(BetaR)
' hc2=b*sin(AlfaR)
' P1=c*hc1/2
' P2=c*hc2/2
' Dla kontroli liczymy pole z wzoru Herona

DECLARE FUNCTION PHelm# (a#, b#, c#)


fd$ = "####.###"   ' format wydruku dlugosci
fp$ = "#####.##"  ' format wydruku pola
fk$ = "####.####"' format wydruku katow
DEFDBL A-C, G-H, P
Pi = 4# * ATN(1#)
RoG = 200# / Pi  ' Ro[Grad]


DO   ' Pocztek petli DO
 CLS
 PRINT "      Program PT2KDl.bas"
 PRINT "Pole trojkata gdy dane 2 katy Alfa, Beta w gradach i dlugosc boku c"
 PRINT
 INPUT "Podaj Alfa[Grad], Beta[Grad], c (oddzielone przecinkami)  "; Alfa, Beta, c
 Gamma = 200# - (Alfa + Beta)
 AlfaR = Alfa / RoG
 BetaR = Beta / RoG
 GammaR = Gamma / RoG
 a = c * SIN(AlfaR) / SIN(GammaR)
 b = c * SIN(BetaR) / SIN(GammaR)
 PRINT
 PRINT "a="; a
 PRINT "b="; b
 PRINT "c="; c
 PRINT "Gamma="; Gamma
 hc1 = a * SIN(BetaR)
 hc2 = b * SIN(AlfaR)
 PRINT "hc1="; hc1
 PRINT "hc2="; hc2
 P1 = c * hc1 / 2
 P2 = c * hc2 / 2

 PRINT "P1="; P1
 PRINT "P2="; P2
 P3 = PHelm(a, b, c)
 PRINT "P3="; P3

' Wydruki
 CLS
 PRINT "Pole trojkata gdy dane: Alfa, Beta, c  "
 PRINT "Pola obliczone   "
 PRINT "P1= c*hc1 = "; :  PRINT USING fp$; P1
 PRINT "P2= c*hc2 = "; :  PRINT USING fp$; P2
 PRINT "Pole obliczone ze wzoru Herona               "
 PRINT "P3="; : PRINT USING fp$; P3
 PRINT "Dlugosci bokow a, b, c:  ";
 PRINT USING fd$; a; b; c
 PRINT
 INPUT "Wydruk do pliku  (T/N) "; w$
 IF w$ = "T" OR w$ = "t" THEN  ' Poczatek IF
  INPUT "Podaj nazwe pliku do wydruku "; f$
  OPEN f$ FOR APPEND AS 1
  PRINT #1, "  Program PT2KDl.bas"
  PRINT #1, "Pole trokata gdy dane: Alfa, Beta, c  "
  PRINT #1,
  PRINT #1, "Alfa[grad], Beta[grad], c:  ";
  PRINT #1, USING fk$; Alfa; Beta;
  PRINT #1, USING fd$; c
  PRINT #1,
  PRINT #1, "Gamma[grad]="; Gamma
  PRINT #1, "Wysokosci z boku c:  hc1 = a * SIN(BetaR), hc2 = b * SIN(AlfaR):"
  PRINT #1, USING fd$; hc1; hc2
  PRINT #1,
  PRINT #1, "Pola obliczone   "
  PRINT #1, "P1= c*hc1 = "; :  PRINT #1, USING fp$; P1
  PRINT #1, "P2= c*hc2 = "; :  PRINT #1, USING fp$; P2
  PRINT #1, "Pole obliczone ze wzoru Herona P3= ";
  PRINT #1, USING fp$; P3
  PRINT #1, "Dlugosci bokow a, b, c ";
  PRINT #1, USING fd$; a; b; c
  PRINT #1,
  PRINT #1,
  INPUT "Nazwisko obliczajacego: "; obl$
  PRINT #1, "Obliczyl: "; obl$; "    Data (mc-dz-rok) "; DATE$; " Godz. "; TIME$
  PRINT #1,
  CLOSE #1
 END IF  ' Koniec IF

 do$ = "T"
 PRINT "Dalsze obliczenia (T/N) ";
 INPUT do$
LOOP UNTIL (do$ = "N" OR do$ = "n")  ' Koniec petli DO

END  ' Koniec programu glownego

'Funkcja
FUNCTION PHelm (a, b, c)  ' Obliczenie pola z dlugosci bokow - wzor Helmerta
p = (a + b + c) / 2
' PRINT "a, b, c = "; a, b, c,
pole = SQR(p * (p - a) * (p - b) * (p - c))
PHelm = pole
END FUNCTION