home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / tvision / ide / calc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-25  |  7.3 KB  |  270 lines

  1. (* ------------------------------------------------------ *)
  2. (*                        CALC.PAS                        *)
  3. (*                                                        *)
  4. (*   Calculator object. See TVDEMO.PAS for an example     *)
  5. (*   program that uses this unit.                         *)
  6. (*                                                        *)
  7. (*                    Turbo Vision Demo                   *)
  8. (*      Copyright (c) 1990 by Borland International       *)
  9. (* ------------------------------------------------------ *)
  10. UNIT Calc;
  11.  
  12. {$F+,O+,S-}
  13.  
  14. INTERFACE
  15.  
  16. USES Drivers, Objects, Views, Dialogs;
  17.  
  18. TYPE
  19.   tCalcState     = (csFirst, csValid, csError);
  20.  
  21.   pCalcDisplay   = ^tCalcDisplay;
  22.   tCalcDisplay   = OBJECT (tView)
  23.     Status   : tCalcState;
  24.     Number   : STRING [15];
  25.     Sign     : CHAR;
  26.     Operator : CHAR;
  27.     Operand  : REAL;
  28.  
  29.     CONSTRUCTOR Init(VAR Bounds : tRect);
  30.     CONSTRUCTOR Load(VAR S : tStream);
  31.     PROCEDURE   CalcKey(Key : CHAR);
  32.     PROCEDURE   Clear;
  33.     PROCEDURE   Draw;                             VIRTUAL;
  34.     FUNCTION    GetPalette : pPalette;            VIRTUAL;
  35.     PROCEDURE   HandleEvent(VAR Event : tEvent);  VIRTUAL;
  36.     PROCEDURE   Store(VAR S : tStream);
  37.   END;
  38.  
  39.   pCalculator    = ^tCalculator;
  40.   tCalculator    = OBJECT (tDialog)
  41.     CONSTRUCTOR Init;
  42.   END;
  43.  
  44. CONST
  45.   rCalcDisplay : tStreamRec = (
  46.     ObjType : 10040;
  47.     VmtLink : Ofs(TypeOf(tCalcDisplay)^);
  48.     Load    : @tCalcDisplay.Load;
  49.     Store   : @tCalcDisplay.Store);
  50.  
  51.   rCalculator : tStreamRec = (
  52.     ObjType : 10041;
  53.     VmtLink : Ofs(TypeOf(tCalculator)^);
  54.     Load    : @TCalculator.Load;
  55.     Store   : @TCalculator.Store);
  56.  
  57.   PROCEDURE RegisterCalc;
  58.  
  59. (* ------------------------------------------------------ *)
  60.  
  61. IMPLEMENTATION
  62.  
  63. CONST
  64.   cmCalcButton   = 100;
  65.  
  66.   CONSTRUCTOR tCalcDisplay.Init(VAR Bounds : tRect);
  67.   BEGIN
  68.     inherited Init(Bounds);
  69.     Options   := Options OR ofSelectable;
  70.     EventMask := evKeyDown + evBroadcast;
  71.     Clear;
  72.   END;
  73.  
  74.   CONSTRUCTOR tCalcDisplay.Load(VAR S : tStream);
  75.   BEGIN
  76.     inherited Load(S);
  77.     S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
  78.            SizeOf(Operator) + SizeOf(Operand));
  79.   END;
  80.  
  81.   PROCEDURE tCalcDisplay.CalcKey(Key : CHAR);
  82.   VAR
  83.     R : REAL;
  84.  
  85.     PROCEDURE Error;
  86.     BEGIN
  87.       Status := csError;
  88.       Number := 'Error';
  89.       Sign   := ' ';
  90.     END;
  91.  
  92.     PROCEDURE SetDisplay(R : REAL);
  93.     VAR
  94.       S : STRING [63];
  95.     BEGIN
  96.       Str(R:0:10, S);
  97.       IF S[1] <> '-' THEN
  98.         Sign := ' '
  99.       ELSE BEGIN
  100.         Delete(S, 1, 1);
  101.         Sign := '-';
  102.       END;
  103.       IF Length(S) > 15 + 1 + 10 THEN
  104.         Error
  105.       ELSE BEGIN
  106.         WHILE S[Length(S)] = '0' DO Dec(S[0]);
  107.         IF S[Length(S)] = '.' THEN Dec(S[0]);
  108.         Number := S;
  109.       END;
  110.     END;
  111.  
  112.     PROCEDURE GetDisplay(VAR R : REAL);
  113.     VAR
  114.       E : INTEGER;
  115.     BEGIN
  116.       Val(Sign + Number, R, E);
  117.     END;
  118.  
  119.     PROCEDURE CheckFirst;
  120.     BEGIN
  121.       IF Status = csFirst THEN BEGIN
  122.         Status := csValid;
  123.         Number := '0';
  124.         Sign   := ' ';
  125.       END;
  126.     END;
  127.  
  128.   BEGIN
  129.     Key := UpCase(Key);
  130.     IF (Status = csError) AND (Key <> 'C') THEN Key := ' ';
  131.     CASE Key OF
  132.       '0'..'9'  : BEGIN
  133.                     CheckFirst;
  134.                     IF Number = '0' THEN Number := '';
  135.                     Number := Number + Key;
  136.                   END;
  137.       '.'       : BEGIN
  138.                     CheckFirst;
  139.                     IF Pos ('.', Number) = 0 THEN
  140.                       Number := Number + '.';
  141.                   END;
  142.       #8, #27   : BEGIN
  143.                     CheckFirst;
  144.                     IF Length(Number) = 1 THEN
  145.                       Number := '0'
  146.                     ELSE
  147.                       Dec(Number[0]);
  148.                   END;
  149.       '_', #241 : IF Sign = ' ' THEN
  150.                     Sign := '-'
  151.                   ELSE
  152.                     Sign := ' ';
  153.       '+', '-',
  154.       '*', '/',
  155.       '=', '%',
  156.       #13       : BEGIN
  157.                     IF Status = csValid THEN BEGIN
  158.                       Status := csFirst;
  159.                       GetDisplay(R);
  160.                       IF Key = '%' THEN
  161.                         CASE Operator OF
  162.                           '+', '-' : R := Operand * R / 100;
  163.                           '*', '/' : R := R / 100;
  164.                         END;
  165.                       CASE Operator OF
  166.                         '+' : SetDisplay(Operand + R);
  167.                         '-' : SetDisplay(Operand - R);
  168.                         '*' : SetDisplay(Operand * R);
  169.                         '/' : IF R = 0 THEN
  170.                                 Error
  171.                               ELSE
  172.                                 SetDisplay(Operand / R);
  173.                       END;
  174.                     END;
  175.                     Operator := Key;
  176.                     GetDisplay(Operand);
  177.                   END;
  178.       'C'       : Clear;
  179.     END;
  180.     DrawView;
  181.   END;
  182.  
  183.   PROCEDURE tCalcDisplay.Clear;
  184.   BEGIN
  185.     Status   := csFirst;
  186.     Number   := '0';
  187.     Sign     := ' ';
  188.     Operator := '=';
  189.   END;
  190.  
  191.   PROCEDURE tCalcDisplay.Draw;
  192.   VAR
  193.     Color : BYTE;
  194.     i     : INTEGER;
  195.     B     : tDrawBuffer;
  196.   BEGIN
  197.     Color := GetColor(1);
  198.     i     := Size.X - Length(Number) - 2;
  199.     MoveChar(B, ' ', Color, Size.X);
  200.     MoveChar(B[i], Sign, Color, 1);
  201.     MoveStr(B[i + 1], Number, Color);
  202.     WriteBuf(0, 0, Size.X, 1, B);
  203.   END;
  204.  
  205.   FUNCTION tCalcDisplay.GetPalette : pPalette;
  206.   CONST
  207.     P : STRING [1] = #19;
  208.   BEGIN
  209.     GetPalette := @P;
  210.   END;
  211.  
  212.   PROCEDURE tCalcDisplay.HandleEvent(VAR Event : tEvent);
  213.   BEGIN
  214.     inherited HandleEvent(Event);
  215.     CASE Event.What OF
  216.       evKeyDown   : BEGIN
  217.                       CalcKey(Event.CharCode);
  218.                       ClearEvent(Event);
  219.                     END;
  220.       evBroadcast : IF Event.Command = cmCalcButton THEN BEGIN
  221.                       CalcKey(pButton(Event.InfoPtr)^.Title^[1]);
  222.                       ClearEvent(Event);
  223.                     END;
  224.     END;
  225.   END;
  226.  
  227.   PROCEDURE tCalcDisplay.Store(VAR S : tStream);
  228.   BEGIN
  229.     tView.Store(S);
  230.     S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
  231.             SizeOf(Operator) + SizeOf(Operand));
  232.   END;
  233.  
  234.   { --- tCalculator -------------------------------------- }
  235.  
  236.   CONSTRUCTOR tCalculator.Init;
  237.   CONST
  238.     KeyChar : ARRAY [0..19] OF CHAR = 'C'#27'%'#241'789/456*123-0.=+';
  239.   VAR
  240.     I : INTEGER;
  241.     P : pVIew;
  242.     R : tRect;
  243.   BEGIN
  244.     R.Assign(5, 3, 29, 18);
  245.     inherited Init(R, 'Calculator');
  246.     Options := Options OR ofFirstClick;
  247.     FOR I := 0 TO 19 DO BEGIN
  248.       R.A.X := (I MOD 4) * 5 + 2;
  249.       R.A.Y := (I DIV 4) * 2 + 4;
  250.       R.B.X := R.A.X + 5;
  251.       R.B.Y := R.A.Y + 2;
  252.       P := New(pButton, Init(R, KeyChar[I], cmCalcButton,
  253.                              bfNormal + bfBroadcast));
  254.       P^.Options := P^.Options AND NOT ofSelectable;
  255.       Insert(P);
  256.     END;
  257.     R.Assign(3, 2, 21, 3);
  258.     Insert(New(pCalcDisplay, Init(R)));
  259.   END;
  260.  
  261.   PROCEDURE RegisterCalc;
  262.   BEGIN
  263.     RegisterType(rCalcDisplay);
  264.     RegisterType(rCalculator);
  265.   END;
  266.  
  267. END.
  268. (* ------------------------------------------------------ *)
  269. (*                   Ende von CALC.PAS                    *)
  270.