Przyklady progrmów w języku QBASIC



Oznaczenia niektorych słów kluczowych:

REM lub ' - komentrz (uwaga, remark)
CLS – kasowanie ekranu
INPUT – wprowadzenie danych, DEF – definicje, PRINT – wydruk
DIM – definicja tablicy


REM  QBPR1.BAS ' Nazwa programu 
REM Wczytywanie liczb, znaków, sumy, wydruk – komentarz odnossnie funkci programu
CLS ' Kasowanie ekranu
DEFDBL A-L ' Deklaracja zmiennych A-L jako Long
DEFSTR P-Z ' Deklaracja zmiennych A-L jako String
INPUT "Wpisz dowolna liczbe "; lb1 ' Wprowadzenie liczby
INPUT "wpisz inna liczbe "; lb2 
INPUT "Wpisz znaki "; znak1 ' Wprowadzenie znaku
INPUT "wpisz znaki "; znak2
lb3 = lb1 + lb2
znak3 = znak1 + znak2
PRINT lb1, lb2, lb3 ' Wydruk na ekranie
PRINT znak1, znak2, znak3
PRINT lb1; lb2; lb3
PRINT znak1; znak2; znak3
PRINT "lb1="; lb1, "lb2="; lb2, "lb3=lb1+lb2="; lb3
END ' Koniec programu

REM QBRPR2.BAS
REM Wydruk liczb z uzyciem formatowania
CLS
DEFDBL A-L
a = 100
b = 3
c = a / b
PRINT c, c, c
PRINT
PRINT c; c; c
PRINT
PRINT USING "###.###"; c; c; c
PRINT
PRINT USING "+###.####"; c; c; c
PRINT USING "+#######.####"; c; c; c
PRINT USING "+######.####"; c; c; c
PRINT USING "+#########.####"; c; c; c

REM abcq3.bas
REM Program liczy sume liczb od podanej wartosci N1 do podanej N2
CLS
PRINT "Program liczy sume liczb od N1 do N2"
PRINT
INPUT "Podaj n1, n2 "; n1, n2
sum = 0
FOR k = n1 TO n2
sum = sum + k
NEXT k
PRINT
PRINT "Suma liczb od "; n1; " do "; n2; " = "; sum
END

REM ABCQ4.BAS
CLS
PRINT "Program liczy n! (n silnia) dla n < 35"
PRINT
PRINT "  N! = 1*2*3*4...*n "
PRINT
INPUT "Podaj n "; n
silnia = 1
FOR k = 1 TO n
silnia = silnia * k
NEXT k
PRINT
PRINT n; "!="; silnia
END

REM ABCQ5.BAS
REM Porownywanie 2 liczb
CLS
INPUT "Podaj 2 liczby "; a, b
PRINT a; "="; b; " daje wynik "; a = b
PRINT a; ">"; b; " daje wynik "; a > b
PRINT a; "<"; b; " daje wynik "; a < b


REM ABCQ6.BAS
REM Porownywanie 2 liczb, wynik odejmowania dodatni lub 0
CLS
INPUT "Podaj 2 liczby "; a, b
IF a > b THEN
  wynik = a - b
  PRINT "a-b="; wynik
END IF
IF a < b THEN
  wynik = b - a
  PRINT "b-a="; wynik
  END IF
IF a = b THEN
  wynik = a - b
  PRINT "a-b=b-a="; wynik
END IF

REM ABCQ7.BAS
REM Porownywanie liter
CLS
INPUT "Wpisz litere "; lit1$
INPUT "Wpisz litere "; lit2$
  IF lit1$ < lit2$ THEN
    PRINT lit1$, lit2$
  ELSE
    PRINT lit2$, lit1$
  END IF

REM ABCQ8.bas
REM Wprowadzone liczby maja byc z zakresu (0,1)
CLS
INPUT "Podaj 2 dodatnie liczby < 1 "; a, b
  IF a < 1 AND b < 1 AND a > 0 AND b > 0 THEN
    PRINT "Dobrze"
  ELSE
    PRINT "Zle"
  END IF

