home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TTT510.ZIP / TTTDEM.ZIP / IODEM3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-19  |  10.6 KB  |  300 lines
  1. Program IOTTT5_Demo_3;
  2.  
  3. {IMPORTANT NOTE: Set Options Compile Conditional Defines to IOFull and
  4.                  select Compile Build.
  5. }
  6.  
  7. {$V-}       {don't check string lengths}
  8.  
  9. USES  DOS, CRT, FASTTTT5, WINTTT5, IOTTT5, KeyTTT5, Strnttt5, MiscTTT5;
  10.  
  11. CONST
  12.     Big_Field_width = 40;
  13.  
  14. TYPE
  15.    Customer_Rec = Record
  16.                        Title   : String[Big_Field_Width];
  17.                        Company : String[Big_Field_Width];
  18.                        Addr1   : string[Big_Field_Width];
  19.                        Addr2   : string[Big_Field_Width];
  20.                        City    : string[Big_Field_Width];
  21.                        State   : string[2];
  22.                        Zip     : string[9];
  23.                        Number  : string[10];
  24.                   end;
  25.  
  26.    Item_Rec     = record
  27.                        Item          : byte;
  28.                        Quantity      : word;
  29.                        Description   : string[50];
  30.                        Price         : real;
  31.                        ExtendedPrice : real;
  32.                   end;
  33.    Display_Cols = record
  34.                       TextF    : byte;
  35.                       Back     : byte;
  36.                       MsgF     : byte;
  37.                       MsgB     : Byte;
  38.                       FieldHiF : byte;
  39.                       FieldHiB : Byte;
  40.                       FieldLoF : Byte;
  41.                       FieldLoB : Byte;
  42.                       BoxF     : Byte;
  43.                       HeadF    : Byte;
  44.                   end;
  45. VAR
  46.   Cust : Customer_Rec;
  47.   OurRef : string[10];
  48.   ODate : dates;
  49.   Items: array[1..3] of Item_Rec;
  50.   Screen_Cols : Display_Cols;
  51.  
  52.    Procedure Init_Vars;
  53.    {}
  54.    begin
  55.        FillChar(Cust,sizeof(Cust),#0);
  56.        Cust.Title := 'Bob Ainsbury';
  57.        FillChar(Items,SizeOf(Items),#0);
  58.        OurRef:= '';
  59.        Odate := Today_in_Julian;
  60.        With Screen_Cols do
  61.             If ColorScreen then 
  62.             begin
  63.                 TextF    := white;
  64.                 Back     := Blue;
  65.                 MsgF     := yellow;
  66.                 MsgB     := red;
  67.                 FieldHiF := white;
  68.                 FieldHiB := red;
  69.                 FieldLoF := Lightgray;
  70.                 FieldLoB := black;
  71.                 BoxF     := lightcyan;
  72.                 HeadF    := white;
  73.             end
  74.             else
  75.             begin
  76.                 TextF    := lightgray;
  77.                 Back     := black;
  78.                 MsgF     := white;
  79.                 MsgB     := black;
  80.                 FieldHiF := black;
  81.                 FieldHiB := lightgray;
  82.                 FieldLoF := white;
  83.                 FieldLoB := black;
  84.                 BoxF     := white;
  85.                 HeadF    := white;
  86.             end;
  87.  
  88.    end; {of proc Init}
  89.  
  90.    Procedure Set_Screen;
  91.    {}
  92.    begin
  93.        ClearText(1,1,80,25,white,black);
  94.        With Screen_Cols do
  95.        begin
  96.             FBox(1,1,80,21,BoxF,Back,2);
  97.             WriteCenter(21,TextF,back,'Copyright (c) 1988 TechnoJock Software Inc.');
  98.             WriteCenter(1,HeadF,back,' Order Entry Screen ');
  99.             WriteAt(64,1,TextF,back,' F10 to Quit ');
  100.             WriteAt(19,3,TextF,back,'Name');
  101.             WriteAT(19,4,TextF,back,'Company');
  102.             WriteAT(19,5,TextF,back,'Address 1');
  103.             WriteAT(19,6,TextF,back,'Address 2');
  104.             WriteAT(19,7,TextF,back,'City');
  105.             WriteAT(19,8,TextF,back,'State             Zip');
  106.             WriteAT(53,8,TextF,back,'Telephone');
  107.             WriteAT(8,10,TextF,back,'Our Reference:                          Order Date');
  108.             WriteAT(8,12,TextF,back,'                                                        UNIT    EXT.');
  109.             WriteAT(8,13,TextF,back,'ITEM  QUANTITY             DESCRIPTION                  PRICE   PRICE');
  110.             WriteAT(64,19,TextF,back,'Total');
  111.        end;
  112.        WriteAT(3,23,lightcyan,black,'This demo input routine was written using the IOTTT5 unit of TechnoJock''s');
  113.        WriteAT(3,24,lightcyan,black,'Turbo Toolkit v5.0 . The unit is easy to use and supports dependent field');
  114.        WriteAT(3,25,lightcyan,black,'update, field format control, automatic range checking, and much much more!');
  115.    end; {of proc Set_Screen}
  116.  
  117.    Procedure Set_Fields;
  118.    {}
  119.    var I : Integer;
  120.    begin
  121.        Create_Tables(1);
  122.        Activate_Table(1);
  123.        With Screen_Cols do
  124.             Define_Colors(FieldHiF, FieldHiB, FieldLoF, FieldLoB, MsgF, MsgB);
  125.        Allow_Esc(true);
  126.        Create_Fields(22);
  127.        Add_Field(1,  22,2,22,2,  32,3);
  128.        Add_Field(2,  1,3,1,3,    32,4);
  129.        Add_Field(3,  2,4,2,4,    32,5);
  130.        Add_Field(4,  3,5,3,5,    32,6);
  131.        Add_Field(5,  4,6,3,6,    32,7);
  132.        Add_Field(6,  5,7,5,7,    32,8);
  133.        Add_Field(7,  6,8,6,8,    41,8);
  134.        Add_Field(8,  7,9,7,9,    65,8);
  135.        Add_Field(9,  8,10,8,10,  25,10);
  136.        Add_Field(10, 9,11,9,11,  64,10);
  137.        Add_Field(11,10,15,10,12, 8,15);
  138.        Add_Field(12,11,16,11,13, 15,15);
  139.        Add_Field(13,12,17,12,14, 21,15);
  140.        Add_Field(14,13,18,13,15, 63,15);
  141.        Add_Field(15,11,19,14,16, 8,16);
  142.        Add_Field(16,12,20,15,17, 15,16);
  143.        Add_Field(17,13,21,16,18, 21,16);
  144.        Add_Field(18,14,22,17,19, 63,16);
  145.        Add_Field(19,15, 1,18,20, 8,17);
  146.        Add_Field(20,16, 1,19,21, 15,17);
  147.        Add_Field(21,17, 1,20,22, 21,17);
  148.        Add_Field(22,18, 1,21, 1, 63,17);
  149.  
  150.        String_Field(1, Cust.Title,   replicate(Big_Field_Width,'*'));
  151.        String_Field(2, Cust.Company, replicate(Big_Field_Width,'*'));
  152.        String_Field(3, Cust.Addr1,   replicate(Big_Field_Width,'*'));
  153.        String_Field(4, Cust.Addr2,   replicate(Big_Field_Width,'*'));
  154.        String_Field(5, Cust.City,    replicate(Big_Field_Width,'*'));
  155.        String_Field(6, Cust.State,   '!!');
  156.        String_Field(7, Cust.Zip,     '#####-####');
  157.        String_Field(8, Cust.Number, '(###) ###-####');
  158.        Field_Rules(8, RightJustify+AllowNull,[#0],[#0]);
  159.        String_Field(9, OurRef,       '!!!!#####');
  160.        Add_Message(9,0,20,'Look in File 63.B - format 4 characters and 5 numbers');
  161.        Date_Field(10, ODate, MMDDYY,'',0,0);
  162.        For I := 1 to 3 do
  163.        begin
  164.            Byte_Field(11+pred(I)*4,  Items[I].Item,     '###', 101,105);
  165.            Field_Rules(11+pred(I)*4, JumpIfFull+SuppressZero+allownull,[#0],[#0]);
  166.            Add_Message(11+pred(I)*4, 0,20, 'Enter 101, 102, 103, 104 or 105');
  167.            Word_Field(12+pred(I)*4,  Items[I].Quantity, '###', 0, 999);
  168.            String_Field(13+pred(I)*4,Items[I].Description, replicate(Big_Field_Width,'*'));
  169.            Real_Field(14+pred(I)*4,  Items[I].Price,    '###.##',0,0);
  170.            Field_Rules(14+pred(I)*4,
  171.                        SuppressZero+RightJustify+AllowNull,
  172.                        [#0],[#0]);
  173.        end;
  174.    end; {of proc Set_Fields}
  175.  
  176.    Procedure Update_Description(ItemNO : byte;var Str : string; Var Price : real);
  177.    begin
  178.        case ItemNo of
  179.        101 : begin
  180.                  Str := 'TechnoJock''s Fiction Toolbox';
  181.                  Price := 49.95;
  182.              end;
  183.        102 : begin
  184.                  Str := 'TechnoJock''s Turbo Toolkit';
  185.                  Price := 49.95;
  186.              end;
  187.        103 : begin
  188.                  Str := 'TechnoJock''s Tutorials';
  189.                  Price := 10.00;
  190.              end;
  191.        104 : begin
  192.                  Str := 'Home Management System';
  193.                  Price := 10.00;
  194.              end;
  195.        105 : begin
  196.                  Str := 'TechnoJock Upgrade';
  197.                  Price := 15.00
  198.              end;
  199.        end;
  200.    end;
  201.  
  202.    Procedure Update_Totals;
  203.    var
  204.       Sub1,Sub2,Sub3 : real;
  205.    begin
  206.        Sub1 := Items[1].Price * Items[1].Quantity;
  207.        Sub2 := Items[2].Price * Items[2].Quantity;
  208.        Sub3 := Items[3].Price * Items[3].Quantity;
  209.        with Screen_Cols do
  210.        begin
  211.            WriteAT(72,15,BoxF,back,PadRight(Real_to_Str(Sub1,2),7,' '));
  212.            WriteAT(72,16,BoxF,back,Padright(Real_to_Str(Sub2,2),7,' '));
  213.            WriteAT(72,17,BoxF,back,Padright(Real_to_Str(Sub3,2),7,' '));
  214.            WriteAT(72,19,BoxF,back,PadRight(Real_to_Str(Sub1+Sub2+Sub3,2),7,' '));
  215.        end;
  216.    end;
  217.  
  218.    Procedure Help;
  219.    const
  220.        X1 = 15;
  221.        Y1 = 5;
  222.        X2 = 65;
  223.        Y2 = 20;
  224.    var Ch : char;
  225.  
  226.    begin
  227.        with Screen_Cols do
  228.        begin
  229.             MkWin(X1,Y1,X2,Y2,FieldHiF,FieldHiB,1);
  230.             WriteBetween(X1,X2,Y1,FieldHiF,FieldHiB,' H E L P ');
  231.             WriteBetween(X1,X2,Y1+(Y2-Y1)div 2,FieldHiF,FieldHiB,'Just imagine there is help!!');
  232.             Ch := GetKey;
  233.             RmWin;
  234.        end;
  235.    end;
  236.  
  237.    {$F+}
  238.    procedure Key_Press_Check(var C : char;var CF:byte; var Refresh:Byte);
  239.    begin
  240.        If C = #187 then
  241.        begin
  242.            Help;
  243.            C := No_Char;
  244.        end;
  245.    end;
  246.  
  247.    Procedure Update_Dependent_Fields(var CF:byte; var Refresh:byte);
  248.    begin
  249.        Case CF of
  250.        11       :     With Items[1] do
  251.                       begin
  252.                            If (Description = '')
  253.                            and (Price = 0.0) then
  254.                            begin
  255.                                Update_Description(Item,Description,Price);
  256.                                Refresh := Refresh_All;
  257.                            end;
  258.                       end;
  259.        15       :     With Items[2] do
  260.                       begin
  261.                            If (Description = '')
  262.                            and (Price = 0.0) then
  263.                            begin
  264.                                Update_Description(Item,Description,Price);
  265.                                Refresh := Refresh_All;
  266.                            end;
  267.                       end;
  268.        19       :     With Items[3] do
  269.                       begin
  270.                            If (Description = '')
  271.                            and (Price = 0.0) then
  272.                            begin
  273.                                Update_Description(Item,Description,Price);
  274.                                Refresh := Refresh_All;
  275.                            end;
  276.                       end;
  277.        12,16,20,
  278.        14,18,24 : begin
  279.                       Update_Totals;
  280.                       Refresh := Refresh_All;
  281.                   end;
  282.        end; {Case}
  283.    end;
  284.    {$F-}
  285.  
  286. begin
  287.     Init_Vars;
  288.     Set_Screen;
  289.     Set_Fields;
  290.     With Table[CurrentTable]^.ITTT do
  291.         ErrorLine := 21;
  292.     Assign_LeaveFieldHook(Update_Dependent_Fields);
  293.     Assign_CharHook(Key_Press_Check);
  294.     Process_Input(11);
  295.     Clrscr;
  296.     WriteAT(1,1,white,black,'Run DemoTTT.exe for the main demo program');
  297.     WriteAT(1,2,white,black,'TechnoJock''s Turbo Toolkit v5.0');
  298.     GotoXY(1,5);
  299. end.
  300.