home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / CALC!.EXE / GCALC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-06  |  7KB  |  292 lines
  1. UNIT GCalc;
  2.  
  3. INTERFACE
  4.  
  5. uses GDecl,                  {WGRAPH -Units}
  6.      GEvent,
  7.      GDrivers,
  8.      GViews,
  9.      GDlg,
  10.      graph;
  11.  
  12. type tCalcState=(calcOK,calcValid,calcError);
  13.  
  14.      PCalculator=^TCalculator;
  15.      TCalculator=object(TDlgWindow)
  16.       Status:tCalcState;
  17.       Zahl:string[15];
  18.       Sign:char;                               {Vorzeichen}
  19.       Operator:char;
  20.       Operand:real;
  21.       constructor Init(var Bounds:TRect;ATitle:str80;AType:byte);
  22.       procedure SetPalette; virtual;
  23.       procedure InitBackground; virtual;
  24.       procedure Berechne(Key:char);
  25.       procedure ClearDisplay;
  26.       procedure DrawDisplay;
  27.       procedure Draw; virtual;
  28.       procedure HandleEvent; virtual;
  29.      end;
  30.  
  31.      PCalcBackground=^TCalcBackground;
  32.      TCalcBackground=object(TBackground)
  33.       procedure Draw; virtual;
  34.      end;
  35.  
  36.  
  37. IMPLEMENTATION
  38.  
  39. {Implementation TCalculator}
  40.  
  41. constructor TCalculator.Init(var Bounds:TRect;ATitle:str80;AType:byte);
  42. begin
  43.   TDlgWindow.Init(Bounds,ATitle,AType);
  44.   DlgInput:=false;
  45.   SetPushButton(10,85,22,22,'7',1007);
  46.    ChangePalColor(7,LightGray);
  47.    ChangePalColor(8,LightGray);
  48.   SetPushButton(35,85,22,22,'8',1008);
  49.    ChangePalColor(7,LightGray);
  50.    ChangePalColor(8,LightGray);
  51.   SetPushButton(60,85,22,22,'9',1009);
  52.    ChangePalColor(7,LightGray);
  53.    ChangePalColor(8,LightGray);
  54.   SetPushButton(100,85,22,22,'/',1010);
  55.    ChangePalColor(6,Blue);
  56.    ChangePalColor(7,LightGray);
  57.    ChangePalColor(8,LightGray);
  58.   SetPushButton(128,85,22,22,'C',1011);
  59.    ChangePalColor(6,Blue);
  60.    ChangePalColor(7,LightGray);
  61.    ChangePalColor(8,LightGray);
  62.   SetPushButton(10,110,22,22,'4',1004);
  63.    ChangePalColor(7,LightGray);
  64.    ChangePalColor(8,LightGray);
  65.   SetPushButton(35,110,22,22,'5',1005);
  66.    ChangePalColor(7,LightGray);
  67.    ChangePalColor(8,LightGray);
  68.   SetPushButton(60,110,22,22,'6',1006);
  69.    ChangePalColor(7,LightGray);
  70.    ChangePalColor(8,LightGray);
  71.   SetPushButton(100,110,22,22,'*',1012);
  72.    ChangePalColor(6,Blue);
  73.    ChangePalColor(7,LightGray);
  74.    ChangePalColor(8,LightGray);
  75.   SetPushButton(128,110,22,22,'+',1013);
  76.    ChangePalColor(6,Blue);
  77.    ChangePalColor(7,LightGray);
  78.    ChangePalColor(8,LightGray);
  79.   SetPushButton(10,135,22,22,'1',1001);
  80.    ChangePalColor(7,LightGray);
  81.    ChangePalColor(8,LightGray);
  82.   SetPushButton(35,135,22,22,'2',1002);
  83.    ChangePalColor(7,LightGray);
  84.    ChangePalColor(8,LightGray);
  85.   SetPushButton(60,135,22,22,'3',1003);
  86.    ChangePalColor(7,LightGray);
  87.    ChangePalColor(8,LightGray);
  88.   SetPushButton(100,135,22,22,'-',1014);
  89.    ChangePalColor(6,Blue);
  90.    ChangePalColor(7,LightGray);
  91.    ChangePalColor(8,LightGray);
  92.   SetPushButton(128,135,22,22,'%',1015);
  93.    ChangePalColor(6,Blue);
  94.    ChangePalColor(7,LightGray);
  95.    ChangePalColor(8,LightGray);
  96.   SetPushButton(10,160,22,22,'0',1000);
  97.    ChangePalColor(7,LightGray);
  98.    ChangePalColor(8,LightGray);
  99.   SetPushButton(35,160,22,22,'.',1016);
  100.    ChangePalColor(7,LightGray);
  101.    ChangePalColor(8,LightGray);
  102.   SetPushButton(60,160,22,22,'±',1017);
  103.    ChangePalColor(6,Blue);
  104.    ChangePalColor(7,LightGray);
  105.    ChangePalColor(8,LightGray);
  106.   SetPushButton(100,160,50,22,'=',1018);
  107.    ChangePalColor(6,Blue);
  108.    ChangePalColor(7,LightGray);
  109.    ChangePalColor(8,LightGray);
  110.  
  111.   Zahl:='0'; Sign:=' '; Operand:=0;
  112.   Status:=calcOK; Operator:='=';
  113.  
  114. end;
  115.  
  116. procedure TCalculator.SetPalette;
  117. begin
  118.   Palette:=pal[palRed];
  119.   Palette[4]:=#14;
  120.   Palette[5]:=#14;
  121.   Palette[6]:=#1;
  122. end;
  123.  
  124. procedure TCalculator.InitBackground;
  125. var RR:TRect;
  126. begin
  127.   RR:=Frame^.Area;
  128.   Bgrd:=new(PCalcBackground, Init(RR));
  129.   List^.InsertItem(Bgrd);
  130. end;
  131.  
  132. procedure TCalculator.Berechne(Key:char);
  133. var z:real;
  134.  
  135. procedure Fehler;
  136. begin
  137.   Status:=calcError;
  138.   Zahl:='ERROR';
  139.   Sign:=' ';
  140. end;
  141.  
  142. procedure CheckFirst;
  143. begin
  144.   if Status=calcOK then
  145.    begin
  146.      Status:=calcValid;
  147.      Zahl:='0';
  148.      Sign:=' ';
  149.    end;
  150. end;
  151.  
  152. procedure SetDisplay(z:real);
  153. var s:string;
  154. begin
  155.   str(z:0:10,s);
  156.   if s[1]<>'-' then Sign:=' ' else
  157.    begin
  158.      delete(s,1,1);
  159.      Sign:='-';
  160.    end;
  161.   if length(s)>15+1+10 then Fehler else
  162.    begin
  163.      while s[length(s)]='0' do dec(s[0]);
  164.      if s[length(s)]='.' then dec(s[0]);
  165.      Zahl:=s;
  166.    end;
  167. end;
  168.  
  169. procedure GetDisplay(var z:real);
  170. var err:integer;
  171. begin
  172.   val(Sign+Zahl,z,err);
  173. end;
  174.  
  175. {----------}
  176.  
  177. begin
  178.   Key:=UpCase(Key);
  179.   if (Status=calcError) and (Key<>'C') then Key:=' ';
  180.   case Key of
  181.    '0'..'9' : begin
  182.                 CheckFirst;
  183.                 if Zahl='0' then Zahl:='';
  184.                 Zahl:=Zahl+Key;
  185.               end;
  186.    '.'      : begin
  187.                 CheckFirst;
  188.                 if Pos('.',Zahl)=0 then Zahl:=Zahl+'.';
  189.               end;
  190.    #8,#27   : begin
  191.                 CheckFirst;
  192.                 if length(Zahl)=1 then Zahl:='0' else dec(Zahl[0]);
  193.               end;
  194.    '_',#241 : if Sign=' ' then Sign:='-' else Sign:=' ';
  195.    '+','-',
  196.    '*','/',
  197.    '=','%',
  198.    'W',#13  : begin
  199.                 if Status=calcValid then
  200.                  begin
  201.                    Status:=calcOK;
  202.                    GetDisplay(z);
  203.                    if Key='%' then
  204.                     case Operator of
  205.                      '+','-': z:=Operand*z/100;
  206.                      '*','/': z:=z/100;
  207.                     end; {case}
  208.                    case Operator of
  209.                     '+':SetDisplay(Operand+z);
  210.                     '-':SetDisplay(Operand-z);
  211.                     '*':SetDisplay(Operand*z);
  212.                     '/':if z=0 then Fehler else SetDisplay(Operand/z);
  213.                    end; {case}
  214.                  end;
  215.                 Operator:=Key;
  216.                 GetDisplay(Operand);
  217.               end;
  218.    'C'      : ClearDisplay;
  219.   end; {case}
  220. end;
  221.  
  222. procedure TCalculator.ClearDisplay;
  223. var Border:TRect;
  224. begin
  225.   Border:=Frame^.Area;
  226.   with Border do
  227.    begin
  228.      SetFillStyle(SolidFill,Yellow);
  229.      Bar(A.x+10,A.y+20,B.x-10,A.y+40);
  230.    end;
  231.   Status:=calcOK;
  232.   Zahl:='0';
  233.   Sign:=' ';
  234.   Operator:='=';
  235. end;
  236.  
  237. procedure TCalculator.DrawDisplay;
  238. var z:string;
  239.     Border:TRect;
  240. begin
  241.   Border:=Frame^.Area;
  242.   with Border do
  243.    begin
  244.      SetColor(Black);
  245.      z:=Sign+Zahl;
  246.      SetTextJustify(RightText,TopText);
  247.      Mouse.HideMouse;
  248.      SetFillStyle(SolidFill,White);
  249.      Bar(A.x+10,A.y+20,B.x-10,A.y+40);
  250.      OutTextXY(B.x-16,A.y+27,z);
  251.      Mouse.ShowMouse;
  252.      SetTextJustify(LeftText,TopText);
  253.    end;
  254. end;
  255.  
  256. procedure TCalculator.Draw;
  257. begin
  258.   TDlgWindow.Draw;
  259.   DrawDisplay;
  260. end;
  261.  
  262. procedure TCalculator.HandleEvent;
  263. const KeyCodes:string='0123456789/C*+-%._=';
  264. var i:integer;
  265. begin
  266.   TDlgWindow.HandleEvent;
  267.   i:=Event.Command-1000;
  268.   if i>=0 then
  269.    begin
  270.      Berechne(char(KeyCodes[i+1]));
  271.      DrawDisplay;
  272.    end;
  273.   if (Event.What=evKeyboard) and (pos(UpCase(Keyb.KeyCode),KeyCodes)<>0) then
  274.    begin
  275.      Berechne(Keyb.KeyCode);
  276.      DrawDisplay;
  277.    end;
  278. end;
  279.  
  280. procedure TCalcBackground.Draw;
  281. begin
  282.   with Border do
  283.    begin
  284.      SetFillStyle(SolidFill,LightGray);
  285.      Bar(A.x,A.y,B.x,B.y);
  286.      SetFillStyle(SolidFill,White);
  287.      Bar(A.x+10,A.y+20,B.x-10,A.y+40);
  288.    end;
  289. end;
  290.  
  291.  
  292. END.