erase
clear
clear gets
set escape on
set talk off
set raw off
text
  CelÙ program se sklÁdÁ jen z jednoho souboru CMD, vÓe ostatnÉ se

  vytvoÒÉ automaticky. Pro sprÁvnou  funkci je vÓak nutno pracovat

  korektnÅ. Program je psÁn pro RAMDISK, ale nenÉ to podmÉnkou. RD

  zÁlohovanÙ i nezÁlohovanÙ si umÉ zjistit. Pokud  je RD pÒÉtomen,

  vÓechny vÙsledky  se automaticky uklÁdajÉ na nÅj, i kdyÚ program

  sÁm je spuÓtÅn z jin×ho disku. PÒi nepÒÉtomnosti RD  se  veÓker× 

  vÙsledky uklÁdajÉ na disk, z kter×ho byl spuÓtÅn program AR.CMD.

  Program  si  ale  neumÉ hlÉdat kapacitu disku, proto je nutn× si

  dostatek voln×ho mÉsta zajistit pÒedem.

  NynÉ si otestuji TvÊj syst×m a moÚnÁ Ti dÁm nÅjak× otÁzky.

                                                 MÅj tedy strpenÉ.

    PÒepracoval: M.UrbÁnek,Brno       ZmÁÃkni cokoliv.......
endtext
@ 22,0
set console off
wait
set console on
erase
store F to RAMDISK
store peek(59967) to RD
if RD>0 .and. RD<=64
store T to RAMDISK
endif

store T to INIT
store 'AR' to DISKAR
 do while INIT
 store file ('&DISKAR') to TESTAR
  if TESTAR
  store F to INIT
  else
  erase
   store ' ' to DISK 
   @ 3,3 say 'NenaÓel jsem na disku soubor AR.DBF, potÒebuji vÅdÅt'
   @ 5,3 say 'na kter×m disku se nachÁzÉ !!!' 
   @ 8,3 say 'Zadej nÁzev disku s tÉmto prg. (A - E) ' get DISK picture;
   'A'
   read
   store !(DISK)+':AR' to DISKAR
   loop
   endif
 enddo    
 
  if RAMDISK
  store 'E:ARP' to PARP
  store 'E:ARV' to PARV
  store 'E:ARD' to PARD
  store 'E:AR' to MAR
  store 'ramdisk' to TEXT
  else 
  store 'ARP' to PARP
  store 'ARV' to PARV
  store 'ARD' to PARD
  store 'AR' to MAR
  store 'disk' to TEXT
  endif

 use &DISKAR
 copy structure to &PARP
 use

  If .NOT. file('&MAR'+'MEM')
  store '(!(trim(KNazev)) $ !(Nazev))' to P1
  store '(Cislo = val(KCislo))'        to P2
  store '(Rok = val(KRok))'            to P3
  save to &MAR
  endif
 set colon off
 store ' ' to VOLBA
 store 0 to POCETVET
 store 0 to ZRUS
do while VOLBA <> '6'
   erase
text

                   PÒehled ÃlÁnkÊ Ãasopisu Amat×rsk× rÁdio
                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



                         1 - VÙbÅr podle klÉÃe

                         2 - ProhlÉÚenÉ vybranÙch vÅt

                         3 - ZruÓenÉ oznaÃenÙch vÅt

                         4 - VytvoÒenÉ tisk. souboru

                         5 - DoplÎovÁnÉ evidence

                         6 - Konec prÁce
endtext
   @ 0,0
   set console off
   wait to VOLBA
   set console on
   do case
      case VOLBA = '1'
           erase
           use &PARP
           copy stru to &PARV
           use &PARV
           restore from &MAR additive
           store '                                        ' to KNazev
           store '  '                                       to KCislo
           store '  '                                       to KRok
           store ' '                                        to Podminka
           set colon on
           @  1,28 say 'Zadej klÉÃ pro vyhledÁvÁnÉ'
           @  2,28 say '~~~~~~~~~~~~~~~~~~~~~~~~~~'
           @  7,15 say 'NÁzev '
           @  7,22 get KNazev
           @  9,15 say 'ãÉslo '
           @  9,22 get KCislo
           @ 11,15 say 'Rok   '
           @ 11,22 get KRok
           read
           set colon off
           if KNazev <> '                                        '
            store P1 to Podminka
           endif
           if KCislo <> '  '
            if Podminka = ' '
             store P2 to Podminka
            else
             store Podminka + ' .AND. ' + P2 to Podminka
            endif
           endif
            if KRok <> '  '
             if Podminka = ' '
              store P3 to Podminka
             else
              store Podminka + ' .AND. ' + P3 to Podminka
             endif
            endif

             if Podminka <> ' '
              store '(' + Podminka + ')' to Podminka
              erase
              text

                *******************************************
                *                                         *
                *  ãekejte, prosÉm, prohledÁvÁm databÁzi  *
                *                                         *
                *******************************************
              endtext
              @ 0,0
              append from &DISKAR for &Podminka
             count to pocetvet
             use
            endif
      case VOLBA = '2'
           erase
           if POCETVET = 0
            @ 6,10 say 'Lituji, ale nebyla vybrÁna ÚÁdnÁ vÅta !'
            @ 13,37 say 'ZmÁÃkni cokoliv....'
            set console off
            @ 0,0
            wait
            set console on
            loop
           endif 
           use &PARV
           go top
           browse
           count for * to ZRUS
           use
      case VOLBA = '3'
           erase
           if ZRUS = 0
            @ 5,10 say 'Nebyla oznaÃena ÚÁdnÁ vÅta ke zruÓenÉ !!!'
           else
            @ 5,10 say 'Pocet vÅt urÃenÙch ke zruÓenÉ je '+str(ZRUS,4)+' !!!'
            use &PARV
            pack
            use
           endif
           @ 13,37 say 'ZmÁÃkni cokoliv.....'
           @ 0,0 
           set console off
           wait
           set console on
      case VOLBA = '4'
           erase
           if POCETVET = 0
            @ 6,10 say 'Lituji, ale nebyla vybrÁna ÚÁdnÁ vÅta !'
            @ 13,37 say 'ZmÁÃkni cokoliv....'
            set console off
            @ 0,0
            wait
            set console on
            loop
           endif
           store 'AR      ' to TISKSOUB
           use &PARV
           go top
           erase
           @ 1,6 say 'VÙslednÙ soubor uloÚÉm na '+trim(TEXT)+' pod nÁzvem ';
