home *** CD-ROM | disk | FTP | other *** search
/ Collection of Education / collectionofeducationcarat1997.iso / COMPUSCI / TOT11.ZIP / TOTDEM11.ZIP / TELE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  13KB  |  377 lines
  1. Program Create_Telephone_Labels;
  2.  
  3.   { This demo program written using substantial portions of the   }
  4.   { Technojock Object Toolkit in order to demonstrate how various }
  5.   { objects and their methods can be integrated.                  }
  6.   {                                                               }
  7.   { Copyright 1991 by George Bean                                 }
  8.  
  9. Uses Dos, Crt, Printer,
  10.  
  11.          TOTDATE,
  12.          TOTDIR,
  13.          TOTFAST,
  14.          TOTINPUT,
  15.          TOTIO1,
  16.          TOTIO2,
  17.          TOTIO3,
  18.          TOTLINK,
  19.          TOTLIST,
  20.          TOTLOOK,
  21.          TOTMISC,
  22.          TOTMSG,
  23.          TOTREAL,
  24.          TOTSTR,
  25.          TOTSYS,
  26.          TOTWIN;
  27.  
  28. Var ExitWindow             : PromptOBJ;
  29.     PreviewMsg             : MessageOBJ;
  30.     LabelType, Fmtype      : RadioIOOBJ;
  31.     Manager                : FormOBJ;
  32.     IncludeExten           : CheckIOOBJ;
  33.     Screen1                : ScreenOBJ;
  34.     Result, ExitCode       : tAction;
  35.     Preview, Cancel, Print : Strip3DIOOBJ;
  36.     Keys                   : ControlKeysIOOBJ;
  37.     AmountToPrint          : IntIOOBJ;
  38.     MainPhone,
  39.     FirstPhone, LastPhone,
  40.     FirstExten, LastExten  : PictureIOOBJ;
  41.     FP_Int,     LP_Int,
  42.     FE_Int,     LE_Int,
  43.     CurrentExt, X          : Integer;
  44.  
  45. Procedure DisposeVars;
  46. Begin
  47.   LabelType.Done;
  48.   FmType.Done;
  49.   IncludeExten.Done;
  50.   MainPhone.Done;
  51.   FirstPhone.Done;
  52.   LastPhone.Done;
  53.   FirstExten.Done;
  54.   LastExten.Done;
  55.   Preview.Done;
  56.   Cancel.Done;
  57.   Print.Done;
  58.   Manager.Done;
  59. End;
  60.  
  61. Procedure InitForm;
  62. Begin
  63.   IOTOT^.SetColField(113,7,15,120);
  64.   IOTOT^.SetColLabel(48,62,63,62);
  65.   With LabelType Do
  66.   Begin
  67.     Init(10,9,15,3,'');
  68.     SetID(1);
  69.     AddItem('~S~tandard',83,True);
  70.     AddItem('~D~ID',68,False);
  71.     AddItem('~E~xt Only',69,False);
  72.     SetMessage(19,22,' to point, SPACE BAR to select label type');
  73.   End;
  74.   With MainPhone Do
  75.   Begin
  76.     Init(50,9,'(###) ###-####');
  77.     SetLabel(' ~M~ain Number ');
  78.     SetHotKey(77);
  79.     SetID(2);
  80.     SetActiveStatus(True);
  81.     SetMessage(22,22,'Enter the TEN DIGIT telephone number');
  82.   End;
  83.   Keys.Init;
  84.   With FirstPhone Do
  85.   Begin
  86.     Init(50,11,'(###) ###-####');
  87.     SetLabel('  ~F~irst DID  ');
  88.     SetHotKey(70);
  89.     SetID(3);
  90.     SetMessage(19,22,'Enter the First TEN DIGIT telephone number');
  91.   End;
  92.   With LastPhone Do
  93.   Begin
  94.     Init(50,13,'(###) ###-####');
  95.     SetLabel('   ~L~ast DID  ');
  96.     SetHotKey(76);
  97.     SetID(4);
  98.     SetMessage(19,22,'Enter the Last TEN DIGIT telephone number');
  99.   End;
  100.   With FirstExten Do
  101.   Begin
  102.     Init(50,15,'#####');
  103.     SetLabel('  Firs~t~ Ext  ');
  104.     SetHotKey(84);
  105.     SetID(5);
  106.     SetMessage(23,22,'Enter the FIRST extension to print');
  107.   End;
  108.   With LastExten Do
  109.   Begin
  110.     Init(50,17,'#####');
  111.     SetLabel('   L~a~st Ext  ');
  112.     SetHotKey(65);
  113.     SetID(6);
  114.     SetMessage(23,22,'Enter the LAST extension to print');
  115.   End;
  116.   With IncludeExten Do
  117.   Begin
  118.     Init(10,13,15,1,'');
  119.     SetID(7);
  120.     AddItem('~I~nclude Ext',73,True);
  121.     SetMessage(18,22,'Press SPACE BAR to include extension number');
  122.   End;
  123.   With AmountToPrint Do
  124.   Begin
  125.     Init(21,18,4);
  126.     InitFormat;
  127.     SetMinMax(0,9999);
  128.     SetLabel('  Amount  ');
  129.     SetMessage(20,22,'Enter the number of labels to be printed');
  130.   End;
  131.   With FmType Do
  132.   Begin
  133.     Init(10,15,15,3,'');
  134.     AddItem('Ext ~O~ver',79,False);
  135.     AddItem('Ext ~U~nder',85,True);
  136.     SetMessage(18,22,' to point, SPACE BAR to select label format');
  137.   End;
  138.   Preview.Init(24,20,' Pre~v~iew ',Stop1);
  139.   Preview.SetHotkey(86);
  140.   Print.Init(37,20,' ~P~rint ',Finished);
  141.   Print.SetHotkey(80);
  142.   Cancel.Init(48,20,' ~C~ancel ',Escaped);
  143.   Cancel.SetHotkey(67);
  144. End;
  145.  
  146. Procedure DoMenuSelection;
  147. Begin
  148.   With Manager Do
  149.   Begin
  150.     Init;
  151.     Screen.ShadFillBox(5,7,75,23,78,2);
  152.     Screen.WriteBetween(5,75,7,79,'  L A B E L    D E S C R I P T I O N  ');
  153.     AddItem(LabelType);
  154.     AddItem(IncludeExten);
  155.     AddItem(MainPhone);
  156.     AddItem(FirstPhone);
  157.     AddItem(LastPhone);
  158.     AddItem(FirstExten);
  159.     AddItem(LastExten);
  160.     AddItem(FmType);
  161.     AddItem(AmountToPrint);
  162.     AddItem(Preview);
  163.     AddItem(Print);
  164.     AddItem(Cancel);
  165.     AddItem(Keys);
  166.     Result := Go;
  167.   End;
  168. End;
  169.  
  170. Procedure PrintLabels;
  171. Begin
  172.   Write(LST,#27#71);     { Set LQ mode }
  173.   Case LabelType.GetValue Of
  174.     1 : Begin    { Standard Labels }
  175.           If IncludeExten.GetValue(1) Then
  176.           Begin
  177.             If ( FmType.GetValue = 1 ) Then
  178.             Begin   { Standard with ext over }
  179.               CurrentExt := StrToInt(FirstExten.GetValue);
  180.               Repeat
  181.                 Writeln(LST,'   Ext ',CurrentExt);
  182.                 Writeln(LST,MainPhone.GetPicValue);
  183.                 Writeln(LST);
  184.                 Inc(CurrentExt);
  185.               Until CurrentExt = ( StrToInt(LastExten.GetValue) + 1 );
  186.             End
  187.             Else
  188.             Begin   { Standard with ext under }
  189.               CurrentExt := StrToInt(FirstExten.GetValue);
  190.               Repeat
  191.                 Writeln(LST,MainPhone.GetPicValue);
  192.                 Writeln(LST,'   Ext ',CurrentExt);
  193.                 Writeln(LST);
  194.                 Inc(CurrentExt);
  195.               Until CurrentExt = ( StrToInt(LastExten.GetValue) + 1 );
  196.             End;
  197.           End
  198.           Else     { Did not include extension }
  199.           Begin
  200.             For X := 1 to AmountToPrint.GetValue Do
  201.             Begin
  202.               Writeln(LST,MainPhone.GetPicValue);
  203.               Writeln(LST);
  204.               Writeln(LST);
  205.             End;
  206.           End;
  207.         End;
  208.     2 : Begin      { DID Labels }
  209.           FP_Int := StrToInt(Copy(FirstPhone.GetValue,7,4));
  210.           LP_Int := StrToInt(Copy(LastPhone.GetValue,7,4));
  211.           FE_Int := StrToInt(FirstExten.GetValue);
  212.           LE_Int := StrToInt(LastExten.GetValue);
  213.           If IncludeExten.GetValue(1) Then
  214.           Begin
  215.             If ( FmType.GetValue = 1 ) Then
  216.             Begin   { DID with Ext over }
  217.               For X := FP_Int to LP_Int Do
  218.               Begin
  219.                 Writeln(LST,'   Ext ',FE_Int);
  220.                 Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  221.                 Writeln(LST);
  222.                 Inc(FE_Int);
  223.               End;
  224.             End
  225.             Else
  226.             Begin   { DID with Ext under }
  227.               For X := FP_Int to LP_Int Do
  228.               Begin
  229.                 Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  230.                 Writeln(LST,'   Ext ',FE_Int);
  231.                 Writeln(LST);
  232.                 Inc(FE_Int);
  233.               End;
  234.             End;
  235.           End
  236.           Else
  237.           Begin
  238.             For X := FP_Int to LP_Int Do
  239.             Begin
  240.               Writeln(LST,Copy(FirstPhone.GetPicValue,1,10),X);
  241.               Writeln(LST);
  242.               Writeln(LST);
  243.             End;
  244.           End;
  245.         End;
  246.     3 : Begin      { Extension Only }
  247.           FE_Int := StrToInt(FirstExten.GetValue);
  248.           LE_Int := StrToInt(LastExten.GetValue);
  249.           For X := FE_Int to LE_Int Do
  250.           Begin
  251.             Writeln(LST,'   Ext ',X);
  252.             Writeln(LST);
  253.             Writeln(LST);
  254.           End;
  255.         End;
  256.   End; { Case }
  257.   Write(LST,#27#72);  { Cancel LQ mode }
  258. End;
  259.  
  260. Begin
  261.   Screen.Clear(3,'▓');
  262.   LookTOT^.SetWindow(31,23,30,30);
  263.   ShadowTOT^.SetShadowStyle(DownRight,7,'░');
  264.   Screen.ShadFillBox(5,2,75,4,31,4);
  265.   Screen.WriteBetween(5,75,3,30,'T E L E P H O N E      L A B E L      D E S I G N E R');
  266.   InitForm;
  267.   Repeat
  268.     DoMenuSelection;
  269.     Case Result Of
  270.       Finished : Begin     { OK to Print }
  271.                    PrintLabels;
  272.                  End;
  273.       Stop1    : Begin     { Preview first and last label }
  274.                    Screen1.Init;
  275.                    Screen1.Save;
  276.                    Screen.PartClear(5,7,77,24,3,'▓');
  277.                    If ( LabelType.GetValue = 3 ) Then   { Extension Only }
  278.                    Begin
  279.                      Screen.ShadFillBox(14,8,31,10,78,1);
  280.                      Screen.ShadFillBox(50,8,67,10,78,1