home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / news / 563 / ocdemo / tdemo.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-09  |  12KB  |  593 lines
  1. {       Here is a copy of your program       }
  2. {          Generated by ObjectCraft          }
  3. {     (c) 1989 - 1993 by ObjectCraft Inc.    }
  4. {    and Object Oriented Technologies Ltd    }
  5.  
  6. {              For Turbo Pascal              }
  7.  
  8.  
  9. uses graph,dos,crt;
  10.  
  11. CONST
  12.     YES=1;
  13.     NO=0;
  14.     MAX_FILES=5;
  15.     SZ_LN=80;
  16.     SZ_FIELD=256;
  17.     MAX_FIELDS=256;
  18.     SZ_FLNM=32;
  19.     SZ_FNAME=64;
  20.     SZ_NAME=40;
  21.  
  22. type
  23.  
  24. { The following code defines your objects: }
  25.  
  26. top=object
  27.     x1pos: integer;
  28.     y1pos: integer;
  29.     x2pos: integer;
  30.     y2pos: integer;
  31.     visible: integer;
  32.     picnum: integer;
  33.     procedure erase;
  34.         procedure setx(newx: integer);
  35.         procedure sety(newy: integer);
  36. end;
  37.  
  38. dbrec= object (top)
  39.         fbreed: char;
  40.         finm: array [0..SZ_FLNM] of char;
  41.         fp: File;
  42.         fn: array[0..MAX_FIELDS] of string[20];
  43.         fs: array[0..MAX_FIELDS] of integer;
  44.         nf: integer;
  45.         ft: array[0..MAX_FIELDS] of char;
  46.         rs: integer;
  47.  
  48.         last: longint;
  49.         latest: longint;
  50.         off: integer;
  51.  
  52.         rend: longint;
  53.         rno: integer;
  54.         nre: integer;
  55.                 procedure reopen0;
  56.     end;
  57.  
  58.  
  59. slot= object(top)
  60.       slotval: integer;
  61. end;
  62.  
  63. sptr=^slot;
  64.  
  65. doneitptr = ^doneit;
  66. targetptr = ^target;
  67. orderptr = ^order;
  68. salestodayptr = ^salestoday;
  69.  
  70. doneit  =  object (top) 
  71.     Click: string;
  72.     Image: string;
  73.     X: integer;
  74.     Y: integer;
  75.     count: integer;
  76.     s_Click: slot;
  77.     s_Image: slot;
  78.     s_X: slot;
  79.     s_Y: slot;
  80.     s_count: slot;
  81.     { Here are methods for doneit: }
  82.     procedure calc_Click (newval: string); virtual;
  83.     procedure calc_Image (newval: string); virtual;
  84.     procedure calc_X (newval: integer); virtual;
  85.     procedure calc_Y (newval: integer); virtual;
  86.     constructor init ( oClick:string; oImage:string; oX:integer;
  87.  oY:integer; ocount:integer);
  88.     procedure draw;
  89. end;
  90.  
  91. target  =  object (top) 
  92.     count: integer;
  93.     y3: integer;
  94.     y2: real;
  95.     y1: real;
  96.     currentv: integer;
  97.     Image: string;
  98.     Y: integer;
  99.     X: integer;
  100.     targetv: integer;
  101.     s_count: slot;
  102.     s_y3: slot;
  103.     s_y2: slot;
  104.     s_y1: slot;
  105.     s_currentv: slot;
  106.     s_Image: slot;
  107.     s_Y: slot;
  108.     s_X: slot;
  109.     s_targetv: slot;
  110.     { Here are methods for target: }
  111.     procedure calc_currentv (newval: integer); virtual;
  112.     procedure calc_Image (newval: string); virtual;
  113.     procedure calc_Y (newval: integer); virtual;
  114.     procedure calc_X (newval: integer); virtual;
  115.     constructor init ( ocount:integer; oy3:integer; oy2:real; oy1:real;
  116.  ocurrentv:integer; oImage:string; oY:integer; oX:integer;
  117.  otargetv:integer);
  118.     procedure draw;
  119. end;
  120.  
  121. order  =  object (top) 
  122.     price: real;
  123.     number: integer;
  124.     total: integer;
  125.     s_price: slot;
  126.     s_number: slot;
  127.     s_total: slot;
  128.     { Here are methods for order: }
  129.     procedure calc_price (newval: real); virtual;
  130.     procedure calc_number (newval: integer); virtual;
  131.     function ftot: integer; virtual;
  132.     constructor init ( oprice:real; onumber:integer; ototal:integer);
  133.     procedure draw;
  134. end;
  135.  
  136. salestoday  =  object (top) 
  137.     salesq: integer;
  138.     salesv: integer;
  139.     s_salesq: slot;
  140.     s_salesv: slot;
  141.     { Here are methods for salestoday: }
  142.     constructor init ( osalesq:integer; osalesv:integer);
  143.     procedure draw;
  144. end;
  145.  
  146. { Here are the definitions for the global variables and constants,
  147.        }
  148. { as well as the code that implements the methods and re-calcs 
  149. attatched }
  150. { to objects. }
  151.  
  152. tptr=^top;
  153.  
  154. CONST
  155.     MAX=100;
  156.         OB=0;
  157.         VAL=1;
  158.     MAX_CHARS=124;
  159. VAR
  160.     olink: array[0..MAX] of tptr;
  161.     p: array[0..MAX] of pointer;
  162.         stype: array[0..MAX] of integer;
  163.     currobject,latestobject: integer;
  164.     filenm: string;
  165.     numcar: integer;
  166.     imname: array[0..MAX] of string;
  167.     currcolor,bkcolor: integer;
  168.     c1_sizes: array[0..MAX_CHARS] of integer;
  169.     c2_sizes: array[0..MAX_CHARS] of integer;
  170.     b1: array[0..MAX_CHARS] of array[0..10] of integer;
  171.     b2: array[0..MAX_CHARS] of array[0..13] of integer;
  172.     currsize: integer;
  173.     dummy_int: integer;
  174.     dummy_float: real;
  175. {$I ovmouse.pas}
  176. {$I ovdb.pas}
  177. {$I ovfns.pas}
  178. {$I ovfont.pas}
  179.  
  180. { Here are the methods for drawing objects on the screen: }
  181.  
  182. procedure doneit.draw;
  183. begin
  184.     mouseoff;
  185.     showsslot (s_Click, Click);
  186.     showsslot (s_Image, Image);
  187.     showislot (s_X, X);
  188.     showislot (s_Y, Y);
  189.     showislot (s_count, count);
  190.     if (visible = YES) then
  191. begin
  192.             picnum: = findname (image);
  193.             showimage (x1pos, y1pos, picnum, 'doneit');
  194.         end;
  195.  
  196.     mouseon;
  197. end;
  198.  
  199. procedure target.draw;
  200. begin
  201.     mouseoff;
  202.     showislot (s_count, count);
  203.     showislot (s_y3, y3);
  204.     showrslot (s_y2, 0, y2);
  205.     showrslot (s_y1, 0, y1);
  206.     showislot (s_currentv, currentv);
  207.     showsslot (s_Image, Image);
  208.     showislot (s_Y, Y);
  209.     showislot (s_X, X);
  210.     showislot (s_targetv, targetv);
  211.     if (visible = YES) then
  212. begin
  213.             picnum: = findname (image);
  214.             showimage (x1pos, y1pos, picnum, 'target');
  215.         end;
  216.  
  217.     mouseon;
  218. end;
  219.  
  220. procedure order.draw;
  221. begin
  222.     mouseoff;
  223.     showrslot (s_price, 2, price);
  224.     showislot (s_number, number);
  225.     showislot (s_total, total);
  226.     mouseon;
  227. end;
  228.  
  229. procedure salestoday.draw;
  230. begin
  231.     mouseoff;
  232.     showislot (s_salesq, salesq);
  233.     showislot (s_salesv, salesv);
  234.     mouseon;
  235. end;
  236.  
  237. {  The following procedure is used to access and modify } 
  238. {  'Click' in object 'doneit':   }
  239.  
  240. procedure doneit.calc_Click (newval: string);
  241.     begin
  242.     if (click = 'YES') then click: = 'NO'
  243.     else click: = 'YES';
  244.     draw;
  245.     if  (click='YES') then calc_image ('done');
  246.     if  (click='NO') then begin
  247.         calc_image ('done1');
  248.         count: = 0;
  249.         draw;
  250.         while  (count<200) do begin
  251.             count: = count+1;
  252.             draw;
  253.         end;
  254.         calc_image ('done');
  255.         calc_click ('YES');
  256.         salestoday.salesq: = salestoday.salesq+order.number;
  257.         salestoday.draw;
  258.         salestoday.salesv: = salestoday.salesv+order.total;
  259.         salestoday.draw;
  260.                 target.calc_currentv (salestoday.salesv);
  261.     end;
  262.     end;
  263.  
  264.  
  265. {  The following procedure is used to access and modify } 
  266. {  'Image' in object 'doneit':   }
  267.  
  268. procedure doneit.calc_Image (newval: string);
  269.     begin
  270.     Image: = newval;
  271.     draw;
  272.     draw ;
  273.     end;
  274.  
  275.  
  276. {  The following procedure is used to access and modify } 
  277. {  'X' in object 'doneit':   }
  278.  
  279. procedure doneit.calc_X (newval: integer);
  280.     begin
  281.     X: = newval;
  282.     draw;
  283.     erase ;
  284.     setx (x);
  285.     draw ;
  286.     end;
  287.  
  288.  
  289. {  The following procedure is used to access and modify } 
  290. {  'Y' in object 'doneit':   }
  291.  
  292. procedure doneit.calc_Y (newval: integer);
  293.     begin
  294.     Y: = newval;
  295.     draw;
  296.     erase ;
  297.     sety (y);
  298.     draw ;
  299.     end;
  300.  
  301.  
  302. {  The following procedure is used to access and modify } 
  303. {  'currentv' in object 'target':   }
  304.  
  305. procedure target.calc_currentv (newval: integer);
  306.     begin
  307.     currentv: = newval;
  308.     draw;
  309.     color(2);
  310.     y2: = 130*currentv;
  311.     draw;
  312.     if  (currentv>targetv) then y2: = 130*targetv;
  313.     draw;
  314.     y1: = y-(y2/targetv);
  315.     draw;
  316.     y3: = round(y1);
  317.     draw;
  318.     rectangle(x,y3,x+20,y);
  319.     if  (currentv>targetv) then begin
  320.         color(14);
  321.         count: = 0;
  322.         draw;
  323.         while  (count<300) do begin
  324.             count: = count+1;
  325.             draw;
  326.         end;
  327.         rectangle(x,y3,x+20,y);
  328.         color(2);
  329.         count: = 0;
  330.         draw;
  331.         while  (count<150) do begin
  332.             count: = count+1;
  333.             draw;
  334.         end;
  335.         rectangle(x,y3,x+20,y);
  336.         color(14);
  337.         count: = 0;
  338.         draw;
  339.         while  (count<300) do begin
  340.             count: = count+1;
  341.             draw;
  342.         end;
  343.         rectangle(x,y3,x+20,y);
  344.         color(2);
  345.         count: = 0;
  346.         draw;
  347.         while  (count<150) do begin
  348.             count: = count+1;
  349.             draw;
  350.         end;
  351.         rectangle(x,y3,x+20,y);
  352.     end;
  353.     end;
  354.  
  355.  
  356. {  The following procedure is used to access and modify } 
  357. {  'Image' in object 'target':   }
  358.  
  359. procedure target.calc_Image (newval: string);
  360.     begin
  361.     Image: = newval;
  362.     draw;
  363.     draw ;
  364.     end;
  365.  
  366.  
  367. {  The following procedure is used to access and modify } 
  368. {  'Y' in object 'target':   }
  369.  
  370. procedure target.calc_Y (newval: integer);
  371.     begin
  372.     Y: = newval;
  373.     draw;
  374.     erase ;
  375.     sety (y);
  376.     draw ;
  377.     end;
  378.  
  379.  
  380. {  The following procedure is used to access and modify } 
  381. {  'X' in object 'target':   }
  382.  
  383. procedure target.calc_X (newval: integer);
  384.     begin
  385.     X: = newval;
  386.     draw;
  387.     erase ;
  388.     setx (x);
  389.     draw ;
  390.     end;
  391.  
  392.  
  393. {  The following procedure is used to access and modify } 
  394. {  'price' in object 'order':   }
  395.  
  396. procedure order.calc_price (newval: real);
  397.     begin
  398.     price: = newval;
  399.     draw;
  400.     dummy_int: = ftot;
  401.     end;
  402.  
  403.  
  404. {  The following procedure is used to access and modify } 
  405. {  'number' in object 'order':   }
  406.  
  407. procedure order.calc_number (newval: integer);
  408.     begin
  409.     number: = newval;
  410.     draw;
  411.     ftot ;
  412.     end;
  413.  
  414.  
  415.  
  416. { Here is the routine to handle data entry into slotst shown on the 
  417. screen: }
  418.  
  419. procedure vput(n: integer; tword: string);
  420. var
  421.     r: real;
  422.     i,code: integer;
  423.     cword: string;
  424. begin
  425.  
  426. end;
  427.  
  428. { Here is the constructor for the 'doneit' class: }
  429.  
  430. constructor doneit.init ( oClick:string; oImage:string; oX:integer;
  431.  oY:integer; ocount:integer);
  432. begin
  433.     Click: = oClick;
  434.     s_Click.visible: = 0;
  435.     Image: = oImage;
  436.     s_Image.visible: = 0;
  437.     X: = oX;
  438.     s_X.visible: = 0;
  439.     Y: = oY;
  440.     s_Y.visible: = 0;
  441.     count: = ocount;
  442.     s_count.visible: = 0;
  443.  
  444. end;
  445.  
  446. { Here is the constructor for the 'target' class: }
  447.  
  448. constructor target.init ( ocount:integer; oy3:integer; oy2:real;
  449.  oy1:real; ocurrentv:integer; oImage:string; oY:integer; oX:integer;
  450.  otargetv:integer);
  451. begin
  452.     count: = ocount;
  453.     s_count.visible: = 0;
  454.     y3: = oy3;
  455.     s_y3.visible: = 0;
  456.     y2: = oy2;
  457.     s_y2.visible: = 0;
  458.     y1: = oy1;
  459.     s_y1.visible: = 0;
  460.     currentv: = ocurrentv;
  461.     s_currentv.visible: = 0;
  462.     Image: = oImage;
  463.     s_Image.visible: = 0;
  464.     Y: = oY;
  465.     s_Y.visible: = 0;
  466.     X: = oX;
  467.     s_X.visible: = 0;
  468.     targetv: = otargetv;
  469.     s_targetv.visible: = 0;
  470.  
  471. end;
  472.  
  473. { Here is the constructor for the 'order' class: }
  474.  
  475. constructor order.init ( oprice:real; onumber:integer;
  476.  ototal:integer);
  477. begin
  478.     price: = oprice;
  479.     s_price.visible: = 0;
  480.     number: = onumber;
  481.     s_number.visible: = 0;
  482.     total: = ototal;
  483.     s_total.visible: = 0;
  484.  
  485. end;
  486. function order.ftot: integer;
  487. begin
  488.     total: = price*number;
  489.     draw;
  490. end;
  491.  
  492.  
  493. { Here is the constructor for the 'salestoday' class: }
  494.  
  495. constructor salestoday.init ( osalesq:integer; osalesv:integer);
  496. begin
  497.     salesq: = osalesq;
  498.     s_salesq.visible: = 0;
  499.     salesv: = osalesv;
  500.     s_salesv.visible: = 0;
  501.  
  502. end;
  503. { Here is the main program which will initalize the system and start 
  504. it up }
  505. var
  506.  
  507. Mode,Driver: integer;
  508. m1,m2,m3,m4,m5: integer;
  509. n1,n: integer;
  510.  
  511. begin
  512.     currcolor:=0;
  513.     currobject:=0;
  514.     latestobject:=0;
  515.     Driver:=VGA;
  516.     Mode:=1;
  517.     InitGraph(Driver,Mode,'');
  518.     mreset;
  519.     mouseoff;
  520.  
  521.  
  522.     filenm: = 'demob';
  523.     readim;
  524.     read_in_fonts;
  525.     setbkcolor (0);
  526.  
  527. { Here are the constructor calls to initialize instance objects: }
  528.  
  529.     bkcolor: = 3;
  530.     currsize: = 0;
  531.     setfillstyle (1, bkcolor);
  532.     bar (0, 0, max_x, 349);
  533.     setfillstyle (1, 8);
  534.     bar (55, 35, 244, 191);
  535.     color (14);
  536.     setsize (0);
  537.     disp_string ('Please enter order information', 76, 47);
  538.     color (15);
  539.     setsize (0);
  540.     disp_string ('Price of part -', 66, 72);
  541.     color (15);
  542.     setsize (0);
  543.     disp_string ('Number of units -', 66, 96);
  544.     color (15);
  545.     setsize (0);
  546.     disp_string ('Total price of order -', 66, 122);
  547.     color (15);
  548.     setsize (0);
  549.     disp_string ('Today's sales so far', 67, 150);
  550.     setfillstyle (1, 4);
  551.     bar (207, 10, 339, 23);
  552.     color (14);
  553.     setsize (0);
  554.     disp_string ('ObjectCraft parts system', 215, 12);
  555.     setfillstyle (1, 4);
  556.     bar (60, 144, 235, 184);
  557.     color (11);
  558.     setsize (0);
  559.     disp_string ('Quantity', 66, 169);
  560.     color (11);
  561.     setsize (0);
  562.     disp_string ('Value', 154, 170);
  563.     setfillstyle (1, 1);
  564.     bar (462, 34, 505, 190);
  565.     color (15);
  566.     setsize (0);
  567.     disp_string ('Today's target ($)', 353, 38);
  568.     setfillstyle (1, 8);
  569.     bar (349, 34, 517, 190);
  570.     setfillstyle (1, 15);
  571.     line (500, 174, 504, 174);
  572.     setfillstyle (1, 15);
  573.     line (500, 86, 505, 86);
  574.     setfillstyle (1, 15);
  575.     line (500, 40, 504, 40);
  576.     setfillstyle (1, 15);
  577.     line (500, 131, 505, 131);
  578.     color (15);
  579.     setsize (0);
  580.     disp_string ('So far', 353, 114);
  581.     mouseon;
  582.     salestoday.salesv: = 0;
  583.     salestoday.draw;
  584.     salestoday.salesq: = 0;
  585.     salestoday.draw;
  586.     target.targetv: = 3000;
  587.     target.draw;
  588.         target.calc_currentv (0);
  589. { Here is them main event loop: }
  590.     while (getclick=1) do;
  591.     CloseGraph;
  592. end.
  593.