home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / tvision / ide / hexcalc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-28  |  13.8 KB  |  454 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   HEXCALC.PAS                          *)
  3. (*     Nachbau von Charles Petzolds Windows-Hexcalc       *)
  4. (*     (Programming Windows, Microsoft Press, 1990)       *)
  5. (*             (c) 1993 te-wi Verlag, München             *)
  6. (* ------------------------------------------------------ *)
  7. UNIT HexCalc;
  8.  
  9. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
  10. {$M 16384,0,655360}
  11.  
  12. INTERFACE
  13.  
  14. USES Objects, Drivers, Views, Menus, MsgBox, Dialogs, App;
  15.  
  16. CONST
  17.   cmCalc       = 10000;
  18.  
  19. (* --- tPetzCalcDisplay Object ------------------------------ *)
  20.  
  21. TYPE
  22.   tCalcState = (csFirst, csValid, csError);
  23.  
  24.   pPetzCalcDisplay = ^tPetzCalcDisplay;
  25.   tPetzCalcDisplay = OBJECT (tView)
  26.     Status   : tCalcState;
  27.     Number   : STRING [20];
  28.     Operator : CHAR;
  29.     Operand  : LONGINT;
  30.  
  31.     CONSTRUCTOR Init(VAR Bounds : tRect);
  32.     CONSTRUCTOR Load(VAR S : tStream);
  33.     PROCEDURE   HandleEvent(VAR Event : tEvent);  VIRTUAL;
  34.     FUNCTION    GetPalette : pPalette;            VIRTUAL;
  35.     PROCEDURE   Draw;                             VIRTUAL;
  36.     PROCEDURE   Clear;
  37.     PROCEDURE   CalcKey(Key : CHAR);
  38.     PROCEDURE   Store(VAR S : tStream);
  39.   END;
  40.  
  41. TYPE
  42.   pPetzCalc = ^tPetzCalc;
  43.   tPetzCalc = OBJECT (tDialog)
  44.     CONSTRUCTOR Init;
  45.   END;
  46.  
  47. (* --- HexCalc Registration Record ---------------------- *)
  48.  
  49. CONST
  50.   rPetzCalcDisplay : tStreamRec = (
  51.     ObjType : 10180;      (* Visions CALC.PAS hat 10040 *)
  52.     VmtLink : Ofs(TypeOf(tPetzCalcDisplay)^);
  53.     Load    : @tPetzCalcDisplay.Load;
  54.     Store   : @tPetzCalcDisplay.Store);
  55.  
  56.   rPetzCalc : tStreamRec = (
  57.     ObjType : 10181;
  58.     VmtLink : Ofs(TypeOf(tPetzCalc)^);
  59.     Load    : @tPetzCalc.Load;
  60.     Store   : @tPetzCalc.Store);
  61.  
  62.   PROCEDURE RegisterPetzCalc;
  63.  
  64. IMPLEMENTATION
  65.  
  66. CONST
  67.   cmCalcButton = cmCalc + 1;
  68.  
  69.   CONSTRUCTOR tPetzCalcDisplay.Init(VAR Bounds : tRect);
  70.   BEGIN
  71.     inherited Init(Bounds);
  72.     Options   := Options   OR ofSelectable;
  73.     EventMask := evKeyDown OR evBroadCast;
  74.     Clear;
  75.   END;
  76.  
  77.   CONSTRUCTOR tPetzCalcDisplay.Load(VAR S : tStream);
  78.   BEGIN
  79.     inherited Load(S);
  80.     S.Read(Status, SizeOf(Status) + SizeOf(Number) +
  81.                    SizeOf(Operator) + SizeOf(Operand));
  82.   END;
  83.  
  84.   FUNCTION tPetzCalcDisplay.GetPalette : pPalette;
  85.   CONST
  86.     P : STRING [1] = #19;
  87.   BEGIN
  88.     GetPalette := @P;
  89.   END;
  90.  
  91.   PROCEDURE tPetzCalcDisplay.Draw;
  92.     (* aktualisiert das Display. Wird z.B. auch von Clear
  93.        benötigt, sonst passiert schon bei der Initialisierung
  94.        gar nichts. *)
  95.   VAR
  96.     Color : BYTE;
  97.     i     : INTEGER;
  98.     B     : tDrawBuffer;
  99.   BEGIN
  100.     Color := GetColor(1);
  101.     i     := Size.X - Length(Number) - 2;
  102.     MoveChar(B, ' ', Color, Size.X);
  103.     MoveStr(B[i], Number, Color);
  104.     WriteBuf(0, 0, Size.X, 1, B);
  105.   END;
  106.  
  107.   PROCEDURE tPetzCalcDisplay.Clear;
  108.   BEGIN
  109.     Status  := csFirst;
  110.     Number  := '0';
  111.   END;
  112.  
  113.   PROCEDURE tPetzCalcDisplay.CalcKey(Key : CHAR);
  114.   VAR
  115.     R : LONGINT;
  116.  
  117.     PROCEDURE Error(s : STRING);
  118.     BEGIN
  119.       Status  := csError;
  120.       Number := s;
  121.     END;
  122.  
  123.     PROCEDURE CheckFirst;
  124.     BEGIN
  125.       IF Status = csFirst THEN BEGIN
  126.         Status  := csValid;
  127.         Number := '0';
  128.       END;
  129.     END;
  130.  
  131.     PROCEDURE GetDisplay(VAR LI : LONGINT);
  132.     VAR
  133.       E : INTEGER;
  134.     BEGIN
  135.       Val('$' + Number, LI, E);  (* Hex -> Dezimal *)
  136.     END;
  137.  
  138.     FUNCTION HexByte(b : BYTE) : STRING;
  139.     CONST
  140.       H : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  141.     BEGIN
  142.       HexByte[0] := #2;
  143.       HexByte[1] := H[b DIV 16];
  144.       HexByte[2] := H[b MOD 16];
  145.     END;
  146.  
  147.     FUNCTION HexWord(w : WORD) : STRING;
  148.     BEGIN
  149.       HexWord := HexByte(w DIV 256) + HexByte(w MOD 256);
  150.     END;
  151.  
  152.     PROCEDURE SetDisplay(Li : LONGINT);
  153.     VAR
  154.       L  : RECORD Hi, Lo : WORD; END ABSOLUTE Li;
  155.     BEGIN
  156.       Number := HexWord(L.Lo) + HexWord(L.Hi);
  157.     END;
  158.  
  159.   BEGIN
  160.     Key := UpCase(Key);
  161.     IF (Status = csError) AND (Key <> 'L') THEN Key := ' ';
  162.     CASE Key OF
  163.       '0'..'9',
  164.       'A'..'F'   : BEGIN
  165.                      CheckFirst;
  166.                      IF Number = '0' THEN Number := '';
  167.                      Number := Number + Key;
  168.                    END;
  169.       #8, #27    : BEGIN
  170.                      CheckFirst;
  171.                      IF Length(Number) = 1 THEN
  172.                        Number := '0'
  173.                      ELSE
  174.                        Dec(Number[0]);
  175.                    END;
  176.       'L'        : Clear;
  177.       '+', '-',
  178.       '*', '/',
  179.       '%', '&',
  180.       '|', '^',
  181.       '<', '>',
  182.       '=', #13   : BEGIN
  183.         IF Status = csValid THEN BEGIN
  184.           Status := csFirst;
  185.           GetDisplay(R);
  186.           CASE Operator OF
  187.             '+'      : SetDisplay(Operand + R);
  188.             '-'      : SetDisplay(Operand - R);
  189.             '*'      : SetDisplay(Operand * R);
  190.             '/'      : IF R <> 0 THEN
  191.                          SetDisplay(Operand DIV R)
  192.                        ELSE
  193.                          Error('division by zero');
  194.             '%'      : IF R <> 0 THEN
  195.                          SetDisplay(Operand MOD R)
  196.                        ELSE
  197.                          Error('division by zero');
  198.             '&'      : SetDisplay(Operand AND R);
  199.             '|'      : SetDisplay(Operand OR  R);
  200.             '<'      : SetDisplay(Operand SHL R);
  201.             '>'      : SetDisplay(Operand SHR R);
  202.  
  203. (* --- Baustelle ------- *)
  204.             '^'      : ; (* aktivieren der zweiten display-zeile *)
  205. (* --------------------- *)
  206.  
  207.             '=', #13 : (* do nothing *) ;
  208.           END;
  209.         END;
  210.         Operator := Key;
  211.         GetDisplay(Operand);
  212.       END;
  213.     END;
  214.     DrawView;
  215.   END;
  216.  
  217.   PROCEDURE tPetzCalcDisplay.HandleEvent(VAR Event : tEvent);
  218.   BEGIN
  219.     inherited HandleEvent(Event);
  220.  
  221.     CASE Event.What OF
  222.       evKeyDown   : CalcKey(Event.CharCode);
  223.       evBroadCast : IF Event.Command = cmCalcButton THEN BEGIN
  224.                       CalcKey(pButton(Event.InfoPtr)^.Title^[1]);
  225.                     END;
  226.     ELSE
  227.       Exit;
  228.     END;
  229.     ClearEvent(Event);
  230.   END;
  231.  
  232.   PROCEDURE tPetzCalcDisplay.Store(VAR S : tStream);
  233.   BEGIN
  234.     inherited Store(S);
  235.     S.Write(Status, SizeOf(Status) + SizeOf(Number) +
  236.                     SizeOf(Operator) + SizeOf(Operand));
  237.   END;
  238.  
  239. (* --- tPetzCalc Object --------------------------------- *)
  240.  
  241.   CONSTRUCTOR tPetzCalc.Init;
  242.   VAR
  243.     i : INTEGER;
  244.     P : pView;
  245.     R : tRect;
  246.   BEGIN
  247.     R.Assign(5, 3, 35, 21);
  248.     inherited Init(R, 'Hex Calculator');
  249.     Options := Options OR ofFirstClick;
  250.  
  251. (* --- Knopfzeile 1 ------------------------------------- *)
  252.  
  253.     R.A.X := 2;          R.A.Y := 5;
  254.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  255.     P := New(pButton, Init(R, 'D', cmCalcButton, bfNormal + bfBroadcast));
  256.     P^.Options := P^.Options AND NOT ofSelectable;
  257.     Insert(P);
  258.  
  259.     R.A.X := 7;          R.A.Y := 5;
  260.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  261.     P := New(pButton, Init(R, 'E', cmCalcButton, bfNormal + bfBroadcast));
  262.     P^.Options := P^.Options AND NOT ofSelectable;
  263.     Insert(P);
  264.  
  265.     R.A.X := 12;          R.A.Y := 5;
  266.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  267.     P := New(pButton, Init(R, 'F', cmCalcButton, bfNormal + bfBroadcast));
  268.     P^.Options := P^.Options AND NOT ofSelectable;
  269.     Insert(P);
  270.  
  271.     R.A.X := 17;          R.A.Y := 5;
  272.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  273.     P := New(pButton, Init(R, '+', cmCalcButton, bfNormal + bfBroadcast));
  274.     P^.Options := P^.Options AND NOT ofSelectable;
  275.     Insert(P);
  276.  
  277.     R.A.X := 22;          R.A.Y := 5;
  278.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  279.     P := New(pButton, Init(R, '&', cmCalcButton, bfNormal + bfBroadcast));
  280.     P^.Options := P^.Options AND NOT ofSelectable;
  281.     Insert(P);
  282.  
  283. (* --- Knopfzeile 2 ------------------------------------- *)
  284.  
  285.     R.A.X := 2;          R.A.Y := 7;
  286.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  287.     P := New(pButton, Init(R, 'A', cmCalcButton, bfNormal + bfBroadcast));
  288.     P^.Options := P^.Options AND NOT ofSelectable;
  289.     Insert(P);
  290.  
  291.     R.A.X := 7;          R.A.Y := 7;
  292.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  293.     P := New(pButton, Init(R, 'B', cmCalcButton, bfNormal + bfBroadcast));
  294.     P^.Options := P^.Options AND NOT ofSelectable;
  295.     Insert(P);
  296.  
  297.     R.A.X := 12;         R.A.Y := 7;
  298.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  299.     P := New(pButton, Init(R, 'C', cmCalcButton, bfNormal + bfBroadcast));
  300.     P^.Options := P^.Options AND NOT ofSelectable;
  301.     Insert(P);
  302.  
  303.     R.A.X := 17;         R.A.Y := 7;
  304.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  305.     P := New(pButton, Init(R, '-', cmCalcButton, bfNormal + bfBroadcast));
  306.     P^.Options := P^.Options AND NOT ofSelectable;
  307.     Insert(P);
  308.  
  309.     R.A.X := 22;         R.A.Y := 7;
  310.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  311.     P := New(pButton, Init(R, '|', cmCalcButton, bfNormal + bfBroadcast));
  312.     P^.Options := P^.Options AND NOT ofSelectable;
  313.     Insert(P);
  314.  
  315. (* --- Knopfzeile 3 ------------------------------------- *)
  316.  
  317.     R.A.X := 2;          R.A.Y := 9;
  318.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  319.     P := New(pButton, Init(R, '7', cmCalcButton, bfNormal + bfBroadcast));
  320.     P^.Options := P^.Options AND NOT ofSelectable;
  321.     Insert(P);
  322.  
  323.     R.A.X := 7;          R.A.Y := 9;
  324.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  325.     P := New(pButton, Init(R, '8', cmCalcButton, bfNormal + bfBroadcast));
  326.     P^.Options := P^.Options AND NOT ofSelectable;
  327.     Insert(P);
  328.  
  329.     R.A.X := 12;         R.A.Y := 9;
  330.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  331.     P := New(pButton, Init(R, '9', cmCalcButton, bfNormal + bfBroadcast));
  332.     P^.Options := P^.Options AND NOT ofSelectable;
  333.     Insert(P);
  334.  
  335.     R.A.X := 17;         R.A.Y := 9;
  336.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  337.     P := New(pButton, Init(R, '*', cmCalcButton, bfNormal + bfBroadcast));
  338.     P^.Options := P^.Options AND NOT ofSelectable;
  339.     Insert(P);
  340.  
  341.     R.A.X := 22;         R.A.Y := 9;
  342.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  343.     P := New(pButton, Init(R, '^', cmCalcButton, bfNormal + bfBroadcast));
  344.     P^.Options := P^.Options AND NOT ofSelectable;
  345.     Insert(P);
  346.  
  347. (* --- Knopfzeile 4 ------------------------------------- *)
  348.  
  349.     R.A.X := 2;          R.A.Y := 11;
  350.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  351.     P := New(pButton, Init(R, '4', cmCalcButton, bfNormal + bfBroadcast));
  352.     P^.Options := P^.Options AND NOT ofSelectable;
  353.     Insert(P);
  354.  
  355.     R.A.X := 7;          R.A.Y := 11;
  356.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  357.     P := New(pButton, Init(R, '5', cmCalcButton, bfNormal + bfBroadcast));
  358.     P^.Options := P^.Options AND NOT ofSelectable;
  359.     Insert(P);
  360.  
  361.     R.A.X := 12;         R.A.Y := 11;
  362.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  363.     P := New(pButton, Init(R, '6', cmCalcButton, bfNormal + bfBroadcast));
  364.     P^.Options := P^.Options AND NOT ofSelectable;
  365.     Insert(P);
  366.  
  367.     R.A.X := 17;         R.A.Y := 11;
  368.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  369.     P := New(pButton, Init(R, '/', cmCalcButton, bfNormal + bfBroadcast));
  370.     P^.Options := P^.Options AND NOT ofSelectable;
  371.     Insert(P);
  372.  
  373.     R.A.X := 22;         R.A.Y := 11;
  374.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  375.     P := New(pButton, Init(R, '<', cmCalcButton, bfNormal + bfBroadcast));
  376.     P^.Options := P^.Options AND NOT ofSelectable;
  377.     Insert(P);
  378.  
  379. (* --- Knopfzeile 5 ------------------------------------- *)
  380.  
  381.     R.A.X := 2;          R.A.Y := 13;
  382.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  383.     P := New(pButton, Init(R, '1', cmCalcButton, bfNormal + bfBroadcast));
  384.     P^.Options := P^.Options AND NOT ofSelectable;
  385.     Insert(P);
  386.  
  387.     R.A.X := 7;          R.A.Y := 13;
  388.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  389.     P := New(pButton, Init(R, '2', cmCalcButton, bfNormal + bfBroadcast));
  390.     P^.Options := P^.Options AND NOT ofSelectable;
  391.     Insert(P);
  392.  
  393.     R.A.X := 12;         R.A.Y := 13;
  394.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  395.     P := New(pButton, Init(R, '3', cmCalcButton, bfNormal + bfBroadcast));
  396.     P^.Options := P^.Options AND NOT ofSelectable;
  397.     Insert(P);
  398.  
  399.     R.A.X := 17;         R.A.Y := 13;
  400.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  401.     P := New(pButton, Init(R, '%', cmCalcButton, bfNormal + bfBroadcast));
  402.     P^.Options := P^.Options AND NOT ofSelectable;
  403.     Insert(P);
  404.  
  405.     R.A.X := 22;         R.A.Y := 13;
  406.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  407.     P := New(pButton, Init(R, '>', cmCalcButton, bfNormal + bfBroadcast));
  408.     P^.Options := P^.Options AND NOT ofSelectable;
  409.     Insert(P);
  410.  
  411. (* --- Knopfzeile 6 ------------------------------------- *)
  412.  
  413.     R.A.X := 2;          R.A.Y := 15;
  414.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  415.     P := New(pButton, Init(R, '0', cmCalcButton, bfNormal + bfBroadcast));
  416.     P^.Options := P^.Options AND NOT ofSelectable;
  417.     Insert(P);
  418.  
  419.     R.A.X := 7;          R.A.Y := 15;
  420.     R.B.X := R.A.X + 10;  R.B.Y := R.A.Y + 2;
  421.     P := New(pButton, Init(R, #27, cmCalcButton, bfNormal + bfBroadcast));
  422.     P^.Options := P^.Options AND NOT ofSelectable;
  423.     Insert(P);
  424.  
  425.     R.A.X := 17;         R.A.Y := 15;
  426.     R.B.X := R.A.X + 10;  R.B.Y := R.A.Y + 2;
  427.     P := New(pButton, Init(R, '=', cmCalcButton, bfNormal + bfBroadcast));
  428.     P^.Options := P^.Options AND NOT ofSelectable;
  429.     Insert(P);
  430.  
  431.     (* Clear *)
  432.     R.A.X := 2;          R.A.Y := 3;
  433.     R.B.X := R.A.X + 5;  R.B.Y := R.A.Y + 2;
  434.     P := New(pButton, Init(R, 'L', cmCalcButton, bfNormal + bfBroadcast));
  435.     P^.Options := P^.Options AND NOT ofSelectable;
  436.     Insert(P);
  437.  
  438.     (* Display *)
  439.     R.Assign(8, 3, 27, 4);
  440.     Insert(New(pPetzCalcDisplay, Init(R)));
  441.   END;
  442.  
  443.   PROCEDURE RegisterPetzCalc;
  444.   BEGIN
  445.     RegisterType(rPetzCalcDisplay);
  446.     RegisterType(rPetzCalc);
  447.   END;
  448.  
  449. END.
  450. (* ------------------------------------------------------ *)
  451. (*              Ende von HEXCALC.PAS                      *)
  452.  
  453.  
  454.