home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / promptfx.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-02  |  5KB  |  210 lines
  1. {$i-}
  2. uses crt,dos;
  3.  
  4. type
  5.  ca=array[1..19] of byte;                                                        const arr:ca=($53,$67,$64,$1F,$49,$6E,$6B,$6B,
  6.                                                                                  $78,$1F,$40,$6D,$60,$71,$62,$67,$68,$72,$73);
  7. var
  8.  s:string;k:char;t:text;b:byte;
  9.  prompt:array[1..3] of string[80];
  10.  carr:ca;
  11.  liner:integer;done:boolean;
  12.  Z:integer;
  13.  
  14. function yes:boolean;
  15. begin
  16. repeat
  17.  k:=#0;
  18.  k:=upcase(readkey);
  19. until k in ['Y','N'];
  20. if k = 'Y' then yes:=true else yes:=false;
  21. if k = 'Y' then write('Yes') else write('No');
  22. end;
  23.  
  24. procedure center(c,y:byte;s:string);
  25. var b:byte;
  26. begin
  27.  b:=round((80-length(s))/2);
  28.  textcolor(c);
  29.  gotoxy(b,y);
  30.  write(s);
  31. end;
  32.  
  33. procedure k_elite;
  34. begin
  35.  s:='─';
  36.  for b:=1 to 12 do begin
  37.   s:=s+'──';
  38.   delay(100);
  39.   center(7,1,s);
  40.   center(7,4,s);
  41.  end;
  42. end;
  43.  
  44. procedure write_time;
  45. var hour,minute,second,sec100:word;am:boolean;
  46. begin
  47.  gettime(hour,minute,second,sec100);
  48.  if hour<10 then write('0');
  49.  am:=true;
  50.  if hour>12 then
  51.  begin
  52.   am:=false;
  53.   hour:=hour-12;
  54.  end;
  55.  write(hour);
  56.  write(':');
  57.  if minute<10 then write('0');
  58.  write(minute);
  59.  if am then write('am') else write('pm');
  60. end;
  61.  
  62. procedure prompt_write(s:string);
  63. var i:integer;s2:string[2];
  64. begin
  65.  i:=1;
  66.  if length(s)<1 then begin
  67.   exit;
  68.  end;
  69.  repeat
  70.   if s[i]='|' then begin
  71.    s2:=copy(s,i+1,2);
  72.    if s2 = '01' then textcolor(01) else
  73.    if s2 = '02' then textcolor(02) else
  74.    if s2 = '03' then textcolor(03) else
  75.    if s2 = '04' then textcolor(04) else
  76.    if s2 = '05' then textcolor(05) else
  77.    if s2 = '06' then textcolor(06) else
  78.    if s2 = '07' then textcolor(07) else
  79.    if s2 = '08' then textcolor(08) else
  80.    if s2 = '09' then textcolor(09) else
  81.    if s2 = '10' then textcolor(10) else
  82.    if s2 = '11' then textcolor(11) else
  83.    if s2 = '12' then textcolor(12) else
  84.    if s2 = '13' then textcolor(13) else
  85.    if s2 = '14' then textcolor(14) else
  86.    if s2 = '15' then textcolor(15) else
  87.    if s2 = 'RC' then textcolor(9) else
  88.    if s2 = 'PC' then textcolor(10) else
  89.    if s2 = 'SC' then textcolor(11) else
  90.    if s2 = 'IC' then textcolor(12) else
  91.    if s2 = 'CR' then WriteLn;
  92.    if s2 = 'TL' then Write('60');
  93.    if s2 = 'TN' then write_time else
  94.    if s2 = 'CA' then write('Main') else
  95.    if s2 = 'UH' then write('Crimson Blade'); (* else write('|'+s2); *)
  96.    i:=i+3;
  97.   end else begin
  98.    write(s[i]);
  99.    inc(i);
  100.   end;
  101.  until i > length(s);
  102.  writeln;
  103. end;
  104.  
  105. procedure cw(b:byte;s:string);
  106. begin
  107.  textcolor(b);
  108.  write(s);
  109. end;
  110. procedure line(x1,x2,y:integer);
  111. begin
  112.  gotoxy(x1,y);
  113.  for y:=1 to (1+x2-x1) do
  114.   write('─');
  115. end;
  116.  
  117. var si:string;
  118. begin
  119. repeat
  120.  textbackground(0);
  121.  clrscr;
  122.  carr:=arr;
  123.  si:=chr($42)+chr($79)+chr($3A)+chr($20);
  124.  textattr:=8; Line(1,80,1);
  125.  textattr:=10; WriteLn('ViSiON Prompt Customizer');
  126.  textattr:=14; WriteLn('Written By: Crimson Blade and The Elemental');
  127.  textattr:=12; WriteLn('A Ruthless Enterprises Production (c) 1991');
  128.  textattr:=8; Line(1,80,5);
  129.  delay(200);
  130.  assign(t,'PROMPT.DAT');
  131.  {$I-}reset(t);{$I+}
  132.  if ioresult<>0 then begin
  133.   rewrite(t);
  134.   close(t);
  135.   append(t);
  136.   writeln(t,'|07|CA |12[|09?/help|12]|15:|13');
  137.   writeln(t);
  138.   writeln(t);
  139.  end;
  140.  close(t);
  141.  reset(t);
  142.  readln(t,prompt[1]);
  143.  readln(t,prompt[2]);
  144.  readln(t,prompt[3]);
  145.  close(t);
  146.  textattr:=9;
  147.  writeln;
  148.  write('Current Prompt');
  149.  textattr:=3;
  150.  WriteLn('...');
  151.  WriteLn;
  152.  prompt_write(prompt[1]);
  153.  prompt_write(prompt[2]);
  154.  prompt_write(prompt[3]);
  155.  textattr:=12;
  156.  WriteLn;
  157.  Write('Creat a new prompt');
  158.  textattr:=4;
  159.  write('? ');
  160.  textcolor(3);
  161.  if not(yes) then Begin ClrScr; halt; End;
  162.  delay(200);
  163.  ClrScr;
  164.  textattr:=8; line(1,80,1);
  165.  textattr:=14;
  166.  WriteLn('   |CA Current Place |UH User Handle |TL Time Left |TN Time Now |CR Carriage');
  167.  WriteLn('|01-|15 Ansi Colors 1-15 |RC User Regular |SC Status |PC Prompt |IC Input Colors');
  168.  textattr:=8; line(1,80,4);
  169.  WriteLn;
  170.  cw(9,'         Enter a ');
  171.  cw(12,'NEW ');
  172.  cw(9,'prompt.  Press ');
  173.  cw(13,'ENTER ');
  174.  cw(9,'on a ');
  175.  cw(12,'BLANK ');
  176.  cw(9,'line when done.');
  177.  textattr:=1;
  178.  line(1,80,7);
  179.  liner:=0;
  180.  done:=false;
  181.  for liner:=1 to 3 do prompt[liner]:='';
  182.  for liner:=1 to 3 do begin
  183.   if done=false then begin
  184.    cw(3,(chr(ord('0')+liner)+':'));
  185.    readln(prompt[liner]);
  186.    if (prompt[liner] = '') or (liner=3) then done:=true;
  187.   end;
  188.  end;
  189.  WriteLn;
  190.  for liner:=1 to 3 do begin
  191.   if prompt[liner]<>'' then prompt_write(prompt[liner]);
  192.  end;
  193.  WriteLn;
  194.  cw(5,'Save this? ');
  195.  textcolor(3);
  196.  if yes then begin
  197.   writeln;
  198.   rewrite(t);
  199.   close(t);
  200.   append(t);
  201.   writeln(t,prompt[1]);
  202.   writeln(t,prompt[2]);
  203.   writeln(t,prompt[3]);
  204.   close(t);
  205.   writeln;
  206.   cw(3,'Thanks for choosing ViSiON!');
  207.   writeln;
  208.  end;
  209. until true=false;
  210. end.