+trim(Tisksoub)+'.TXT'
            store 'A' to ODP
            @ 3,6 say "ChceÓ zmÅnit jeho nÁzev ? (A/ )"
            @ 3,38 get ODP picture '!'
            read
             if ODP ='A' 
              @ 8,0        
              ? 'Zde je adresÁÒ disku :'
              ? '~~~~~~~~~~~~~~~~~~~~~~'
               if RAMDISK
                disp file like *.txt on E:
               else
                disp file like *.txt
               endif
              store '        ' to Tisksoub
              set colon on
              store T to TEST
               do while TEST
                @ 5,6 say '                                               '
                @ 5,6 say 'NovÙ nÁzev souboru bude - 'get Tisksoub picture;
'!!!!!!!!'
                read
                 if rank(TISKSOUB) < 65 .or. rank(TISKSOUB) > 90
                  loop
                 endif
                store F to TEST
               enddo
             set colon off
            endif
           erase
            if RAMDISK
             stor 'E:'+trim(TISKSOUB) to ZTISKSOUB
            else
             store trim(TISKSOUB) to ZTISKSOUB
            endif
           set alternate to &ZTISKSOUB
           set alternate on
           text
============================================================================
NÁzev                                                        AR  Ã. rok  str
============================================================================
           endtext
           list off
           text
============================================================================
           endtext
           set alternate off
           set alternate to
           erase
@  4,8  say '*****************************************************************'
@  5,8  say '*                                                               *'
@  6,8  say '*          VÙslednÙ tiskovÙ soubor je uloÚen pod nÁzvem         *'
@  7,8  say '*                                                               *'
@  8,8  say '*'
           if RAMDISK
@  8,20 say trim(TISKSOUB)+'.TXT na ramdisk !!!!'
           else
@  8,20 say trim(TISKSOUB)+'.TXT na implicitnÉ disk !!!!'
           endif
@  8,72 say '*'
@  9,8  say '*                                                               *'
@ 10,8  say '*     Je moÚn× ho vytisknout v jak×mkoliv textov×m editoru.     *'
@ 11,8  say '*                                                               *'
@ 12,8  say '*****************************************************************'
@ 16,37 say 'Stiskni libovolnou klÁvesu..... '
           @ 0,0
           set console off
           wait
           set console on
           use
      case VOLBA = '5'
           if DATE() ='00/00/00'
           store DATE() to DDATE
           erase	
@  5, 0 say "+----------------------------------------------------------------------+"
@  6, 0 say ". JelikoÚ nÁÓ SHARPIK si nemÊÚe pamatovat datum, je pro potÒeby tohoto ."
@  7, 0 say ".                                                                      ."
@  8, 0 say ". programu tÒeba jej zadat. Vstup je oÓetÒen tak, aby nebylo moÚn× za- ."
@  9, 0 say ".                                                                      ."
@ 10, 0 say ". dat nesmysln× datum (dny - mÅsÉce). Rok snad uÚ kaÚdÙ zadÁ sprÁvnÅ.  ."
@ 11, 0 say "+----------------------------------------------------------------------+"
           @ 14, 4 say"Zadej tedy sprÁvn× dneÓnÉ datum (dd/mm/rr):"
           @ 14,49 get DDATE picture '99/99/99'
           READ
           if VAL($(DDATE,4,2)) = 0 .OR. VAL($(DDATE,4,2)) > 12
           ?? chr(7)
           @ 17,15 say "No tak to snad ne !!!"
           @ 0,0
           store 20 to TIME
            do while TIME > 0
            store TIME - 1 to TIME
            enddo
           loop
           endif
           if VAL($(DDATE,4,2)) = 2 
            if VAL($(DDATE,1,2))= 0 .OR. VAL($(DDATE,1,2)) > 29
            ?? chr(7)
             @ 17,15 say "No tak to snad ne !!!"
             @ 0,0
             store 20 to TIME
              do while TIME > 0
              store TIME - 1 to TIME
              enddo
             loop
            endif
           endif
           if VAL($(DDATE,4,2)) = 4 .OR. VAL($(DDATE,4,2)) = 6;
