home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / os2 / datofunk.zip / KALENDER.PAS < prev   
Pascal/Delphi Source File  |  1994-01-23  |  2KB  |  70 lines
  1. program kalender;
  2. {****************************************************************************}
  3. {* KALENDER - Demonstration af DATOFUNK.TPU - Tool for datoberegning        *}
  4. {*            23.1.94/HK                                                    *}
  5. {****************************************************************************}
  6.  
  7. uses
  8.   datofunk,crt;
  9.  
  10. var
  11.   firstdag: dagnrt;
  12.   key: char;
  13.  
  14. procedure showcal(fra: dagnrt);
  15.  
  16. var
  17.   i: longint;
  18.  
  19. begin{showcal}
  20.   gotoxy(1,5);
  21.   writeln(copy(dato(fra),5,2),'.',copy(dato(fra),1,4));
  22.   writeln('Uge  Man Tir Ons Tor Fre L¢r S¢n');
  23.   write('--------------------------------');
  24.   if fra mod 7 <> 1 then begin
  25.     writeln;
  26.     write(uge(fra):3,'  ');
  27.     for i:=1 to (fra-1) mod 7 do write('    ');
  28.   end;
  29.   i:=fra;
  30.   while copy(dato(fra),1,6)=copy(dato(i),1,6) do begin
  31.     if i mod 7=1 then begin
  32.       writeln;
  33.       write(uge(i):3,'  ');
  34.     end{if};
  35.     if arbejdsdag(i) then write(' ') else write('*');
  36.     write(copy(dato(i),7,2),' ');
  37.     inc(i);
  38.   end{while};
  39.   clreol; writeln;
  40.   writeln('--------------------------------'); clreol;
  41.   writeln; clreol;
  42. end{showcal};
  43.  
  44. begin{kalender}
  45.   clrscr;
  46.   writeln;
  47.   writeln('Kalender. Demo af DATOFUNK.TPU. 22.1.94/HK');
  48.   writeln('Tryk PgUp/PgDn. Esc for slut');
  49.   writeln;
  50.   firstdag:=dag(copy(dato(idag),1,6)+'01');
  51.   showcal(firstdag);
  52.   repeat
  53.     key:=#0;
  54.     if keypressed then begin
  55.       key:=readkey;
  56.       case key of
  57.         'Q':
  58.           begin
  59.             firstdag:=dag(copy(dato(firstdag+40),1,6)+'01');
  60.             showcal(firstdag);
  61.           end;
  62.         'I':
  63.           begin
  64.             firstdag:=dag(copy(dato(firstdag-5),1,6)+'01');
  65.             showcal(firstdag);
  66.           end;
  67.       end{case};
  68.     end{if};
  69.   until key=#27;
  70. end{kalender}.