PROGRAMY W 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