REM ABCQ8a.BAS
REM Petla DOO..LOOP
CLS
k = 0
INPUT "Ile przebiegow petli "; n
DO
  k = k + 1
  IF k = n THEN EXIT DO
LOOP
PRINT "Wykonano "; k, "przebiegow petli LOOP"

REM inny typ petli
INPUT "Ile petli "; n
FOR m = 1 TO 10000
 IF m = n THEN EXIT FOR
NEXT m
PRINT "Wykonano "; m; "przebiegow petli FOR"

REM ABCQ9.BAS
REM Program wczytuje n liczb i porzadkuje
REM je od najwiekszej do najmniejszej
CLS
DIM liczba(50)
INPUT "Ile liczb "; n
FOR i = 1 TO n
  PRINT "Liczba nr "; i
  INPUT liczba(i)
NEXT i
REM porzadkowanie liczb
FOR i = 1 TO n - 1
  FOR j = i + 1 TO n
    IF liczba(i) < liczba(j) THEN SWAP liczba(i), liczba(j)
  NEXT j
NEXT i
REM Wydruk uporzadkowanych liczb
PRINT
PRINT "Liczby w porzadku malejacym "
PRINT
FOR i = 1 TO n
 PRINT , liczba(i)
NEXT i
END

REM ABCQ10.BAS
REM Program wczytuje n liczb i porzadkuje
REM je od najwiekszej do najmniejszej
CLS
DIM nazw(50) AS STRING
REM wprowadzenie nazwisk
INPUT "Ile nazwisk "; n
FOR i = 1 TO n
  PRINT "Nazwisko nr "; i
  INPUT nazw(i)
NEXT i
REM porzadkowanie nazwisk
FOR i = 1 TO n - 1
  FOR j = i + 1 TO n
    IF nazw(i) > nazw(j) THEN SWAP nazw(i), nazw(j)
  NEXT j
NEXT i
REM Wydruk uporzadkowanych nazwisk
PRINT
PRINT "Nazwiska w kolejnosci alfabetycznej "
PRINT
FOR i = 1 TO n
 PRINT , nazw(i)
NEXT i
END

REM abcq11.bas
REM znajdowanie najwiekszej i najmniejszej liczby
CLS
DIM liczba(50)
INPUT "Ile liczb "; n
FOR i = 1 TO n
 PRINT "liczba nr "; i;
 INPUT liczba(i)
NEXT i
REM znajdowanie liczby najwiekszej
max = liczba(1)                                 '1
FOR i = 1 TO n
 IF liczba(i) > max THEN max = liczba(i)        '2
NEXT i
REM znajdowanie liczby najmniejszej             '3
min = liczba(1)
FOR i = 1 TO n
 IF liczba(i) < min THEN min = liczba(i)        '4
NEXT i
REM wydruk liczby max i minim.
PRINT
PRINT "Liczba najwieksza = "; max, "Liczba najmniejsza="; min
END


REM ABCQ12.BAS
REM Wydruk na drukarke, gdy blad to komunikat
CLS
ON ERROR GOTO label1
INPUT "Podaj promien "; r
 obw = 2 * 3.14 * r
 pole = 3.14 * r ^ 2
 LPRINT "Promien="; r, "obwod="; obw, "pole="; pole
END
label1:
  PRINT "Drukarka nie jest gotowa. Wlacza ja i <Enter> "
  INPUT d$
  RESUME


REM ABCQ12.BAS
REM Sprawdzanie rodzaju bledu: brak gotowosci drukarki, dzielenie przez zero, inny
CLS
ON ERROR GOTO label1
DEFINT A-D
INPUT "Podaj promien "; r
  obw = 2 * 3.14 * r
  pole = 3.14 * r ^ 2
  LPRINT "Promien="; r, " obwod = "; obw, "; pole = "; pole; ""
  w = pole / (r - r)
