home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / uldialog / testdial.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-12  |  2.9 KB  |  107 lines
  1. {$A-,B-,E+,F+,I+,N-,O+,R+,S+,V-}
  2. {$M 32000,64000,655360}
  3.  
  4. { Test Program for testing ULDial }
  5.  
  6. Program TESTDIAL;
  7.  
  8. Uses ULRoot, DOS, OpCrt, OpString, OpKey, OpFrame, OpWindow,
  9.      ULDial;
  10.  
  11. label
  12.   Again;
  13.  
  14. var
  15.   Msg : string;
  16.   Choices : string;
  17.   Prompt : string;
  18.   Len : byte absolute Prompt;
  19.   EditSt : string;
  20.   ExitCode : word;
  21.   TimeOut : word;
  22.   N : longint;
  23.   Dial : DialogBox;
  24.   Error : word;
  25.   Orientation : HorizVerticalType;
  26.   NrRows, NrCols : byte;
  27.  
  28. begin
  29.   N := MemAvail;
  30.   InitCrt;
  31.   with ULRootColorSet do
  32.   TextAttr := ColorMono(HotSpotColor, HotSpotMono);
  33. Again:
  34.   ClrScr;
  35.   WriteLn('Test of DialogBox.');
  36.   WriteLn('Do you want radio buttons arranged horizontally or vertically?');
  37.   Write('Enter H or V═');
  38.   ReadLn(Msg);
  39.   NrRows := 1;
  40.   NrCols := 1;
  41.   if UpCase(Msg[1]) = 'H' then
  42.   begin
  43.     Orientation := rbHoriz;
  44.     Write('How many rows of buttons? ═');
  45.     ReadLn(NrRows);
  46.   end
  47.   else
  48.   begin
  49.     Orientation := rbVertical;
  50.     Write('How many columns of buttons? ═');
  51.     ReadLn(NrCols);
  52.   end;
  53.   if not Dial.InitDeluxe(0,0,DefWindowOptions+wBordered,
  54.                          ULRootColorSet, Orientation,
  55.                          NrRows, NrCols, False, 4,320,8,80) then Halt;
  56.   WriteLn('Enter lines of text that you want used for message.');
  57.   WriteLn('Use blank line to end.');
  58.   EditSt := '';
  59.   with Dial do
  60.   begin
  61.     AddHeader(' DialogBox ',heTC);
  62.     repeat
  63.       Write('═');
  64.       ReadLn(Msg);
  65.       if Msg <> '' then AddMessageString(Msg);
  66.     until Msg = '';
  67.     WriteLn('Enter several choices you want displayed as radio buttons.');
  68.     WriteLn('Enter blank line to end the choices.');
  69.     repeat
  70.       Write('═');
  71.       ReadLn(Choices);
  72.       if Choices <> '' then AddChoice(Choices);
  73.     until Choices = '';
  74.     WriteLn('If you want a string entry field, enter a 2 or 3 word prompt.');
  75.     WriteLn('If you do not want an entry field, enter a blank line.');
  76.     Write('═');
  77.     ReadLn(Prompt);
  78.     if Prompt <> '' then
  79.       AddStringEntryField(Prompt,1,1,CharStr('X',80),1,
  80.                           Len+2,20,0,EditSt);
  81.     WriteLn('If you want an automatic timeout, enter number of seconds delay.');
  82.     WriteLn('Enter 0 to disable this function.');
  83.     ReadLn(TimeOut);
  84.     SetTimeOut(TimeOut);
  85.     Error := GetLastError;
  86.     if Error <> 0 then
  87.     begin
  88.       WriteLn('Error: ', Error);
  89.       Halt(1);
  90.     end;
  91.     Process;
  92.     ExitCode := GetLastChoice;
  93.     EditSt := GetEditedString;
  94.     Done;
  95.   end;
  96.   WriteLn('You exited with code: ',ExitCode);
  97.   if Prompt <> '' then
  98.     WriteLn('The edited string was: ', EditSt);
  99.   WriteLn('Press {Enter} to go again; any other key to quit...');
  100.   ExitCode := ReadKeyWord;
  101.   if ExitCode = Enter then Goto Again;
  102.   wStack.Done;  { If you don't use this, you eat up 40 bytes of the heap.}
  103.   RestoreCrt;
  104.   WriteLn('Memory Available: Start:', N);
  105.   WriteLn('                 Finish:',MemAvail);
  106. end.
  107.