home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / internet / Jeremy / tp / downloads / aplikace.pas next >
Pascal/Delphi Source File  |  1999-08-03  |  8KB  |  303 lines
  1. Unit Aplikace;
  2. interface
  3.  
  4.  type AppData = record
  5.                 Jmeno,
  6.                 Verze,
  7.                 Datum,
  8.                 Autor,
  9.                 Cislo: string;
  10.                 end;
  11.  
  12.  var AFiles: array [1..20] of string;
  13.      ARunOK: boolean;
  14.      Direct: word;
  15.  const
  16.       ARMode=true;
  17.       ANMode=false;
  18.  
  19.       AContinue = 1;
  20.       AQuit = 2;
  21.       AReboot = 3;
  22.       AShell = 4;
  23.  
  24.       CloseQ = true;
  25.       CloseN = false;
  26.  
  27.  procedure InitApplication(A:AppData; ATypMode: boolean);
  28.  function CloseApplication(Typ: boolean): word;
  29.  procedure AReadData(AJmeno,AVerze,ADatum,AAutor,ACislo: string; Var B:AppData);
  30.  
  31. implementation
  32.  uses crt,dos,savewind,csmon,vstupy,okna;
  33.  
  34.  var
  35.       ADeskB,ADeskW,ADeskG,ATitle,ADefault,AButton: byte;
  36.       boxscreen: pbuf;
  37.  const
  38.       AFCount: byte = 0;
  39.       AWidth: byte = 0;
  40.  
  41.  var
  42.     dosscreen, appscreen:pbuf;
  43.     dosx, dosy, dosmode: byte;
  44.     DirInfo: SearchRec;
  45.     Amode: boolean;
  46.     AChar: char;
  47.     AName: string;
  48.     Aattr: byte;
  49.  
  50. function GetTextMode: byte;
  51. var m: byte absolute $0000:$0449;
  52. begin
  53.      GetTextMode:=m;
  54. end;
  55.  
  56. procedure CenterEditData(A: AppData);
  57. var Q: byte;
  58.     I: integer;
  59. begin
  60.      Q:=0;
  61.      Q:=Ord(A.Jmeno[0]);
  62.      if Q<Ord(A.Verze[0]) then Q:=Ord(A.Verze[0]);
  63.      if Q<Ord(A.Datum[0]) then Q:=Ord(A.Datum[0]);
  64.      if Q<Ord(A.Autor[0]) then Q:=Ord(A.Autor[0]);
  65.      if Q<Ord(A.Cislo[0]) then Q:=Ord(A.Cislo[0]);
  66.      AWidth:=Q;
  67.      for I:=1 to (AWidth-Length(A.Jmeno)) div 2 do
  68.          A.Jmeno:=concat(' ',A.Jmeno);
  69.      for I:=1 to (AWidth-Length(A.Verze)) div 2 do
  70.          A.Verze:=concat(' ',A.Verze);
  71.      for I:=1 to (AWidth-Length(A.Datum)) div 2 do
  72.          A.Datum:=concat(' ',A.Datum);
  73.      for I:=1 to (AWidth-Length(A.Autor)) div 2 do
  74.          A.Autor:=concat(' ',A.Autor);
  75.      for I:=1 to (AWidth-Length(A.Cislo)) div 2 do
  76.          A.Cislo:=concat(' ',A.Cislo);
  77. end;
  78.  
  79. procedure ADeskTop(Name: string);
  80. var I: byte;
  81. begin
  82.      window(1,1,80,25);
  83.      textattr:=ADeskW;
  84.      clrscr;
  85.      gotoxy(2,1); write('┌');
  86.      for I:=3 to 78 do
  87.       begin
  88.            gotoxy(i,1);
  89.            write('─');
  90.       end;
  91.      textattr:=ADeskB;
  92.      gotoxy(79,1); write('┐');
  93.      textattr:=ADeskW;
  94.      for I:=2 to 24 do
  95.       begin
  96.            gotoxy(2,i);
  97.            write('│');
  98.      end;
  99.      gotoxy(2,25);
  100.      write('└');
  101.      textattr:=ADeskB;
  102.      for I:=2 to 24 do
  103.       begin
  104.            gotoxy(79,i);
  105.            write('│');
  106.       end;
  107.      for I:=3 to 78 do
  108.       begin
  109.            gotoxy(i,25);
  110.            write('─');
  111.       end;
  112.      write('┘');
  113.  
  114.     gotoxy(3,22); textattr:=ADeskB; write('┌');
  115.     for I:=4 to 77 do
  116.     begin
  117.     gotoxy(i,22);
  118.     write('─');
  119.     end;
  120.     gotoxy(3,23); write('│');
  121.     gotoxy(3,24); write('└');
  122.  
  123.     gotoxy(78,22); textattr:=ADeskW; write('┐');
  124.  
  125.     for I:=4 to 77 do
  126.     begin
  127.          gotoxy(i,24);
  128.          write('─');
  129.     end;
  130.     write('┘');
  131.     gotoxy(78,23); write('│');
  132.  
  133.      textattr:=ATitle;
  134.      gotoxy(39-(Length(Name) div 2),1);
  135.      write(' ',Name,' ');
  136. end;
  137.  
  138. procedure EntryBox(B: AppData);
  139. var I: integer;
  140.     a,c: integer;
  141. begin
  142.      CenterEditData(b);
  143.      {savewin(39-(AWidth div 2),8,39-(Awidth div 2)+AWidth+1,18,boxscreen);}
  144.      textattr:=ADeskG;
  145.      savewin(3,8,77,18,boxscreen);
  146.      gotoxy(39-(AWidth div 2),8);
  147.      textattr:=ADeskB;
  148.      write('┌');
  149.      for I:=39-(Awidth div 2)+1 to 39-(AWidth div 2)+AWidth do
  150.       begin
  151.            gotoxy(i,8);
  152.            write('─');
  153.       end;
  154.      textattr:=ADeskW;
  155.      gotoxy(39-(AWidth div 2)+AWidth+1,8);
  156.      write('┐');
  157.      textattr:=ADeskB;
  158.      for I:=9 to 17 do
  159.       begin
  160.            gotoxy(39-(AWidth div 2),i);
  161.            write('│');
  162.       end;
  163.      textattr:=ADeskW;
  164.      for I:=9 to 17 do
  165.       begin
  166.            gotoxy((39-AWidth div 2)+AWidth+1,i);
  167.            write('│');
  168.       end;
  169.      gotoxy(39-(Awidth div 2),18);
  170.      textattr:=ADeskB;
  171.      write('└');
  172.      textattr:=ADeskW;
  173.      for I:=39-(AWidth div 2)+1 to 39-(AWidth div 2)+Awidth do
  174.       begin
  175.            gotoxy(i,18);
  176.            write('─');
  177.       end;
  178.      write('┘');
  179.      a:=(AWidth div 2)+(AWidth mod 2);
  180.      textattr:=ADeskG;
  181.      gotoxy(39-(Awidth div 2)+1+(Awidth-(Length(B.Jmeno) div 2))-a,9); write(B.Jmeno);
  182.      gotoxy(39-(Awidth div 2)+1+(Awidth-(Length(B.verze) div 2))-a,10); write(B.Verze);
  183.      gotoxy(39-(Awidth div 2)+1+(Awidth-(Length(B.datum) div 2))-a,11); write(B.Datum);
  184.      gotoxy(39-(Awidth div 2)+1,12);
  185.       for I:=1 to Awidth do write(' ');
  186.      gotoxy(39-(Awidth div 2)+1+(Awidth-(Length(B.autor) div 2))-a,13); write(B.Autor);
  187.      gotoxy(39-(Awidth div 2)+1+(Awidth-(Length(B.cislo) div 2))-a,14); write(B.Cislo);
  188.  
  189.      gotoxy(38,16);
  190.      textattr:=AButton;
  191.      write(' OK ');
  192.      textattr:=ADeskB;
  193.      gotoxy(39,17); write('▀▀▀▀');
  194.      gotoxy(42,16); write('▄');
  195.  
  196.      gotoxy(4,23);
  197.      textattr:=ADeskG;
  198.      write(' Vítejte v aplikaci ...');
  199.      getkey;
  200.  
  201.      {restorewin(39-(AWidth div 2),8,39-(Awidth div 2)+AWidth+1,18,boxscreen);}
  202.      restorewin(3,8,77,18,boxscreen);
  203. end;
  204.  
  205. procedure AReadData(AJmeno,AVerze,ADatum,AAutor,ACislo: string; Var B:AppData);
  206. begin
  207.      B.Jmeno:=AJmeno;
  208.      B.Verze:=AVerze;
  209.      B.Datum:=ADatum;
  210.      B.Autor:=AAutor;
  211.      B.Cislo:=ACislo;
  212. end;
  213.  
  214. function ControlFiles: boolean;
  215. var I: integer;
  216. begin
  217.      for I:=1 to AFCount do
  218.       begin
  219.            FindFirst(AFiles[i],Archive,DirInfo);
  220.            if doserror<>0 then
  221.             begin
  222.                  ControlFiles:=false;
  223.                  exit;
  224.             end;
  225.       end;
  226.      ControlFiles:=true;
  227. end;
  228.  
  229. procedure NastavBlikani(Blik : Boolean);
  230. var Reg : Registers;
  231. begin
  232.    Reg.AH := $0010;
  233.    Reg.AL := $0003;
  234.    If Blik then Reg.BL := 1 else Reg.BL := 0;
  235.    Intr($10, Reg);
  236. end;
  237.  
  238. function CloseApplication(Typ: boolean): word;
  239. var I,J: integer;
  240.     akce: word;
  241.     vseg: word;
  242.     w: word;
  243. begin
  244.      savewin(1,1,80,25,appscreen);
  245.      textattr:=ADefault;
  246.      gotoxy(4,23); write('                        Ukonçení práce s aplikací ...                    ');
  247.  
  248.      window(1,1,80,25);
  249.      textattr:=16*black+white;
  250.      lowvideo;
  251.      clrscr;
  252.      if AMode then textmode(dosmode);
  253.      obnovkursor;
  254.      UnLoadChar;
  255.      restorewin(1,1,80,25,dosscreen);
  256.      gotoxy(dosx,dosy);
  257.      NastavBarvu(CtiPaletu(6),Stand[6]);
  258.      NastavBlikani(true);
  259.      ARunOK:=false;
  260. end;
  261.  
  262. procedure InitApplication(A:AppData;ATypMode: boolean);
  263. begin
  264.      dosx:=wherex;
  265.      dosy:=wherey;
  266.      dosmode:=getTextMode;
  267.      Amode:=ATypMode;
  268.      AName:=A.Jmeno;
  269.      savewin(1,1,80,25,dosscreen);
  270.      skryjkursor;
  271.      LoadChar;
  272.      NastavBlikani(false);
  273.      ADeskTop(AName);
  274.      EntryBox(A);
  275.      if controlfiles=false then
  276.       begin
  277.            write(#7);
  278.            CloseApplication(CloseN);
  279.       end
  280.      else ARunOK:=true;
  281. end;
  282.  
  283. BEGIN
  284.      checkbreak:=false;
  285.      if GetTextMode=7 then {barvy pro Hercules}
  286.        begin
  287.             ADeskB:=16*lightgray+black;
  288.             ADeskW:=16*lightgray+black;
  289.             ADeskG:=16*lightgray+black;
  290.             ATitle:=16*lightgray+black;
  291.             ADefault:=16*black+lightgray;
  292.             AButton:=16*black+white;
  293.        end
  294.       else
  295.           begin {barvy pro barevny EGA/VGA}
  296.                 ADeskB:=16*lightgray+black;
  297.                 ADeskW:=16*lightgray+white;
  298.                 ADeskG:=16*lightgray+darkgray;
  299.                 ATitle:=16*lightgray+blue;
  300.                 ADefault:=16*lightgray+darkgray;
  301.                 AButton:=16*blue+yellow;
  302.           end;
  303. END.