END
label1:
PRINT "Blad nr "; ERR
  SELECT CASE ERR
    CASE 25
     PRINT "Drukarka nie jest gotowa.  Wlacz ja i Enter"
     INPUT d$
    RESUME
  CASE 11
   PRINT "Dzielenie przez zero - Enter by zakonczyc"
   INPUT d$
  CASE ELSE
   PRINT "Nieznany blad - Enter by zakonczyc"
   INPUT d$
  END SELECT


REM abcq13.bas
REM Podprogram drukuj – 2 wywolania
DECLARE SUB drukuj (x!)   ' ! oznacza single precision - real
CLS
a = 7
b = 15
CALL drukuj(a)
PRINT "Pierwszy powrot do Main"
CALL drukuj(b)
PRINT "Drugi powrot do Main"
PRINT "w programie MAIN a="; a, "b="; b, "x="; x
END

SUB drukuj (x)
PRINT "Jestem w podprogramie DRUKUJ ";
PRINT "x="; x, "a="; a, "b="; b
END SUB


REM ABCQ14.BAS
REM 2 podprogramy: druk1 i druk2 
DECLARE SUB druk1 ()
DECLARE SUB druk2 ()
COMMON SHARED ws
CLS
ws = 23
PRINT "W programie glownym ws="; ws
 CALL druk1
 CALL druk2
END

SUB druk1
PRINT "w SUBroutine druk1 ws="; ws
END SUB

SUB druk2
PRINT "Tu takze (w subroutine druk2)  ws="; ws
END SUB


REM abcq15.bas
REM Zmienne wspolne/wspoldzielone, podprogram (SUB) licz
DECLARE SUB licz ()
COMMON SHARED a, b, c, w
CLS
a = 1
b = 2
c = 3
PRINT "Przed wejsciem do procedury LICZ wartosci a, b, c oraz w (suma w licz): "
PRINT a, b, c, w
CALL licz
PRINT "Po wyjscu z proc LICZ wartosci a, b, c oraz w (suma przed zmiana w licz): "
PRINT a, b, c, w
PRINT "Poniewaz a, b, c byly zadeklarowane jako COMMON SHARED"
END

SUB licz
w = a + b + c
a = 10
b = 20
c = 30
END SUB


REM abcq16.bas
REM zmienne shared i zwykle, 2 podprogramy
DECLARE SUB ekran ()
DECLARE SUB pisz ()
CLS
a = 12
b = 20
PRINT "MAIN (glowny) : a,b", a, b
CALL ekran
CALL pisz

SUB ekran
PRINT "ekran: a, b (zupelnie inne zmienne bo nie shared) "; a, b
END SUB

SUB pisz
SHARED a, b
PRINT "pisz: shared a, b", a, b
END SUB


REM ABCQ17  Program znajduje wspolczynniki rownan kwadratowych
REM  a x^2 + b x + c = 0
REM wybierajac tylko te, ktore daja pierwiastki wymierne
REM PODPROGRAMY
REM wsp()   generuje wspolczynniki a, b, c
REM pierwiastki()  oblicza pierwiastki
REM                *******************
DECLARE SUB wsp (a!, b!, c!)
DECLARE SUB pierwiastki (a!, b!, delta!, x1!, x2!)
DIM pierw(99, 1)   'tablica pierwiastkow - 0 do 99 rownan
                   ' 0 do 1 pierwiastkow
  CLS
PRINT "Program   generuje wspolczynniki a, b, c rownan kwadratowych "
PRINT " i   oblicza pierwiastki "
PRINT
PRINT "Wydruk wynikow"
PRINT "W wynikach drukowane sa:  a, b, c,  x1  x2"
PRINT
PRINT
INPUT " Nacisnij Enter"; a$
 CLS

    licznik% = 0
