home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ASG53.ZIP / R2ENGLSH.INC < prev    next >
Encoding:
Text File  |  1989-12-03  |  3.2 KB  |  94 lines
  1. {Cute procedures used to demonstrate the RealToEnglish() Procedure}
  2.  
  3. VAR
  4.  DONE   : BOOLEAN;
  5.  TotPd,
  6.  INREAL : REAL;
  7.  OutStr : STRING;
  8.  CqNum  : WORD;
  9.  
  10. CONST
  11.  Pass1   : BOOLEAN = True;
  12.  Name    : STRING[30] = 'YOUR FIRM NAME';
  13.  Address : STRING[30] = 'Your Address goes here';
  14.  City    : STRING[30] = 'Your City, Province, PostCode';
  15.  
  16. PROCEDURE GetPayor;
  17. BEGIN
  18.  OrgAttr:=33; SayAttr:=32; GetAttr:=26; EndAttr:=32; {DEMO}
  19.  AtSay(15,2,Address);
  20.  AtSay(15,3,City);
  21.  AtSayGetStrLen(15,1,'',Name,30);
  22.  AtSayGetStrLen(15,2,'',Address,30);
  23.  AtSayGetStrLen(15,3,'',City,30);
  24.  EndAttr:=33; TextAttr:=32; Pass1:=False;
  25. END;
  26.  
  27. PROCEDURE ShowCheque;
  28. BEGIN
  29.  SayAttr:=32; OrgAttr:=32;
  30.  AtSay(69,3,', 19');
  31.  AtSay( 2,4,'PAY  to the');
  32.  AtSay( 2,5,'order of...');
  33.  GoToXY(65,1); WRITE('Cheque #',CqNum:3);
  34.  TextAttr:=33;
  35.  GoToXY(51,3); WRITE(NameOfMonth(MonthOfYear(SysDate)):15);
  36.  GoToXY(66,3); WRITE(COPY(DateToDateString(SysDate),3,2):3);
  37.  GoToXY(74,3); WRITE(COPY(DateToDateString(SysDate),7,2));
  38.  SayAttr:=33; TextAttr:=33;
  39.  AtSay(15,5,'John Roncalio, DBA: Blue Ribbon Software');
  40.  GoToXY(1,7); ClrEol; SayAttr:=32;
  41.  AtSay(5, 8,'The Bank of Liberal Overdrafts');
  42.  AtSay(5, 9,'5555 Bay St., Toronto, Ontario');
  43.  AtSay(41,9,'PER _______________________________');
  44.  AtSay(2,11,'║▀ 000000║▀  ■|00123 ■■■ 004■|  00567■■■89║▀');
  45.  GoToXY(8,11); WRITE(CqNum:3);
  46.  IF Pass1 THEN GetPayor ELSE
  47.  BEGIN
  48.   AtSay(15,1,Name);
  49.   AtSay(15,2,Address);
  50.   AtSay(15,3,City);
  51.  END;
  52. END;
  53.  
  54. PROCEDURE IntroScript;
  55. BEGIN
  56.  TextAttr:=112; ClrScr;
  57.  GoToXY(32,1); WRITELN('RealToEnglish()'); WRITELN;
  58.  WRITELN(' This procedure takes a REAL number and outputs a STRING of English words that');
  59.  WRITELN(' represent the number.  The obvious application for this is to produce cheques');
  60.  WRITELN(' such as the shareware contribution cheque shown below:'); GoToXY(1,8);
  61. END;
  62.  
  63. PROCEDURE PatheticPlea;
  64. BEGIN
  65.  IF TotPd<45 THEN WRITELN(' You don''t believe in shareware?') ELSE
  66.  BEGIN
  67.   WRITELN;
  68.   WRITELN(' THANK YOU! Your cheques totaling $',TotPd:10:2,' would be greatly appreciated by');
  69.   WRITELN(' my family who think I should spend more time with them and less with Pascal!');
  70.   RealToEnglish(TotPd,OutStr);
  71.   WRITELN;
  72.   IF TotPd>45 THEN
  73.   BEGIN
  74.    WRITELN(' ',OutStr);
  75.    WRITELN(' is really too much; However we would be pleased to receive a shareware con-');
  76.    WRITELN(' tribution of $45 for which I will send you complete source code on 5.25" disk.');
  77.    WRITELN(' If you use these routines it is because they are obviously useful and a great');
  78.    WRITELN(' savings of YOUR time, allowing you to spend more time with YOUR family. Please');
  79.    WRITELN(' explain to your partner that the cheque for $45 that you are about to write to');
  80.    WRITELN(' me is a tax deductable purchase of source code, and that it will go to feed a');
  81.    WRITELN(' poor family and promote international goodwill. Again... thank you.');
  82.   END
  83.   ELSE WRITELN(' This procedure outputs the English words for any REAL number to $9,999,999.99');
  84.  END;
  85. END;
  86.  
  87. PROCEDURE WriteAnotherCheque;
  88. BEGIN
  89.  OpenWindow(60,19,69,23,White,Green,2,'');
  90.  AtSayGetBoolean(2,2,'End?',Done);
  91.  CloseWindow; {done}
  92. END;
  93.  
  94.