.OR. VAL($(DDATE,4,2)) = 9.OR. VAL($(DDATE,4,2)) = 11
            if VAL($(DDATE,1,2)) = 0 .OR. VAL($(DDATE,1,2)) > 30
             ?? chr(7)
             @ 17,15 say "No tak to snad ne !!!"
             @ 0,0
             store 20 to TIME
              do while TIME > 0
              store TIME - 1 to TIME
              enddo
             loop
             endif 
            endif
            if VAL($(DDATE,4,2)) = 1 .OR. VAL($(DDATE,4,2)) = 3;
.OR. VAL($(DDATE,4,2)) = 5 .OR. VAL($(DDATE,4,2)) = 7;
.OR. VAL($(DDATE,4,2)) = 8 .OR. VAL($(DDATE,4,2)) = 10;
.OR. VAL($(DDATE,4,2)) = 12
             if VAL($(DDATE,1,2)) = 0 .OR. VAL($(DDATE,1,2)) > 31
              ?? chr(7)
              @ 17,15 say "No tak to snad ne !!!"
              @ 0,0
              store 20 to TIME
               do while TIME > 0
               store TIME - 1 to TIME
               enddo
              loop
              endif 
             endif
            set date to &DDATE
           endif
           erase
           use &PARP
           copy structure to &PARD
           use &PARD
           store F to OPRAVIT
           store F to DOPACK
           store T to CYKL
           do while CYKL
            if .NOT. OPRAVIT
             append blank
            endif
            store F to OPRAVIT
            erase
            set colon on
            @  2,18 say "Funkce 5 - zadÁvÁnÉ novÙch ÕdajÊ"
            @  3,17 say "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
            @  5, 2 say "NÁzev ÃlÁnku :"
            @  7, 5 get NAZEV
            @  9, 2 say "Typ AR :"
            @  9,22 get AR picture 'AA'
            @ 11, 2 say "ãÉslo AR :"
            @ 11,22 get CISLO
            @ 13, 2 say "RoÃnÉk :"
            @ 13,22 get ROK
            @ 15, 2 say "ãÉslo strÁnky AR :"
            @ 15,22 get STRANA
            set colon off
            read
            replace AR with !(AR)
            store "3" to MENU
            @ 21,1 say "1 - opravit   2 - vymazat   3 - zapsat"
            @ 23,1 say 'odpovÅÄ  ' get MENU pictu "9"
            read
             do case
              case MENU ="1"
                   store T to OPRAVIT
                   loop
              case MENU="2"
                   store T to DOPACK
                   delete
              endcase
            erase
            store 'A' to VKLAD
            @ 20,15 say 'DalÓÉ data ? (A/ ) 'get VKLAD picture '!'
            read
             if VKLAD = 'A'
              loop
             else
              store F to CYKL
             endif
           enddo
            if DOPACK 
             erase
             @ 3,10 say 'TeÄ budu mazat to, co jsi zvrznul....'
             @ 5,1 
             display all for * off
             pack
             store 20 to TIME
             do while TIME >0
              store TIME - 1 to TIME
             enddo       
            endif
           count all to ZAPIS
            if ZAPIS > 0
             erase
             @  6,6 say 'A nynÉ pÒipojÉm vÓechny vÅty, kter× jsi  prÁvÅ pracnÅ'
             @  8,6 say 'naÔukal do sv×ho SHARPIKA, k zÁkladnÉ databÁzi AR.DBF'
             @ 10,6 say 'Je jich celkem '+str(ZAPIS,5)+'.'
             @ 12,6 say 'AÚ budu hotov, dÁm Ti vÅdÅt klasickou zprÁvou !!!' 
             use &DISKAR
             append from &PARD
             use
            else 
             erase
             @ 12,6 say 'To tedy byl zase jednou vÙkon !!!!   F U J .'
             use
            endif
           @ 16,37 say 'ZmÁÃkni cokoliv .........'
           @ 0,0         
           set console off
           wait
           set console on
      case VOLBA = '6'
           erase
           store '&MAR'+'.mem' to MAR
           delete file &MAR
           delete file &PARP
            if file ('&PARV')
            delete file &PARV
            endif 
            if file ('&PARD')
            delete file &PARD
            endif
            release all

           *disp memo
           set talk on
           set colon on
           set raw on
           *cancel
           quit
   endcase
enddo