20 CALL wsp(a, b, c)
  delta = b ^ 2 - 4! * a * c
  IF delta < 0 THEN GOTO 20
  sqdelta = SQR(delta)
  IF sqdelta <> INT(sqdelta) THEN GOTO 20
     ' jesli pierwiastek z delty nie jest liczba calkowita
     ' generuje kolejne wspolczynniki
  CALL pierwiastki(a, b, sqdelta, x1, x2)
       pierw(licznik%, 0) = x1
       pierw(licznik%, 1) = x2


  REM poczawszy od 2-go rownania sprawdza, czy pierwiastki nie
  REM powtarzaja sie
    IF licznik% > 2 THEN
      FOR k% = 1 TO licznik% - 1
        IF pierw(k%, 0) = x1 AND pierw(k%, 1) = x2 THEN GOTO 20
      NEXT k%
    END IF
  PRINT "Lp="; licznik%, , a; b; c, x1, x2  'wydruk wynikow
   IF licznik% > 0 AND (licznik% \ 20 = licznik% / 20) THEN INPUT "Nacisnij Enter"; ent$
  licznik% = licznik% + 1
  IF licznik% <= 99 GOTO 20
  PRINT "Koniec"
 END

 SUB pierwiastki (a, b, sqrdelta, x1, x2)
  x1 = (-b - sqrdelta) / 2 / a
  x2 = (-b + sqrdelta) / 2 / a
END SUB

SUB wsp (a, b, c)
REM Generuje wspolcz rowna a,b,c
REM w sposob przypadkowy (IF RND < 0.5) im przypisuje znak minus
 RANDOMIZE TIMER
 a = INT(RND * 10) + 1
   IF RND < .5 THEN a = -a
 b = INT(RND * 10) + 1
   IF RND < .5 THEN b = -b
 c = INT(RND * 10) + 1
   IF RND < .5 THEN c = -c
END SUB

REM p27.bas
REM Zastosowanie funkcji – FUNCTION nazwa (parametry)
DECLARE FUNCTION sumprz (a, b, c)
CLS
INPUT "Podaj 3 liczby "; a, b, c
PRINT "Suma dlug. przek prostop a,b,c= "; sumprz(a, b, c)
END

FUNCTION sumprz (a, b, c)
p1 = SQR(a ^ 2 + b ^ 2)
p2 = SQR(b ^ 2 + c ^ 2)
p3 = SQR(a ^ 2 + c ^ 2)
sumprz = 2 * (p1 + p2 + p3)
END FUNCTION

REM p27c.bas
DECLARE FUNCTION iloraz (a, b)
CLS
INPUT "podaj 2 liczby x,y "; x, y
rez1 = iloraz(x, y)
rez2 = iloraz(33, 11)
rez3 = iloraz(x * y, x + y)
rez4 = iloraz(3 + x, y / 7)
PRINT "rez1=iloraz(x,y)="; rez1
PRINT "rez1=iloraz(33,11)="; rez2
PRINT "rez3=iloraz(x*y, x+y)="; rez3
PRINT "rez4=iloraz(3+x,y/7)="; rez4

FUNCTION iloraz (p, q)
iloraz = p / q
END FUNCTION

REM p37.bas
REM Program znajduje liczby pierwsze z przedzialu 1 do 1000
REM metoda Eratostenesa
CLS
PRINT "Program znajduje liczby pierwsze z przedzialu 1 do 1000"
PRINT "Metoda Eratostenesa"
PRINT
INPUT "Ile liczb przeszukac "; n
DIM liczby(n)
  t1 = TIMER
  liczby(1) = 0
  FOR i = 2 TO n
    liczby(i) = i
  NEXT i
  FOR i = 2 TO n
    IF liczby(i) <> 0 THEN
      PRINT i;
       FOR k = i + 1 TO n STEP i
        liczby(k) = 0
       NEXT k
    END IF
  NEXT i
  t2 = TIMER
  PRINT
  PRINT "Czas obliczen i wydruku w [sek] : "; t2 - t1
END

