home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / CALC32 / CALC.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-13  |  14KB  |  479 lines
  1. unit Calc;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, StdCtrls, Mask, Buttons, ExtCtrls,
  8.   Clipbrd, About;
  9.  
  10. type
  11.   TCalcForm = class(TForm)
  12.     MemButton: TSpeedButton;
  13.     DecButton: TSpeedButton;
  14.     HexButton: TSpeedButton;
  15.     BinButton: TSpeedButton;
  16.     Button7: TSpeedButton;
  17.     Button8: TSpeedButton;
  18.     Button9: TSpeedButton;
  19.     Button4: TSpeedButton;
  20.     Button5: TSpeedButton;
  21.     Button6: TSpeedButton;
  22.     Button1: TSpeedButton;
  23.     Button2: TSpeedButton;
  24.     Button3: TSpeedButton;
  25.     Button0: TSpeedButton;
  26.     PlusMinusButton: TSpeedButton;
  27.     EqualButton: TSpeedButton;
  28.     ButtonA: TSpeedButton;
  29.     ButtonB: TSpeedButton;
  30.     ButtonC: TSpeedButton;
  31.     ButtonD: TSpeedButton;
  32.     ButtonE: TSpeedButton;
  33.     ButtonF: TSpeedButton;
  34.     DivButton: TSpeedButton;
  35.     TimesButton: TSpeedButton;
  36.     MinusButton: TSpeedButton;
  37.     PlusButton: TSpeedButton;
  38.     ANDButton: TSpeedButton;
  39.     ORButton: TSpeedButton;
  40.     XORButton: TSpeedButton;
  41.     NOTButton: TSpeedButton;
  42.     CalcMainMenu: TMainMenu;
  43.     CalcMenuItem: TMenuItem;
  44.     CalcExitMenuItem: TMenuItem;
  45.     MemBevel: TBevel;
  46.     MemLabel: TLabel;
  47.     DecBevel: TBevel;
  48.     DecLabel: TLabel;
  49.     HexBevel: TBevel;
  50.     HexLabel: TLabel;
  51.     BinBevel: TBevel;
  52.     BinLabel: TLabel;
  53.     LineBevel: TBevel;
  54.     ClearButton: TSpeedButton;
  55.     ClearEntryButton: TSpeedButton;
  56.     BackButton: TSpeedButton;
  57.     Help1: TMenuItem;
  58.     About1: TMenuItem;
  59.     Edit1: TMenuItem;
  60.     Paste1: TMenuItem;
  61.     Copy1: TMenuItem;
  62.     BitBtn1: TBitBtn;
  63.     procedure CalcExitMenuItemClick(Sender: TObject);
  64.     procedure FormCreate(Sender: TObject);
  65.     procedure ButtonDigitClick(Sender: TObject);
  66.     procedure DecHexBinButtonClick(Sender: TObject);
  67.     procedure ClearEntryButtonClick(Sender: TObject);
  68.     procedure ClearButtonClick(Sender: TObject);
  69.     procedure BackButtonClick(Sender: TObject);
  70.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  71.     procedure OpButtonClick(Sender: TObject);
  72.     procedure EqualButtonClick(Sender: TObject);
  73.     procedure PlusMinusButtonClick(Sender: TObject);
  74.     procedure NOTButtonClick(Sender: TObject);
  75.     procedure Copy1Click(Sender: TObject);
  76.     procedure Paste1Click(Sender: TObject);
  77.     procedure About1Click(Sender: TObject);
  78.   private
  79.   {- Entry-radix switches. Only one can be true! }
  80.     DecEntry, HexEntry, BinEntry: Boolean;
  81.   {- Enable and disable buttons depending on Entry radix }
  82.     procedure EnableButtons;
  83.   {- Update Dec, Hex, and Bin Labels from Accumulator }
  84.     procedure UpdateDigitLabels;
  85.   {- Update Accumulator value from current entry string }
  86.     procedure UpdateAccumulator;
  87.   {- Assign value to memory (intermediate) accumulator }
  88.     procedure SetMemAcc(V: Longint);
  89.   {- Display error message }
  90.     procedure ShowError(const Msg: String);
  91.   public
  92.     { Public declarations }
  93.   end;
  94.  
  95. var
  96.   CalcForm: TCalcForm;
  97.  
  98. implementation
  99.  
  100. {$R *.DFM}
  101.  
  102. const
  103.  
  104. { -2147483648 }
  105.   maxDecDigits = 11;   { Maximum number of decimal digits }
  106. { 7FFFFFFF }
  107.   maxHexDigits = 8;    { Maximum number of hex digits }
  108. { 00000000000000000000000000000000 }
  109.   maxBinDigits = 32;   { Maximum number of binary digits }
  110.  
  111.   opNo         =  0;   { Operators = button Tag properties }
  112.   opMultiply   = -1;
  113.   opDivide     = -2;
  114.   opAdd        = -3;
  115.   opSubtract   = -4;
  116.   opAnd        = -5;
  117.   opOr         = -6;
  118.   opXor        = -7;
  119.  
  120.   asciiEsc     = #27;  { Ascii escape control code }
  121.   asciiEnter   = #13;  { Ascii enter control code }
  122.  
  123. var
  124.   Accumulator: Longint;              { Current result }
  125.   MemAcc: Longint;                   { Memory result }
  126.   Operator: Integer;                 { opX constant }
  127.   DecString: String[maxDecDigits];   { Result in decimal }
  128.   HexString: String[maxHexDigits];   { Result in hex }
  129.   BinString: String[maxBinDigits];   { Result in binary }
  130.  
  131. {- Global procedures -- for Xtrastuff??? }
  132.  
  133. { Convert integer Value to binary string limited to Digits }
  134. function IntToBin(Value: Longint; Digits: Integer): String;
  135. var
  136.   S: String;
  137. begin
  138.   S := '';               { Initialize string to null }
  139.   while Digits > 0 do
  140.   begin
  141.     if Odd(Value) then S := '1' + S else S := '0' + S;
  142.     Value := Value shr 1;
  143.     Dec(Digits);
  144.   end;
  145.   Result := S;         { Return S as function result }
  146. end;
  147.  
  148. { Convert string S in decimal to Longint value }
  149. function StringToInt(const S: String): Longint;
  150. begin
  151.   if Length(S) = 0 then
  152.     Result := 0
  153.   else try
  154.     Result := StrToInt(S);
  155.   except
  156.     on E: Exception do
  157.     begin
  158.       CalcForm.ShowError(E.Message);
  159.       Result := 0;
  160.     end;
  161.   end;
  162. end;
  163.  
  164. { Convert string S in hexadecimal to Longint value }
  165. function StringToHex(const S: String): Longint;
  166. var
  167.   ErrorCode: Integer;
  168.   V: Longint;
  169. begin
  170.   Val('$' + S, V, ErrorCode);  { Append Pascal's HEX char to S }
  171.   Result := V;                 { Return V as function result }
  172. end;
  173.  
  174. { Convert string S in binary to Longint value }
  175. function StringToBin(const S: String): Longint;
  176. var
  177.   V, Q: Longint;   { Function result value and temporary }
  178.   I, J: Integer;   { For-loop controls }
  179. begin
  180.   V := 0;                     { Initialize result to 0 }
  181.   J := Length(S) - 1;
  182.   for I := 0 to J do          { Shift in each digit in string }
  183.     if S[I + 1] = '1' then
  184.     begin
  185.       Q := 1;                       { Shift in a 1 }
  186.       V := V or (Q shl (J - I));    { Using a logical OR }
  187.     end;
  188.   Result := V;              { Return V as function result }
  189. end;
  190.  
  191. {- Private methods }
  192.  
  193. { Enable and disable buttons depending on entry radix }
  194. procedure TCalcForm.EnableButtons;
  195. begin
  196. {- Assume binary radix }
  197.   Button0.Enabled := True;
  198.   Button1.Enabled := True;
  199.   Button2.Enabled := False;
  200.   Button3.Enabled := False;
  201.   Button4.Enabled := False;
  202.   Button5.Enabled := False;
  203.   Button6.Enabled := False;
  204.   Button7.Enabled := False;
  205.   Button8.Enabled := False;
  206.   Button9.Enabled := False;
  207.   ButtonA.Enabled := False;
  208.   ButtonB.Enabled := False;
  209.   ButtonC.Enabled := False;
  210.   ButtonD.Enabled := False;
  211.   ButtonE.Enabled := False;
  212.   ButtonF.Enabled := False;
  213. {- Add decimal buttons }
  214.   if (DecEntry or HexEntry) then
  215.   begin
  216.     Button2.Enabled := True;
  217.     Button3.Enabled := True;
  218.     Button4.Enabled := True;
  219.     Button5.Enabled := True;
  220.     Button6.Enabled := True;
  221.     Button7.Enabled := True;
  222.     Button8.Enabled := True;
  223.     Button9.Enabled := True;
  224.   end;
  225. {- Add hex buttons }
  226.   if HexEntry then
  227.   begin
  228.     ButtonA.Enabled := True;
  229.     ButtonB.Enabled := True;
  230.     ButtonC.Enabled := True;
  231.     ButtonD.Enabled := True;
  232.     ButtonE.Enabled := True;
  233.     ButtonF.Enabled := True;
  234.   end;
  235. {- Enable / disable radix selector button D, H, or B }
  236.   DecButton.Down := False;
  237.   HexButton.Down := False;
  238.   BinButton.Down := False;
  239.   if DecEntry then
  240.     DecButton.Down := True else
  241.   if HexEntry then HexButton.Down := True else
  242.     BinButton.Down := True;
  243. end;
  244.  
  245. { Update global strings and Label captions from Accumulator }
  246. procedure TCalcForm.UpdateDigitLabels;
  247. begin
  248. {- Convert accumulator value to strings }
  249.   DecString := IntToStr(Accumulator);
  250.   HexString := IntToHex(Accumulator, maxHexDigits);
  251.   BinString := IntToBin(Accumulator, maxBinDigits);
  252. {- Assign strings to Label object Captions }
  253.   DecLabel.Caption := DecString;
  254.   HexLabel.Caption := HexString;
  255.   BinLabel.Caption := BinString;
  256. end;
  257.  
  258. {- Update Accumulator value from current entry string }
  259. procedure TCalcForm.UpdateAccumulator;
  260. begin
  261.   try
  262.     if DecEntry then
  263.       Accumulator := StringToInt(DecString)
  264.     else if HexEntry then
  265.       Accumulator := StringToHex(HexString)
  266.     else if BinEntry then
  267.       Accumulator := StringToBin(BinString);
  268.   except
  269.     on E: EIntError do
  270.       ShowError(E.Message);
  271.   end;
  272. end;
  273.  
  274. {- Assign V to MemAcc and update Memory display line }
  275. procedure TCalcForm.SetMemAcc(V: Longint);
  276. begin
  277.   MemAcc := V;
  278.   MemLabel.Caption := IntToStr(MemAcc);
  279. end;
  280.  
  281. {- Display error message string }
  282. procedure TCalcForm.ShowError(const Msg: String