home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH01 / LOGICAL / LOGICALU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-04-06  |  12.5 KB  |  486 lines
  1. (************************************************************************)
  2. (*                                                                      *)
  3. (* Logical.EXE                                                          *)
  4. (*                                                                      *)
  5. (* This program is a logical operations calculator.  It lets the user    *)
  6. (* enter two binary or hexadecimal values and it will compute the logi-    *)
  7. (* cal AND, OR, or XOR of these two numbers.  This calculator also sup-    *)
  8. (* ports several unary operations including NOT, NEG, SHL, SHR, ROL and    *)
  9. (* ROR.                                    *)
  10. (*                                    *)
  11. (* Randall L. Hyde                            *)
  12. (* 11/3/95                                *)
  13. (* Copyright 1995, All Rights Reserved.                    *)
  14. (*                                    *)
  15. (************************************************************************)
  16.  
  17. unit logicalu;
  18.  
  19. interface
  20.  
  21. uses
  22.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  23.   Forms, Dialogs, StdCtrls, ExtCtrls,
  24.  
  25.   (* Converts is a special unit developed for this program that    *)
  26.   (* provides decimal <-> binary <-> hexadecimal conversions    *)
  27.   (* and data checking.                        *)
  28.  
  29.   Converts;
  30.  
  31.  
  32.   (* The Delphi Class for this form *)
  33.  
  34. type
  35.   TLogicalOps = class(TForm)
  36.     BinEntry1: TEdit;         {Entry box for first binary value    }
  37.     BinEntry2: TEdit;        {Entry box for second binary value    }
  38.     HexEntry1: TEdit;        {Entry box for first hexadecimal value    }
  39.     HexEntry2: TEdit;        {Entry box for second hexadecimal value    }
  40.  
  41.     BinResult: TLabel;        {Binary result goes here        }
  42.     HexResult: TLabel;        {Hexadecimal result goes here        }
  43.  
  44.     Panel1: TPanel;
  45.  
  46.     { Buttons that appear on the form: }
  47.  
  48.     ExitBtn: TButton;
  49.     AboutBtn: TButton;
  50.     AndBtn: TButton;
  51.     OrBtn: TButton;
  52.     XorBtn: TButton;
  53.     NotBtn: TButton;
  54.     NegBtn: TButton;
  55.     SHLBtn: TButton;
  56.     SHRBtn: TButton;
  57.     ROLBtn: TButton;
  58.     RORBtn: TButton;
  59.  
  60.     { These labels hold text that appears on the form }
  61.  
  62.     Label1: TLabel;
  63.     CurOpLbl: TLabel;
  64.     CurrentOp: TLabel;
  65.  
  66.     { The methods that handle events occurring on this form }
  67.  
  68.     procedure ExitBtnClick(Sender: TObject);
  69.     procedure AboutBtnClick(Sender: TObject);
  70.     procedure BinEntry1KeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  71.     procedure BinEntry2KeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  72.     procedure HexEntry1KeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  73.     procedure HexEntry2KeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  74.     procedure AndBtnClick(Sender: TObject);
  75.     procedure OrBtnClick(Sender: TObject);
  76.     procedure XorBtnClick(Sender: TObject);
  77.     procedure NotBtnClick(Sender: TObject);
  78.     procedure NegBtnClick(Sender: TObject);
  79.     procedure FormCreate(Sender: TObject);
  80.     procedure SHLBtnClick(Sender: TObject);
  81.     procedure SHRBtnClick(Sender: TObject);
  82.     procedure ROLBtnClick(Sender: TObject);
  83.     procedure RORBtnClick(Sender: TObject);
  84.     procedure FormClick(Sender: TObject);
  85.  
  86.   private
  87.   public
  88.  
  89.     { Value1 and Value2 hold the results obtained by converting between    }
  90.     { hex/binary and integer forms.                    }
  91.  
  92.     value1,
  93.     value2:integer;
  94.   end;
  95.  
  96.  
  97.  
  98.  
  99. var
  100.   LogicalOps: TLogicalOps;
  101.  
  102. implementation
  103.  
  104. {$R *.DFM}
  105.  
  106.  
  107. { The types of operations this calculator is capable of appear in the    }
  108. { following enumerated list.                        }
  109.  
  110. type
  111.     operations = (ANDop, ORop, XORop, NOTop, NEGop, SHLop, SHRop, ROLop, RORop);
  112.  
  113.  
  114. var
  115.    operation: operations;
  116.  
  117.  
  118.  
  119. { DoCalc-  This function does the currently specified operation on    }
  120. { the value1 and value2 fields.  It displays the results in the binary    }
  121. { and hexadecimal result fields.                    }
  122.  
  123. procedure DoCalc;
  124. var unsigned:integer;
  125.     carry:boolean;
  126. begin
  127.  
  128.      { Compute the result of "Value1 op Value2" (for AND, OR, XOR) or    }
  129.      { "op Value1" (for the other operations) and leave the result in    }
  130.      { the "unsigned" variable.                        }
  131.  
  132.      case Operation of
  133.  
  134.           ANDop: unsigned := LogicalOps.value1 and LogicalOps.value2;
  135.           ORop: unsigned := LogicalOps.value1 or LogicalOps.value2;
  136.           XORop: unsigned := LogicalOps.value1 xor LogicalOps.value2;
  137.           NOTop: unsigned := not LogicalOps.value2;
  138.           NEGop: unsigned := -LogicalOps.value2;
  139.           SHLop: unsigned := LogicalOps.value2 shl 1;
  140.           SHRop: unsigned := LogicalOps.value2 shr 1;
  141.           ROLop: begin
  142.                       carry := (LogicalOps.value2 and $8000) = $8000;
  143.                       unsigned := LogicalOps.value2 shl 1;
  144.                       if carry then inc(unsigned);
  145.                  end;
  146.  
  147.           RORop: begin
  148.                       carry := odd(LogicalOps.value2);
  149.                       unsigned := LogicalOps.value2 shr 1;
  150.                       if carry then
  151.                          unsigned := unsigned or $8000;
  152.                  end;
  153.  
  154.      end;
  155.  
  156.      { Output results to the binary and hexadecimal result fields on    }
  157.      { the form.                            }
  158.  
  159.      LogicalOps.BinResult.Caption := IntToBin(unsigned, 16);
  160.      LogicalOps.HexResult.Caption := IntToHex(unsigned,4);
  161.  
  162.      end;
  163.  
  164.  
  165. { Reformat is a short utility procedure that redraws all the input    }
  166. { values whenever the user clicks on one of the operation buttons.    }
  167.  
  168. procedure Reformat;
  169. begin
  170.  
  171.      LogicalOps.HexEntry1.text := IntToHex(LogicalOps.value1,4);
  172.      LogicalOps.HexEntry2.text := IntToHex(LogicalOps.value2,4);
  173.      LogicalOps.BinEntry1.text := IntToBin(LogicalOps.value1,16);
  174.      LogicalOps.BinEntry2.text := IntToBin(LogicalOps.value2,16);
  175.  
  176. end;
  177.  
  178.  
  179.  
  180. { The following procedure executes when the program first runs.  It    }
  181. { simply initializes the value1 and value2 variables.            }
  182.  
  183. procedure TLogicalOps.FormCreate(Sender: TObject);
  184. begin
  185.  
  186.      Value1 := 0;
  187.      Value2 := 0;
  188.  
  189. end;
  190.  
  191.  
  192.  
  193. { The following procedure terminates the program whenever the user    }
  194. { presses the QUIT button.                        }
  195.  
  196. procedure TLogicalOps.ExitBtnClick(Sender: TObject);
  197. begin
  198.      Halt;
  199. end;
  200.  
  201.  
  202.  
  203. { Whenever the user releases a key pressed in the first hex data entry    }
  204. { box, the following procedure runs to convert the string appearing in    }
  205. { that box to its corresonding integer value.  This procedure also re-    }
  206. { computes the result using the current operation and updates any nec-    }
  207. { cessary fields on the form.                        }
  208.  
  209. procedure TLogicalOps.HexEntry1KeyUp(Sender: TObject;
  210.                                  var Key: Word;
  211.                                  Shift: TShiftState);
  212. begin
  213.  
  214.      { First, see if this is a legal hex value }
  215.  
  216.      if (CheckHex(HexEntry1.Text)) then begin
  217.  
  218.         { If legal, convert it to an integer, update the binary field,    }
  219.         { and then calculate the result.  Change the field's background    }
  220.         { colors back to normal since we've got an okay input value.    }
  221.  
  222.         Value1 := HexToInt(HexEntry1.Text);
  223.         BinEntry1.Text := IntToBin(Value1,16);
  224.         HexEntry1.Color := clWindow;
  225.         BinEntry1.Color := clWindow;
  226.         DoCalc;
  227.  
  228.      end
  229.      else begin
  230.  
  231.           { If there was a data entry error, beep the speaker and set    }
  232.           { the background color to red.                }
  233.  
  234.           MessageBeep($ffff);
  235.           HexEntry1.Color := clRed;
  236.  
  237.      end;
  238.  
  239. end;
  240.  
  241.  
  242. { This function handles key up events in the first binary data entry    }
  243. { field.  It is very similar to HexEntry1KeyUp, so see the comments in    }
  244. { that procedure for details on how this operates.            }
  245.  
  246. procedure TLogicalOps.BinEntry1KeyUp(Sender: TObject; var Key: Word;
  247.   Shift: TShiftState);
  248. begin
  249.  
  250.      if (CheckBin(BinEntry1.Text)) then begin
  251.  
  252.         Value1 := BinToInt(BinEntry1.Text);
  253.         HexEntry1.Text := IntToHex(Value1,4);
  254.         BinEntry1.Color := clWindow;
  255.         HexEntry1.Color := clWindow;
  256.         DoCalc;
  257.  
  258.      end
  259.      else begin
  260.  
  261.           MessageBeep($ffff);
  262.           BinEntry1.Color := clRed;
  263.  
  264.      end;
  265. end;
  266.  
  267.  
  268. {HexEntry2KeyUp handle key up events in the second hex entry text win-    }
  269. {dow.  See HexEntry1KeyUp for operational details.            }
  270.  
  271. procedure TLogicalOps.HexEntry2KeyUp(Sender: TObject; var Key: Word;
  272.   Shift: TShiftState);
  273. begin
  274.  
  275.      if (CheckHex(HexEntry2.Text)) then begin
  276.  
  277.         Value2 := HexToInt(HexEntry2.Text);
  278.         BinEntry2.Text := IntToBin(Value2,16);
  279.         HexEntry2.Color := clWindow;
  280.         BinEntry2.Color := clWindow;
  281.         DoCalc;
  282.  
  283.      end
  284.      else begin
  285.  
  286.           MessageBeep($ffff);
  287.           HexEntry2.Color := clRed;
  288.  
  289.      end;
  290. end;
  291.  
  292.  
  293. {BinEntry2KeyUp handles key up events in the second binary data entry    }
  294. {window.  See the HexEntry1KeyUp procedure for operational details.    }
  295.  
  296. procedure TLogicalOps.BinEntry2KeyUp( Sender: TObject;
  297.                                        var Key: Word;
  298.                                        Shift: TShiftState);
  299. begin
  300.  
  301.      if (CheckBin(BinEntry2.Text)) then begin
  302.  
  303.         Value2 := BinToInt(BinEntry2.Text);
  304.         HexEntry2.Text := IntToHex(Value2,4);
  305.         BinEntry2.Color := clWindow;
  306.         HexEntry2.Color := clWindow;
  307.         DoCalc;
  308.  
  309.      end
  310.      else begin
  311.  
  312.           MessageBeep($ffff);
  313.           BinEntry2.Color := clRed;
  314.  
  315.      end;
  316.  
  317. end;
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325. { The following procedure executes whenever the user presses the    }
  326. { "ABOUT" button on the form.                        }
  327.  
  328. procedure TLogicalOps.AboutBtnClick(Sender: TObject);
  329. begin
  330.  
  331.     MessageDlg(
  332.        'Logical Operations Calculator, Copyright 1995 by Randall Hyde',
  333.        mtInformation, [mbOk], 0);
  334.  
  335. end;
  336.  
  337.  
  338. { The "AndBtnClick" method runs whenever the user presses the AND but-    }
  339. { ton on the form.  It sets the global operation to logical AND, enables}
  340. { input in both data entry text box sets (since this is a dyadic opera-    }
  341. { tion), and it recalculates results.                    }
  342.  
  343. procedure TLogicalOps.AndBtnClick(Sender: TObject);
  344. begin
  345.  
  346.      Operation := ANDop;    {Set operation to logical AND.        }
  347.      BinEntry1.Enabled := true;    {Allow entry in the binary entry 1 and    }
  348.      HexEntry1.Enabled := true;    {hex entry 1 text boxes.        }
  349.      DoCalc;            {Recalculate results.            }
  350.      Reformat;            {Reformat the current input values.    }
  351.      CurrentOp.Caption := 'AND';{Display "AND" on the FORM.        }
  352.  
  353. end;
  354.  
  355.  
  356.  
  357.  
  358. { Same as above, but for the logical OR operation.            }
  359.  
  360. procedure TLogicalOps.OrBtnClick(Sender: TObject);
  361. begin
  362.  
  363.      Operation := ORop;
  364.      BinEntry1.Enabled := true;
  365.      HexEntry1.Enabled := true;
  366.      DoCalc;
  367.      Reformat;
  368.      CurrentOp.Caption := 'OR';
  369.  
  370. end;
  371.  
  372.  
  373. { Same as above, except this one handles the XOR button.        }
  374.  
  375. procedure TLogicalOps.XorBtnClick(Sender: TObject);
  376. begin
  377.  
  378.      Operation := XORop;
  379.      BinEntry1.Enabled := true;
  380.      HexEntry1.Enabled := true;
  381.      DoCalc;
  382.      Reformat;
  383.      CurrentOp.Caption := 'XOR';
  384.  
  385. end;
  386.  
  387.  
  388.  
  389. { Like the above, but the logical NOT operation is unary only, remember. }
  390. { Of course, unary vs. binary is handled in the DoCalc procedure.     }
  391.  
  392. procedure TLogicalOps.NotBtnClick(Sender: TObject);
  393. begin
  394.  
  395.      Operation := NOTop;
  396.      BinEntry1.Enabled := false;
  397.      HexEntry1.Enabled := false;
  398.      DoCalc;
  399.      Reformat;
  400.      CurrentOp.Caption := 'NOT';
  401.  
  402. end;
  403.  
  404.  
  405. { Procedure that runs when the user presses the NOT button        }
  406.  
  407. procedure TLogicalOps.NegBtnClick(Sender: TObject);
  408. begin
  409.  
  410.      Operation := NEGop;
  411.      BinEntry1.Enabled := false;
  412.      HexEntry1.Enabled := false;
  413.      DoCalc;
  414.      Reformat;
  415.      CurrentOp.Caption := 'NEG';
  416.  
  417. end;
  418.  
  419.  
  420. { Procedure that runs when the user presses the SHL button        }
  421.  
  422. procedure TLogicalOps.SHLBtnClick(Sender: TObject);
  423. begin
  424.  
  425.      Operation := SHLop;
  426.      BinEntry1.Enabled := false;
  427.      HexEntry1.Enabled := false;
  428.      DoCalc;
  429.      Reformat;
  430.      CurrentOp.Caption := 'SHL';
  431.  
  432. end;
  433.  
  434.  
  435. { Procedure that runs when the user presses the SHR button        }
  436.  
  437. procedure TLogicalOps.SHRBtnClick(Sender: TObject);
  438. begin
  439.  
  440.      Operation := SHRop;
  441.      BinEntry1.Enabled := false;
  442.      HexEntry1.Enabled := false;
  443.      DoCalc;
  444.      Reformat;
  445.      CurrentOp.Caption := 'SHR';
  446.  
  447. end;
  448.  
  449.  
  450. { Procedure that runs when the user presses the ROL button        }
  451.  
  452. procedure TLogicalOps.ROLBtnClick(Sender: TObject);
  453. begin
  454.  
  455.      Operation := ROLop;
  456.      BinEntry1.Enabled := false;
  457.      HexEntry1.Enabled := false;
  458.      DoCalc;
  459.      Reformat;
  460.      CurrentOp.Caption := 'ROL';
  461.  
  462. end;
  463.  
  464.  
  465. { Procedure that runs when the user presses the ROR button        }
  466.  
  467. procedure TLogicalOps.RORBtnClick(Sender: TObject);
  468. begin
  469.  
  470.      Operation := RORop;
  471.      BinEntry1.Enabled := false;
  472.      HexEntry1.Enabled := false;
  473.      DoCalc;
  474.      Reformat;
  475.      CurrentOp.Caption := 'ROR';
  476.  
  477. end;
  478.  
  479.  
  480. procedure TLogicalOps.FormClick(Sender: TObject);
  481. begin
  482.     Reformat;
  483. end;
  484.  
  485. end.
  486.