REM p39.bas
REM Wpisuje do 7 kolejnych stron a nastepnie wyswietla je na ekranie
DECLARE SUB czekaj ()
FOR i = 1 TO 7
SCREEN 7, , i, 0      ' Wybiera strone nr i
LOCATE 2 * i, 2 * i   ' ustala poloz. tekstu na ekranie
PRINT "Pisze na stronie "; i   ' wpisuje tekst do strony nr  i  video
FOR j = 1 TO 100: NEXT j
NEXT i
REM *** wyswietla kolejne strony
FOR i = 1 TO 7
FOR j = 1 TO 200: NEXT j    'powoduje opoznienie wyswietlania
SCREEN 7, , 0, i
NEXT i
REM **** Wyswietla w odwrotnej kolejnosci
FOR i = 7 TO 1 STEP -1  ' opoznienie
FOR j = 1 TO 200: NEXT j
SCREEN 7, , 0, i
NEXT i
END
' Komenda screen ma postac: SCREEN tryb%,kolor%,stronaaktywna%,stronaobraz%
' kolor% - 0 - mono, 1 - kolor
' stronaaktywna% - nr strony, do ktorej wpisujemy parametry obrazu
' stronaobrazowa% - nr strony, ktorej zawartosc jest wyswietlana na ekranie

REM P41.BAS  Nanoszenie pktow na ekran
REM  Wpisanie "999" konczy dzialanie programu
  SCREEN 1    ' rozdz. 320x200
10 LOCATE 1, 30
  PRINT "    "
  LOCATE 1, 4
  INPUT "Podaj x i y ; '999', konczy "; x, y
    IF x = 999 GOTO 20
    PSET (x, y)
      GOTO 10
20 END

REM p221.BAS
REM Petle DO
CLS 
k = 0
DO UNTIL k = 20
 k = k + 1
 PRINT k
LOOP
INPUT a$

CLS
k = 0
DO
 k = k + 1
 PRINT k
LOOP UNTIL k = 20



DECLARE FUNCTION znaki$ (a$)
REM p254.bas
REM Zamina liter – Funkcja znaki
CLS
INPUT "Podaj imie i nazwisko "; a$
PRINT
PRINT "Wczytalem", , a$
a$ = znaki$(a$)           ' funkcja znaki$ zamienia litery male na duze
PRINT
PRINT "Po wykonaniu zamiany liter", a$
END

FUNCTION znaki$ (a$)
ni = LEN(a$)
FOR i = 1 TO ni
b$ = MID$(a$, i)
nb = ASC(b$)
IF nb >= 97 AND nb <= 122 THEN
 MID$(a$, i) = CHR$(nb - 32)
END IF
100 NEXT i
znaki$ = a$
END FUNCTION

REM p255.bas
DECLARE FUNCTION sumprz (a, b, c)
CLS
INPUT "Podaj 3 liczby "; a, b, c
PRINT "Suma dlug. przek prostop a,b,c= "; sumprz(a, b, c)
PRINT "p1, p2, p3 (shared w function sumprz) "; p1; "  "; p2; "  "; p3
END

FUNCTION sumprz (a, b, c)
SHARED p1, p2, p3
p1 = SQR(a ^ 2 + b ^ 2)
p2 = SQR(b ^ 2 + c ^ 2)
p3 = SQR(a ^ 2 + c ^ 2)
sumprz = 2 * (p1 + p2 + p3)
END FUNCTION


REM p256.bas
REM Wykorzystanie definicji funkci: DEF FN_nazwafunckcji(parametry)
CLS
PRINT "Poczatek programu z DEF FNnazwa"
c = 12
d = 32
e = c * d
REM ***** Definicja funkcji
  DEF FNiloczyn (a, b) = (a + b) * (a ^ 2 + b ^ 2) * (a ^ 3 + b ^ 3)
REM ***** Koniec definicji funkcji
a = 3
b = 4
PRINT " DEF FNiloczyn (a, b) = (a + b) * (a ^ 2 + b ^ 2) * (a ^ 3 + b ^ 3)"
PRINT "FNiloczyn (3,4)="; FNiloczyn(a, b)
END



