📄 canonu.pas
字号:
unit Canonu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, Aboutu;
type
TLogEqns = class(TForm)
InputEqn: TEdit;
Label1: TLabel;
tt00: TPanel;
tt01: TPanel;
tt02: TPanel;
tt03: TPanel;
tt10: TPanel;
tt11: TPanel;
tt12: TPanel;
tt13: TPanel;
tt20: TPanel;
tt21: TPanel;
tt22: TPanel;
tt23: TPanel;
tt30: TPanel;
tt31: TPanel;
tt32: TPanel;
tt33: TPanel;
ba00: TLabel;
ba01: TLabel;
ba10: TLabel;
ba11: TLabel;
dc00: TLabel;
dc01: TLabel;
dc10: TLabel;
dc11: TLabel;
ExitBtn: TButton;
AboutBtn: TButton;
ComputeBtn: TButton;
Eqn1: TLabel;
Eqn2: TLabel;
PrintBtn: TButton;
PrintDialog: TPrintDialog;
procedure FormCreate(Sender: TObject);
procedure ExitBtnClick(Sender: TObject);
procedure AboutBtnClick(Sender: TObject);
procedure PrintBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure InputEqnChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
LogEqns: TLogEqns;
implementation
type
TPType = array [0..1,0..1,0..1,0..1] of TPanel;
var
tt: TPType;
{$R *.DFM}
(* ComputeEqn- Computes the logic equation string from the current *)
(* truth table entries. *)
procedure ComputeEqn;
{ ApndStr- item contains '0' or '1' -- the character in the}
{ current truth table cell. theStr is a string }
{ of characters to append to the equation if item }
{ is equal to '1'. }
procedure ApndStr(item:char; const theStr:string);
begin
with LogEqns do begin
{ To make everything fit on our form, we have to break }
{ the equation up into two lines. If the first line }
{ hits 66 characters, append the characters to the end }
{ of the second string. }
if (length(eqn1.Caption) < 66) then begin
{ If we are appending to the end of EQN1, we have to }
{ check to see if the string's length is zero. If }
{ not, then we need to stick ' + ' between the }
{ existing string and the string we are appending. }
{ If the string length is zero, this is the first }
{ minterm so we don't prepend the ' + '. }
if (item = '1') then
if (length(eqn1.Caption) = 0) then
eqn1.Caption := theStr
else eqn1.Caption := eqn1.Caption + ' + ' + theStr;
end
else if (item = '1') then
eqn2.Caption := eqn2.Caption + ' + ' + theStr;
end;
end;
begin
with LogEqns do begin
eqn1.Caption := '';
eqn2.Caption := '';
{ Determine if two variable truth table. tt12 }
{ will only be visible if we've got a three or }
{ four variable truth table. }
if (not tt12.Visible) then begin
{ Test the 2x2 square in the upper left }
{ hand corner of the truth table and build }
{ the logic equation from the values in }
{ these squares. }
ApndStr(tt00.Caption[1],'B''A''');
ApndStr(tt01.Caption[1],'B''A');
ApndStr(tt10.Caption[1], 'BA''');
ApndStr(tt11.Caption[1], 'BA');
end
else begin {We've got three or four variables here }
{ See if three or four variable truth table }
{ tt20 will only be visible if we have a }
{ four variable truth table. }
if (not tt20.Visible) then begin
{ Build the logic equation from the top }
{ eight squares in the truth table. }
ApndStr(tt00.Caption[1],'C''B''A''');
ApndStr(tt01.Caption[1],'C''B''A');
ApndStr(tt02.Caption[1], 'C''BA''');
ApndStr(tt03.Caption[1], 'C''BA');
ApndStr(tt10.Caption[1],'CB''A''');
ApndStr(tt11.Caption[1],'CB''A');
ApndStr(tt12.Caption[1], 'CBA''');
ApndStr(tt13.Caption[1], 'CBA');
end
else begin {We've got a four-variable truth table }
{ Build the logic equation from all the squares }
{ in the truth table. }
ApndStr(tt00.Caption[1],'D''C''B''A''');
ApndStr(tt01.Caption[1],'D''C''B''A');
ApndStr(tt02.Caption[1], 'D''C''BA''');
ApndStr(tt03.Caption[1], 'D''C''BA');
ApndStr(tt10.Caption[1],'D''CB''A''');
ApndStr(tt11.Caption[1],'D''CB''A');
ApndStr(tt12.Caption[1], 'D''CBA''');
ApndStr(tt13.Caption[1], 'D''CBA');
ApndStr(tt20.Caption[1],'DC''B''A''');
ApndStr(tt21.Caption[1],'DC''B''A');
ApndStr(tt22.Caption[1], 'DC''BA''');
ApndStr(tt23.Caption[1], 'DC''BA');
ApndStr(tt30.Caption[1],'DCB''A''');
ApndStr(tt31.Caption[1],'DCB''A');
ApndStr(tt32.Caption[1], 'DCBA''');
ApndStr(tt33.Caption[1], 'DCBA');
end;
end;
{ If after all the above the string is empty, then we've got a }
{ truth table that contains all zeros. Handle that special }
{ case down here. }
if (length(eqn1.Caption) = 0) then
eqn1.Caption := '0';
Eqn1.Caption := 'F= ' + Eqn1.Caption;
end;
end;
procedure TLogEqns.FormCreate(Sender: TObject);
begin
tt[0,0,0,0] := tt00;
tt[0,0,0,1] := tt01;
tt[0,0,1,0] := tt02;
tt[0,0,1,1] := tt03;
tt[0,1,0,0] := tt10;
tt[0,1,0,1] := tt11;
tt[0,1,1,0] := tt12;
tt[0,1,1,1] := tt13;
tt[1,0,0,0] := tt20;
tt[1,0,0,1] := tt21;
tt[1,0,1,0] := tt22;
tt[1,0,1,1] := tt23;
tt[1,1,0,0] := tt30;
tt[1,1,0,1] := tt31;
tt[1,1,1,0] := tt32;
tt[1,1,1,1] := tt33;
end;
procedure TLogEqns.ExitBtnClick(Sender: TObject);
begin
Halt;
end;
procedure TLogEqns.AboutBtnClick(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TLogEqns.PrintBtnClick(Sender: TObject);
begin
if (PrintDialog.Execute) then
LogEqns.Print;
end;
procedure TLogEqns.ComputeBtnClick(Sender: TObject);
var
Equation : string;
CurChar : integer;
dest,
i: integer;
{ Parse- Parses the "Equation" string and evaluates it. }
{ Returns the equation's value if legal expression, returns }
{ -1 if the equation is syntactically incorrect. }
{ }
{ Grammar: }
{ S -> X + S | X }
{ X -> YX | Y }
{ Y -> Y' | Z }
{ Z -> a | b | c | d | ( S ) }
function parse(D, C, B, A:integer):integer;
function X(D,C,B,A:integer):integer;
function Y(D,C,B,A:integer):integer;
function Z(D,C,B,A:integer):integer;
begin
case (Equation[CurChar]) of
'(': begin
CurChar := CurChar + 1;
Result := parse(D,C,B,A);
if (Equation[CurChar] <> ')') then
Result := -1
else CurChar := CurChar + 1;
end;
'a': begin
CurChar := CurChar + 1;
Result := A;
end;
'b': begin
CurChar := CurChar + 1;
Result := B;
end;
'c': begin
CurChar := CurChar + 1;
Result := C;
end;
'd': begin
CurChar := CurChar + 1;
Result := D;
end;
'0': begin
CurChar := CurChar + 1;
Result := 0;
end;
'1': begin
CurChar := CurChar + 1;
Result := 1;
end;
else Result := -1;
end;
end;
begin {Y}
{ Note: This particular operation is left recursive }
{ and would require considerable grammar transform- }
{ ation to repair. However, a simple trick is to }
{ note that the result would have tail recursion }
{ which we can solve iteratively rather than recur- }
{ sively. Hence the while loop in the following }
{ code. }
Result := Z(D,C,B,A);
while (Result <> -1) and (Equation[CurChar] = '''') then
begin
Result := Result xor 1;
CurChar := CurChar + 1;
end;
end;
begin {X}
Result := Y(D,C,B,A);
if (Result <> -1) and (Equation[CurChar] <> chr(0)) then
Result := Result AND X(D,C,B,A);
end;
begin
Result := X(D,C,B,A);
if (Result <> -1) and (Equation[CurChar] = '+') then begin
CurChar := CurChar + 1;
Result := Result OR parse(D, C, B, A);
end;
end;
var
a, b, c, d:integer;
begin {ComputeBtnClick}
Equation := LowerCase(InputEqn.Text) + chr(0);
{ Remove any spaces present in the string }
dest := 1;
for i := 1 to length(Equation) do
if (Equation[i] <> ' ') then begin
Equation[dest] := Equation[i];
dest := dest + 1;
end;
{ Okay, see if this string is syntactically legal. }
CurChar := 1; {Start at position 1 in string }
if (Parse(0,0,0,0) <> -1) then begin
{ Compute the values for each of the squares in }
{ the truth table. }
for d := 0 to 1 do
for c := 0 to 1 do
for b := 0 to 1 do
for a := 0 to 1 do begin
CurChar := 1;
if (parse(d,c,b,a) = 0) then
tt[d,c,b,a].Caption := '0'
else tt[d,c,b,a].Caption := '1';
end;
ComputeEqn;
InputEqn.Color := clWindow;
end
else InputEqn.Color := clRed;
end;
procedure TLogEqns.InputEqnChange(Sender: TObject);
begin
ComputeBtn.Default := true;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -