home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / internet / Jeremy / tp / downloads / inpdlgs.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-03  |  4KB  |  156 lines
  1. Unit InpDlgs;
  2. interface
  3.  
  4.  var stritem : array [1..10] of string;
  5.  
  6.      StrData: array [1..10] of record
  7.                             Title: string;
  8.                             InfoText: string;
  9.                             SDelka: byte;
  10.                             end;
  11.      INResult: boolean;
  12.  
  13.  procedure ReadStrItems(SITitle, infotxt: string; delka: byte);
  14.  procedure InputBox(x,y: byte; Title: string);
  15.  
  16. implementation
  17.  uses crt, okna, vstupy, savewind;
  18.  
  19.  var SICount: byte;
  20.      Stbuf: pbuf;
  21.  
  22. procedure ReadStrItems(SITitle, infotxt: string; delka: byte);
  23. begin
  24.      SICount:=SICount+1;
  25.      StrData[SICount].Title:=SITitle;
  26.      StrData[SICount].InfoText:=Infotxt;
  27.      StrData[SICount].SDelka:=Delka;
  28. end;
  29.  
  30. procedure INul;
  31. begin
  32.      SICount:=0;
  33. end;
  34.  
  35. procedure InputBox(x, y: byte; Title: string);
  36. label 1;
  37. const IB_OK=1;
  38.       IB_Opr=2;
  39.       IB_Esc=3;
  40. var I,P,Q: byte;
  41.     poms: string;
  42.     BLast, BPos: byte;
  43.     key: char;
  44. begin
  45. 1:   P:=0;
  46.      for I:=1 to SICount do
  47.       begin
  48.            Q:=Length(StrData[I].Title)+3+StrData[I].sdelka;
  49.            if P<Q then P:=Q;
  50.       end;
  51.  
  52.      poms:='';
  53.      for I:=1 to P do poms:=poms+' ';
  54.  
  55.      for I:=1 to (SICount*2)-1 do WEReadLn(poms);
  56.  
  57.  
  58.      WEReadBt(' OK ',IB_OK,'Potvrzení zadanÿch údajû...');
  59.      WEReadBt(' Opravit ',IB_Opr,'Opravení zadanÿch údajû...');
  60.      WEReadBt(' Zru¿it ',IB_Esc,'Anulování æádosti, akci neprovádêt...');
  61.  
  62.      WEWidthLn;
  63.      BtDirect(x,y);
  64.      WEButtonLnY:=y+(2*SICount);
  65.  
  66.      SaveWin(x-1,y-1,x+WEWidth,y+WECount+3,stbuf);
  67.      WFrame(x,y,x+WEWidth-1,y+WECount+2);
  68.  
  69.      gotoxy(x+(WEWidth div 2)-(Length(Title) div 2)-1,y-1);
  70.      textattr:=wcTitle;
  71.      write(' ',Title,' ');
  72.  
  73.      for I:=1 to SICount do
  74.       begin
  75.            ShowLn(StrData[I].Title,x,y+(2*I)-2,StrData[I].sdelka);
  76.       end;
  77.  
  78.      for I:=1 to BtCount do
  79.       begin
  80.            gotoxy(WEPosBt[I],WEButtonLnY);
  81.            writebutton(Buttons[I].jmeno,btNoActive);
  82.       end;
  83.  
  84.      for I:=1 to SICount do
  85.       begin
  86.            InputLnS(StrData[I].Title,StrData[I].infotext,x,y+(2*I)-2,StrData[I].sdelka,StrItem[I]);
  87.       end;
  88.  
  89.      BLast:=1;
  90.      BPos:=1;
  91.      gotoxy(WEPosBt[Bpos],WEButtonLnY);
  92.      writebutton(Buttons[BPos].jmeno,btActive);
  93.      gotoxy(4,23);
  94.      textattr:=wcText;
  95.      write(infoln(Buttons[BPos].text));
  96.      repeat
  97.             key:=GetLegalKey([CR,ESC,TAB]);
  98.             case key of
  99.             TAB:
  100.                 begin
  101.                      BLast:=BPos;
  102.                      BPos:=BPos+1;
  103.                      if BPos=BtCount+1 then BPos:=1;
  104.                 end;
  105.             end;
  106.  
  107.             gotoxy(WEPosBt[BLast],WEButtonLnY);
  108.             writebutton(Buttons[BLast].jmeno,btNoActive);
  109.             gotoxy(WEPosBt[BPos],WEButtonLnY);
  110.             writebutton(Buttons[BPos].jmeno,btActive);
  111.             textattr:=wcText;
  112.             gotoxy(4,23);
  113.             write(infoln(Buttons[BPos].text));
  114.       until key in [CR,ESC];
  115.  
  116.       case key of
  117.       CR:
  118.          begin
  119.               if Buttons[BPos].prikaz=IB_Opr then
  120.                begin
  121.                     restorewin(x-1,y-1,x+WEWidth,y+WECount+3,stbuf);
  122.                     WENul;
  123.                     goto 1;
  124.                end;
  125.               if Buttons[Bpos].prikaz=IB_Esc then
  126.                begin
  127.                     restorewin(x-1,y-1,x+WEWidth,y+WECount+3,stbuf);
  128.                     WENul;
  129.                     INul;
  130.                     INResult:=false;
  131.                     exit;
  132.                end;
  133.               if Buttons[BPos].prikaz=IB_OK then
  134.                begin
  135.                     restorewin(x-1,y-1,x+WEWidth,y+WECount+3,stbuf);
  136.                     WENul;
  137.                     INul;
  138.                     INResult:=true;
  139.                end;
  140.          end;
  141.       ESC:
  142.           begin
  143.                restorewin(x-1,y-1,x+WEWidth,y+WECount+3,stbuf);
  144.                WENul;
  145.                INul;
  146.                INResult:=false;
  147.                exit;
  148.           end;
  149.       end;
  150. end;
  151.  
  152.  
  153. BEGIN
  154.      SICount:=0;
  155. END.
  156.