REM p257.bas
CLS
PRINT "Definicja funkcji przez: DEF FNnazwa...END DEF"

REM ***** defin. funkcji
  DEF fniloczyn (a, b)
  p1 = (a + b)
  p2 = (a ^ 2 + b ^ 2)
  p3 = (a ^ 3 + b ^ 3)
  fniloczyn = p1 * p2 * p3
  END DEF
REM ***** Koniec definicji funkcji

PRINT "DEF FNiloczyn (a,b) jak na str 256"
PRINT "FNiloczyn(3,4)="; fniloczyn(3, 4)



REM p261
REM Rozwiazanie rownania cos(x)-x=0
CLS
PRINT "Rozwiazanie rownania cos(x)-x=0"
x = .5
dx = .01
r = ABS(COS(x) - x)
licznik% = 0
t1 = TIMER
 DO WHILE x < 1
  str = r
  r = ABS(COS(x) - x)
    IF r > str THEN EXIT DO
   x = x + dx
   licznik% = licznik% + 1
 LOOP
t2 = TIMER
czas = t2 - t1
PRINT "Licznik, czas, x, r "
PRINT licznik%; czas; x, r

REM p262
INPUT "a, b, c "; a, b, c
del = b ^ 2 - 4 * a * c
IF del < 0 THEN END
PRINT (b - SQR(del)) / 2 / a, (b + SQR(del)) / 2 / a


REM p263
REM Program rozwiazuje rownanie kwadratowe
REM  a x^2 + b x  + c  =  0
REM del   wyznacznik rownania
REM  x1, x2  pierwiastki
REM  PODPROGRAMY
REM  dane()  czytania danych
REM  delta()  liczy del
REM  pierw()  oblicza x1, x2
REM  wyniki()  druk wynikow

REM PROGRAM GLOWNY
  DECLARE SUB dane (a, b, c)
  DECLARE SUB delta (a, b, c, del)
  DECLARE SUB pierw (a, b, sqrdel, x1, x2)
  DECLARE SUB wyniki (a, b, c, x1, x2)
start:
 CLS
 LOCATE 12, 20
 PRINT "Program rozwiazuje rownanie kwadratowe"
  LOCATE 14, 30
  PRINT "a*x^2+b*x+c=0"
  INPUT "START - Enter "; st$
  CALL dane(a, b, c)
  CALL delta(a, b, c, del)
    IF del < 0 THEN
       CLS
       LOCATE 10, 20
       PRINT "delta < 0,  nie ma rozwiazania "
       GOTO koniec
    END IF
  sqrdel = SQR(del)
  CALL pierw(a, b, sqrdel, x1, x2)
  CALL wyniki(a, b, c, x1, x2)
koniec:
  LOCATE 22, 50
  INPUT "Nastepne rownanie ?  T / N "; tn$
  IF tb$ = "T" OR tn$ = "t" THEN GOTO start
  END

 SUB dane (a, b, c)
   INPUT "a = "; a
   INPUT "b = "; b
   INPUT "c = "; c
END SUB

SUB delta (a, b, c, del)
  del = b ^ 2 - 4 * a * c
END SUB

SUB pierw (a, b, sqrdel, x1, x2)
  mian = 2 * a
  x1 = (-b - sqrdel) / mian
  x2 = (-b + sqrdel) / mian
END SUB

SUB wyniki (a, b, c, x1, x2)
  CLS
  LOCATE 6, 20
  PRINT "Rownanie "; a; "x^2 + "; b; "x + "; c; " =  0"
  LOCATE 8, 22
  PRINT " x1="; x1, "x2="; x2
END SUB


REM P268
' LOSOWANIE LICZB
DEFLNG A-Z
CLS
RANDOMIZE TIMER
INPUT "Ile rzutow "; n
l1 = 1
l2 = 2
l3 = 3
l4 = 4
l5 = 5
l6 = 6
  w1 = 0
  w2 = 0
  w3 = 0
  w4 = 0
  w5 = 0
  w6 = 0
