home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / delite / calc / calc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-01  |  8.5 KB  |  273 lines

  1. PROGRAM calc;
  2. (*****************************************************************************
  3. Name:              CALC.PAS
  4. Version:           1.0
  5. Edit Datum:        1.4.1992
  6. Autor:             Andreas Schumm
  7. Kurzbeschreibung:  Nichtmodaler Taschenrechner
  8. *****************************************************************************)
  9.  
  10. USES  Kernel, API, Dialogs;
  11.  
  12. TYPE  Ops = (divide, multiply, add, subtract, none);
  13.  
  14. VAR   LaunchResult      : integer;
  15.       MyEvent           : EventTyp;
  16.       StillRunning      : boolean;
  17.  
  18.       Calculator        : Dialog;
  19.       CalcOn            : boolean;
  20.       CalcID            : Integer;         { ID of calc Subapplication }
  21.  
  22.       Accu              : real;
  23.       Op1               : real;
  24.       operation         : Ops;
  25.       ToBeCleared       : boolean;
  26.       errorlock         : boolean;
  27.  
  28.  
  29.  
  30. procedure CalcEventProc(TheEvent: EventTyp); far;
  31. var MyEditor : PEditField;
  32. begin
  33.   SetTheViewPort(CalcID);
  34.   MyEditor := Calculator.FindDlgItem(999);
  35.   if (TheEvent.Class = NormKey) then With TheEvent Do
  36.     begin
  37.       Class := DialogEvent;
  38.       MSG   := DLG_BUTTON;
  39.       if (Attrib in ['0'..'9']) then ID := 100 + ord(Attrib) - ord('0');
  40.       if (Attrib = '/') then ID := 111;
  41.       if (Attrib = '*') then ID := 112;
  42.       if (Attrib = '+') then ID := 113;
  43.       if (Attrib = '-') then ID := 114;
  44.       { convert keyboard-events to dialog-events }
  45.     end;
  46.  
  47.   if (TheEvent.Class = DialogEvent) and (TheEvent.MSG = DLG_OK) then
  48.     begin
  49.       TheEvent.MSG := DLG_BUTTON;
  50.       TheEvent.ID  := 115;
  51.       { convert carriage return }
  52.     end;
  53.  
  54.   If (TheEvent.Class = DialogEvent) and (TheEvent.MSG = DLG_BUTTON) then
  55.    begin
  56.      SetTheViewPort(CalcID);
  57.      if errorlock and (TheEvent.ID <> 110) then exit;
  58.      if ToBeCleared and (TheEvent.ID >= 100) and (TheEvent.ID <= 109) then
  59.        begin
  60.          MyEditor^.SetString(' ');
  61.          ToBeCleared := false;
  62.          Accu := 0;
  63.        end;
  64.      Case TheEvent.ID of
  65.        100: if Accu <> 0 then Accu := Accu * 10;
  66.        101: Accu := Accu * 10 + 1;
  67.        102: Accu := Accu * 10 + 2;
  68.        103: Accu := Accu * 10 + 3;
  69.        104: Accu := Accu * 10 + 4;
  70.        105: Accu := Accu * 10 + 5;
  71.        106: Accu := Accu * 10 + 6;
  72.        107: Accu := Accu * 10 + 7;
  73.        108: Accu := Accu * 10 + 8;
  74.        109: Accu := Accu * 10 + 9;
  75.        110: begin
  76.               Accu := 0;
  77.               Op1  := 0;
  78.               operation   := none;
  79.               ToBeCleared := false;
  80.               errorlock   := false;
  81.             end;
  82.        111: begin
  83.               Op1  := Accu;
  84.               Accu := 0;
  85.               operation := divide;
  86.               ToBeCleared := true;
  87.             end;
  88.        112: begin
  89.               Op1  := Accu;
  90.               Accu := 0;
  91.               operation := multiply;
  92.               ToBeCleared := true;
  93.             end;
  94.        113: begin
  95.               Op1  := Accu;
  96.               Accu := 0;
  97.               operation := add;
  98.               ToBeCleared := true;
  99.             end;
  100.        114: begin
  101.               Op1  := Accu;
  102.               Accu := 0;
  103.               operation := subtract;
  104.               ToBeCleared := true;
  105.             end;
  106.        115: begin
  107.               Case Operation of
  108.                 multiply : Accu := Op1 * Accu;
  109.                 divide   : begin
  110.                             if Accu <> 0 then
  111.                               Accu := Op1 / Accu
  112.                             else
  113.                               begin
  114.                                 errorlock := true;
  115.                                 MyEditor^.SetString('Error');
  116.                               end;
  117.                            end;
  118.                 add      : Accu := Accu + Op1;
  119.                 subtract : Accu := Op1 - Accu;
  120.               end;
  121.               ToBeCleared := true;
  122.               if not errorlock then MyEditor^.SetReal(Accu);
  123.               Op1 := 0;
  124.             end;
  125.        end; { Case }
  126.      if not ToBeCleared then MyEditor^.SetReal(Accu);
  127.    end; { If }
  128. end;
  129.  
  130. procedure RouteSubAppEvents(TheEvent: EventTyp); far;
  131. begin
  132.   Calculator.HandleEvent(TheEvent);  { route events to dialog }
  133. end;
  134.  
  135. procedure ShowCalc;
  136. var    MyButton: PButton;
  137.        MyEditor: PEditField;
  138.        hght    : integer;       { vertical size }
  139. begin
  140.   if CalcOn then exit;
  141.   EnableMenuItem(GetMenu, 101, MF_DISABLED);
  142.   EnableMenuItem(GetMenu, 102, MF_ENABLED);
  143.   Accu := 0;
  144.   Op1  := 0;
  145.   tobecleared := false;
  146.   errorlock   := false;
  147.   operation := none;
  148.   hght := 13*FontY;
  149.   Calculator.Init(20*FontX, hght, MF_MOVEABLE, CalcEventProc);
  150.   Calculator.SetCaption('Calculator');
  151.   Calculator.Move(100,100);
  152.   Calculator.BackGnd := lightgray;
  153.  
  154.   new(MyButton, Init(FontX,hght-2*FontY, 4*FontY+4, 2*FontY, 100,'0'));
  155.   Calculator.AddItem(MyButton);
  156.  
  157.   new(MyButton, Init(FontX+4*FontY+8, hght-2*FontY, 2*FontY, 2*FontY,99,'.'));
  158.   Calculator.AddItem(MyButton);
  159.   MyButton^.DisableItem; { Sorry ! }
  160.  
  161.   new(MyButton, Init(FontX, hght-4*FontY-4, 2*FontY, 2*FontY, 101,'1'));
  162.   Calculator.AddItem(MyButton);
  163.  
  164.   new(MyButton, Init(FontX+2*FontY+4, hght-4*FontY-4, 2*FontY, 2*FontY, 102,'2'));
  165.   Calculator.AddItem(MyButton);
  166.  
  167.   new(MyButton, Init(FontX+4*FontY+8, hght-4*FontY-4, 2*FontY, 2*FontY, 103,'3'));
  168.   Calculator.AddItem(MyButton);
  169.  
  170.   new(MyButton, Init(FontX, hght-6*FontY-8, 2*FontY, 2*FontY, 104,'4'));
  171.   Calculator.AddItem(MyButton);
  172.  
  173.   new(MyButton, Init(FontX+2*FontY+4, hght-6*FontY-8, 2*FontY, 2*FontY, 105,'5'));
  174.   Calculator.AddItem(MyButton);
  175.  
  176.   new(MyButton, Init(FontX+4*FontY+8, hght-6*FontY-8, 2*FontY, 2*FontY, 106,'6'));
  177.   Calculator.AddItem(MyButton);
  178.  
  179.   new(MyButton, Init(FontX, hght-8*FontY-12, 2*FontY, 2*FontY, 107,'7'));
  180.   Calculator.AddItem(MyButton);
  181.  
  182.   new(MyButton, Init(FontX+2*FontY+4, hght-8*FontY-12, 2*FontY, 2*FontY, 108,'8'));
  183.   Calculator.AddItem(MyButton);
  184.  
  185.   new(MyButton, Init(FontX+4*FontY+8, hght-8*FontY-12, 2*FontY, 2*FontY, 109,'9'));
  186.   Calculator.AddItem(MyButton);
  187.  
  188.   new(MyButton, Init(FontX, hght-10*FontY-16, 4*FontY+4, 2*FontY, 110,'C'));
  189.   Calculator.AddItem(MyButton);
  190.  
  191.   new(MyButton, Init(FontX+4*FontY+8, hght-10*FontY-16, 2*FontY, 2*FontY, 111,'/'));
  192.   Calculator.AddItem(MyButton);
  193.  
  194.   new(MyButton, Init(FontX+6*FontY+12, hght-10*FontY-16, 2*FontY, 2*FontY, 112,'*'));
  195.   Calculator.AddItem(MyButton);
  196.  
  197.   new(MyButton, Init(FontX+6*FontY+12, hght-8*FontY-12, 2*FontY, 2*FontY, 113,'+'));
  198.   Calculator.AddItem(MyButton);
  199.  
  200.   new(MyButton, Init(FontX+6*FontY+12, hght-6*FontY-8, 2*FontY, 2*FontY, 114,'-'));
  201.   Calculator.AddItem(MyButton);
  202.  
  203.   new(MyButton, Init(FontX+6*FontY+12, hght-4*FontY-4, 2*FontY, 4*FontY+4, 115,'='));
  204.   Calculator.AddItem(MyButton);
  205.  
  206.   new(MyEditor, Init(3*FontX, hght-13*FontY+6, 13,13,999,'0'));
  207.   MyEditor^.status := MyEditor^.status or sfBlind or sfNofocus;
  208.   MyEditor^.SetDigits(13);
  209.   Calculator.AddItem(MyEditor);
  210.  
  211.   SuspendApplication(GetMainID);
  212.  
  213.   CalcID := OpenSubApplication(RouteSubAppEvents, APP_NOFRAME, 'Calc',
  214.                                Calculator.Port.x1,
  215.                                Calculator.Port.y1,
  216.                                Calculator.Port.x2,
  217.                                Calculator.Port.y2);
  218.   Calculator.Show;
  219.   CalcOn := true;
  220. end;
  221.  
  222. procedure HideCalc;
  223. begin
  224.   if not CalcOn then exit;
  225.   EnableMenuItem(GetMenu, 101, MF_ENABLED);
  226.   EnableMenuItem(GetMenu, 102, MF_DISABLED);
  227.   Calculator.Done;
  228.   CalcOn := false;
  229.   CloseSubApplication(CalcId);
  230.   ActivateApplication(GetMainID);
  231. end;
  232.  
  233.  
  234. Procedure HandleMsg(MyMessage: EventTyp); far;
  235. Begin
  236.   With MyMessage Do
  237.     Case Class Of
  238.       NormKey : Calculator.HandleEvent(MyMessage);
  239.       CTRLKey : Calculator.HandleEvent(MyMessage);
  240.       Menu    : begin
  241.                   Case MenuItemID of
  242.                      0       : begin
  243.                                  if CalcOn then HideCalc;
  244.                                  StillRunning := false;  { Ende }
  245.                                end;
  246.                      101     : ShowCalc;
  247.                      102     : HideCalc;
  248.                   end;
  249.                 end;
  250.     end; { Case Class }
  251. End;
  252.  
  253.  
  254. Begin
  255.   StillRunning := true;
  256.   CalcOn       := false;
  257.   LaunchResult := OpenMainApplication(HandleMsg, APP_NOFONT, 'CALC');
  258.  
  259.   If LaunchResult = 0 then                { App launched ! }
  260.   begin
  261.     EnableMenuItem(GetMenu,102,MF_DISABLED);
  262.     while StillRunning Do
  263.        begin
  264.         GetEvent(MyEvent);
  265.         DispatchMessage(MyEvent);
  266.       end;
  267.     CloseMainApplication;
  268.   end
  269.   Else
  270.     Writeln('Error #',LaunchResult,' occured. Cannot start program.');
  271. End.
  272.  
  273.