home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------ *)
- (* CALC.PAS *)
- (* *)
- (* Calculator object. See TVDEMO.PAS for an example *)
- (* program that uses this unit. *)
- (* *)
- (* Turbo Vision Demo *)
- (* Copyright (c) 1990 by Borland International *)
- (* ------------------------------------------------------ *)
- UNIT Calc;
-
- {$F+,O+,S-}
-
- INTERFACE
-
- USES Drivers, Objects, Views, Dialogs;
-
- TYPE
- tCalcState = (csFirst, csValid, csError);
-
- pCalcDisplay = ^tCalcDisplay;
- tCalcDisplay = OBJECT (tView)
- Status : tCalcState;
- Number : STRING [15];
- Sign : CHAR;
- Operator : CHAR;
- Operand : REAL;
-
- CONSTRUCTOR Init(VAR Bounds : tRect);
- CONSTRUCTOR Load(VAR S : tStream);
- PROCEDURE CalcKey(Key : CHAR);
- PROCEDURE Clear;
- PROCEDURE Draw; VIRTUAL;
- FUNCTION GetPalette : pPalette; VIRTUAL;
- PROCEDURE HandleEvent(VAR Event : tEvent); VIRTUAL;
- PROCEDURE Store(VAR S : tStream);
- END;
-
- pCalculator = ^tCalculator;
- tCalculator = OBJECT (tDialog)
- CONSTRUCTOR Init;
- END;
-
- CONST
- rCalcDisplay : tStreamRec = (
- ObjType : 10040;
- VmtLink : Ofs(TypeOf(tCalcDisplay)^);
- Load : @tCalcDisplay.Load;
- Store : @tCalcDisplay.Store);
-
- rCalculator : tStreamRec = (
- ObjType : 10041;
- VmtLink : Ofs(TypeOf(tCalculator)^);
- Load : @TCalculator.Load;
- Store : @TCalculator.Store);
-
- PROCEDURE RegisterCalc;
-
- (* ------------------------------------------------------ *)
-
- IMPLEMENTATION
-
- CONST
- cmCalcButton = 100;
-
- CONSTRUCTOR tCalcDisplay.Init(VAR Bounds : tRect);
- BEGIN
- inherited Init(Bounds);
- Options := Options OR ofSelectable;
- EventMask := evKeyDown + evBroadcast;
- Clear;
- END;
-
- CONSTRUCTOR tCalcDisplay.Load(VAR S : tStream);
- BEGIN
- inherited Load(S);
- S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
- SizeOf(Operator) + SizeOf(Operand));
- END;
-
- PROCEDURE tCalcDisplay.CalcKey(Key : CHAR);
- VAR
- R : REAL;
-
- PROCEDURE Error;
- BEGIN
- Status := csError;
- Number := 'Error';
- Sign := ' ';
- END;
-
- PROCEDURE SetDisplay(R : REAL);
- VAR
- S : STRING [63];
- BEGIN
- Str(R:0:10, S);
- IF S[1] <> '-' THEN
- Sign := ' '
- ELSE BEGIN
- Delete(S, 1, 1);
- Sign := '-';
- END;
- IF Length(S) > 15 + 1 + 10 THEN
- Error
- ELSE BEGIN
- WHILE S[Length(S)] = '0' DO Dec(S[0]);
- IF S[Length(S)] = '.' THEN Dec(S[0]);
- Number := S;
- END;
- END;
-
- PROCEDURE GetDisplay(VAR R : REAL);
- VAR
- E : INTEGER;
- BEGIN
- Val(Sign + Number, R, E);
- END;
-
- PROCEDURE CheckFirst;
- BEGIN
- IF Status = csFirst THEN BEGIN
- Status := csValid;
- Number := '0';
- Sign := ' ';
- END;
- END;
-
- BEGIN
- Key := UpCase(Key);
- IF (Status = csError) AND (Key <> 'C') THEN Key := ' ';
- CASE Key OF
- '0'..'9' : BEGIN
- CheckFirst;
- IF Number = '0' THEN Number := '';
- Number := Number + Key;
- END;
- '.' : BEGIN
- CheckFirst;
- IF Pos ('.', Number) = 0 THEN
- Number := Number + '.';
- END;
- #8, #27 : BEGIN
- CheckFirst;
- IF Length(Number) = 1 THEN
- Number := '0'
- ELSE
- Dec(Number[0]);
- END;
- '_', #241 : IF Sign = ' ' THEN
- Sign := '-'
- ELSE
- Sign := ' ';
- '+', '-',
- '*', '/',
- '=', '%',
- #13 : BEGIN
- IF Status = csValid THEN BEGIN
- Status := csFirst;
- GetDisplay(R);
- IF Key = '%' THEN
- CASE Operator OF
- '+', '-' : R := Operand * R / 100;
- '*', '/' : R := R / 100;
- END;
- CASE Operator OF
- '+' : SetDisplay(Operand + R);
- '-' : SetDisplay(Operand - R);
- '*' : SetDisplay(Operand * R);
- '/' : IF R = 0 THEN
- Error
- ELSE
- SetDisplay(Operand / R);
- END;
- END;
- Operator := Key;
- GetDisplay(Operand);
- END;
- 'C' : Clear;
- END;
- DrawView;
- END;
-
- PROCEDURE tCalcDisplay.Clear;
- BEGIN
- Status := csFirst;
- Number := '0';
- Sign := ' ';
- Operator := '=';
- END;
-
- PROCEDURE tCalcDisplay.Draw;
- VAR
- Color : BYTE;
- i : INTEGER;
- B : tDrawBuffer;
- BEGIN
- Color := GetColor(1);
- i := Size.X - Length(Number) - 2;
- MoveChar(B, ' ', Color, Size.X);
- MoveChar(B[i], Sign, Color, 1);
- MoveStr(B[i + 1], Number, Color);
- WriteBuf(0, 0, Size.X, 1, B);
- END;
-
- FUNCTION tCalcDisplay.GetPalette : pPalette;
- CONST
- P : STRING [1] = #19;
- BEGIN
- GetPalette := @P;
- END;
-
- PROCEDURE tCalcDisplay.HandleEvent(VAR Event : tEvent);
- BEGIN
- inherited HandleEvent(Event);
- CASE Event.What OF
- evKeyDown : BEGIN
- CalcKey(Event.CharCode);
- ClearEvent(Event);
- END;
- evBroadcast : IF Event.Command = cmCalcButton THEN BEGIN
- CalcKey(pButton(Event.InfoPtr)^.Title^[1]);
- ClearEvent(Event);
- END;
- END;
- END;
-
- PROCEDURE tCalcDisplay.Store(VAR S : tStream);
- BEGIN
- tView.Store(S);
- S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
- SizeOf(Operator) + SizeOf(Operand));
- END;
-
- { --- tCalculator -------------------------------------- }
-
- CONSTRUCTOR tCalculator.Init;
- CONST
- KeyChar : ARRAY [0..19] OF CHAR = 'C'#27'%'#241'789/456*123-0.=+';
- VAR
- I : INTEGER;
- P : pVIew;
- R : tRect;
- BEGIN
- R.Assign(5, 3, 29, 18);
- inherited Init(R, 'Calculator');
- Options := Options OR ofFirstClick;
- FOR I := 0 TO 19 DO BEGIN
- R.A.X := (I MOD 4) * 5 + 2;
- R.A.Y := (I DIV 4) * 2 + 4;
- R.B.X := R.A.X + 5;
- R.B.Y := R.A.Y + 2;
- P := New(pButton, Init(R, KeyChar[I], cmCalcButton,
- bfNormal + bfBroadcast));
- P^.Options := P^.Options AND NOT ofSelectable;
- Insert(P);
- END;
- R.Assign(3, 2, 21, 3);
- Insert(New(pCalcDisplay, Init(R)));
- END;
-
- PROCEDURE RegisterCalc;
- BEGIN
- RegisterType(rCalcDisplay);
- RegisterType(rCalculator);
- END;
-
- END.
- (* ------------------------------------------------------ *)
- (* Ende von CALC.PAS *)
-