FOR k = 1 TO n
  w = INT(RND * 6) + 1
  IF w = 1 THEN w1 = w1 + 1
  IF w = 2 THEN w2 = w2 + 1
  IF w = 3 THEN w3 = w3 + 1
  IF w = 4 THEN w4 = w4 + 1
  IF w = 5 THEN w5 = w5 + 1
  IF w = 6 THEN w6 = w6 + 1
NEXT k
PRINT n; " rzutow"
PRINT "Liczby wylosowane ";
PRINT USING "########"; l1; l2; l3; l4; l5; l6
PRINT "Ilosc liczb       ";
PRINT USING "########"; w1; w2; w3; w4; w5; w6

REM P271
REM Program znajduje liczby pierwsze z przedzialu 1 do 1000
REM meoda prymitywna
CLS
PRINT "Liczby pierwsze 1..1000"
INPUT "Ile liczb przeszukiwac "; n
FOR lb = 2 TO n
  FOR k = 2 TO lb - 1
   IF lb \ k = lb / k THEN GOTO 10'sprawdza podzielnosc
  NEXT k
  PRINT lb;
10 NEXT lb

REM P271
REM Program do robienia spisu nazwisk, zapisu ich na dysk do zbioru
REM i odczytu ze zbioru
CLS
INPUT "Podaj przewidywana ilosc osob do wczytywania (>=fakt) "; ilosc
' Np ilosc = 40   'ilosc nazwisk
DIM tablnazw$(ilosc) ' deklaracja tablicy na dane
FOR i = 1 TO ilosc
INPUT "Imie i nazwisko ( Xxx - koniec) "; imnazw$  'wczytywanie danych
IF imnazw$ = "Xxx" GOTO 50
tablnazw$(i) = imnazw$
NEXT i
50 lbn = i - 1  'ilosc danych wczytanych
PRINT
 INPUT "Podaj nazwe zbioru 1 "; nazwzb1$
 OPEN nazwzb1$ FOR OUTPUT AS #1
 FOR i = 1 TO lbn
 PRINT #1, tablnazw$(i)
 NEXT i
 CLOSE #1
REM Odczytanie tresci zbioru
 OPEN nazwzb1$ FOR INPUT AS 3
 FOR i = 1 TO lbn
  INPUT #3, tablnazw$(i)
  NEXT i
  CLOSE #3
REM wydruk zbioru
  FOR i = 1 TO lbn
  PRINT tablnazw$(i)
  NEXT i
  END


REM P278
REM Program do robienia spisu nazwisk, zapisu ich na dysk do zbioru
REM i odczytu ze zbioru
CLS
INPUT "Podaj przewidywana ilosc osob do wczytywania (>=fakt) "; ilosc
' Np ilosc = 40   'ilosc nazwisk
DIM tablnazw$(ilosc) ' deklaracja tablicy na dane
FOR i = 1 TO ilosc
INPUT "Imie i nazwisko ( Xxx - koniec) "; imnazw$  'wczytywanie danych
IF imnazw$ = "Xxx" GOTO 50
tablnazw$(i) = imnazw$
NEXT i
50 lbn = i - 1  'ilosc danych wczytanych
PRINT
 INPUT "Podaj nazwe zbioru 1 "; nazwzb1$
 OPEN nazwzb1$ FOR OUTPUT AS #1
 FOR i = 1 TO lbn
 PRINT #1, tablnazw$(i)
 NEXT i
 CLOSE #1
REM Odczytanie tresci zbioru
 OPEN nazwzb1$ FOR INPUT AS 3
 FOR i = 1 TO lbn
  INPUT #3, tablnazw$(i)
  NEXT i
  CLOSE #3
REM wydruk zbioru
  FOR i = 1 TO lbn
  PRINT tablnazw$(i)
  NEXT i
  END

REM P280
REM zakladanie zbioru
CLS
PRINT "Zakladanie zbioru, przegladanie zbiorow, zmiana nazwy zbioru"
PRINT
INPUT "Nazwa zbioru do zalozenia :"; zb1$
OPEN zb1$ FOR OUTPUT AS #1
PRINT #1, "Tresc tego zbioru nie ma znaczenia"
CLOSE #1
CLS
PRINT "Listowanie katalogu biezacego - FILES - odpowiednik DIR "
PRINT
FILES
PRINT
INPUT "Ktory naped obejrzec <Enter> - katalog biezacy "; nap$
FILES nap$
INPUT "nazwa zbioru po przemianowaniu "; zb2$
NAME zb1$ AS zb2$
PRINT
PRINT SPACE$(20); "Po zmianie nazwy zbioru "
FILES
INPUT "Nacisnij Enter "; e$
CLS

REM P281
CLS
PRINT "Sprawdzenia dzialania instrukcji APPEND - dopisywanie do zbioru"
PRINT
CLS
OPEN "zb1.tst" FOR OUTPUT AS #1
  PRINT "Otwierzylem do zapisu zbior 'zb1.tst'"
  PRINT
  INPUT "Podaj slowo1 do zapisu w zbiorze "; a$
  PRINT #1, a$
  PRINT "Zapisalem do zbioru 'zb1.tst' napis :  "; a$
CLOSE #1
PRINT
 PRINT "Zamknalem zbior"

 PRINT
OPEN "zb1.tst" FOR APPEND AS #1
  PRINT "Otworzylem zbior zb1.tst w trybie APPEND - mozna dopisywac "
  PRINT
  INPUT "Podaj slowo2 do dodania do zbioru"; b$
  PRINT #1, b$
  PRINT "Zapisalem do zbioru <zb1.tst>  slowo:  "; b$
CLOSE #1
 PRINT
 PRINT "Zamknalem zbior "
PRINT
 
 PRINT "Otwieram zbior do czytania i czytam z niego"
OPEN "zb1.tst" FOR INPUT AS #1
 INPUT #1, c$, d$
 PRINT c$, d$
CLOSE #1
PRINT
PRINT "Zamknalem zbior"
PRINT
INPUT "Nacisnij Enter "; a$
CLS

REM P282
REM Zapis i odczyt ze zbioru
CLS
OPEN "zb2.tst" FOR OUTPUT AS #1
  zn1$ = "abcdefghij"
  zn2$ = "12345"
  zn3$ = "A"
   PRINT #1, zn1$
   PRINT #1, zn2$
   PRINT #1, zn3$
CLOSE #1

OPEN "zb2.tst" FOR INPUT AS #7
 INPUT #7, a$, b$, c$
 CLOSE #7
PRINT "a$= "; a$, "b$= "; b$, "c$="; c$


REM P284
REM Zamiana malych liter na duze
CLS
PRINT "Program zamienia male litery na duze"
PRINT
INPUT "Podaj zdanie lub slowo "; a$
ni = LEN(a$)

FOR i = 1 TO ni
 b$ = MID$(a$, i)
 nb = ASC(b$)
 IF nb >= 97 AND nb < 122 THEN
 MID$(a$, i) = CHR$(nb - 32)
 ' PRINT a$
 END IF
100 NEXT i

PRINT a$


REM P285
REM Zamiana malych liter na duze – plik danych i wynikow
CLS
PRINT "Program zamienia male litery na duze"
PRINT
INPUT "Nazwa pliku danych  "; f1$
INPUT "Nazwa pliku wynikow "; f2$
OPEN f1$ FOR INPUT AS #1
OPEN f2$ FOR OUTPUT AS #2
WHILE NOT EOF(1)
LINE INPUT #1, a$
ni = LEN(a$)

FOR i = 1 TO ni
 b$ = MID$(a$, i)
 nb = ASC(b$)
 IF nb >= 97 AND nb < 122 THEN
 MID$(a$, i) = CHR$(nb - 32)
 ' PRINT a$
 END IF
100 NEXT i
PRINT #2, a$
PRINT a$
WEND
CLOSE #1
CLOSE #2