TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Newbie
Ještě to není hotové, zatím je to hodně user-nonfriendly. A sry že tam nejsou komentáře :)
unit unita;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TArr = array ['a'..'o',1..32768] of boolean;
TForm1 = class(TForm)
Button2: TButton;
Edit1: TEdit;
Memo1: TMemo;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function cistupis(i:longint):char;
function kulata(t:string):boolean;
function hranata(t:string):boolean;
function slozena(t:string):boolean;
function odzavorkuj(t:string):string;
procedure tokenizer;
function nenizav(t:string):boolean;
function konjunkce(a,b:boolean):boolean;
function disjunkce(a,b:boolean):boolean;
function implikace(a,b:boolean):boolean;
function ekvivalence(a,b:boolean):boolean;
function pocetpismen(t:string):longint;
procedure vyhodnotto;
function nmocnina(zaklad:longint;exponent:longint):longint;
function mistoznamenka(t:string):longint;
function strtobool(t:string):boolean;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function tform1.strtobool(t: string):boolean;
begin
if t='1' then result:=true else result:=false;
end;
function tform1.cistupis(i: longint):char;
begin
case i of
1:result:='a';
2:result:='b';
3:result:='c';
4:result:='d';
5:result:='e';
6:result:='f';
7:result:='g';
8:result:='h';
9:result:='i';
10:result:='j';
11:result:='k';
12:result:='l';
13:result:='m';
14:result:='n';
15:result:='o';
end;
end;
function tform1.nmocnina(zaklad: longint; exponent: longint):longint;
var i:longint;
begin
result:=zaklad;
for I := 2 to exponent do result:=result*zaklad;
end;
function tform1.kulata(t: string):boolean;
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='(' then result:=true;
end;
procedure TForm1.vyhodnotto;
var a,k,o,krok,x,pozice,i,komb:longint;
arr:Tarr;
b,vyrok1,vyrok2:boolean;
t,res:string;
c:char;
begin
a:=pocetpismen(Edit1.Text);
k:=nmocnina(2,a);
memo1.lines.add('--------Začíná vyhodnotto--------');
memo1.lines.add(inttostr(a));
memo1.lines.add(inttostr(k));
stringgrid1.colcount:=2+k;
stringgrid1.defaultcolwidth:=(stringgrid1.width-10) div stringgrid1.colcount;
for o := 1 to a do
begin
krok:=nmocnina(2,o-1);
if o=1 then krok:=1;
memo1.lines.add('krok' + inttostr(krok));
for x:=1 to k do if (((x-1)div krok)mod 2)=0 then
begin
arr[cistupis(o),x]:=true;
stringgrid2.cells[0,o-1]:=cistupis(o);
stringgrid2.cells[x,o-1]:='1';
end
else
begin
arr[cistupis(o),x]:=false;
stringgrid2.cells[0,o-1]:=cistupis(o);
stringgrid2.cells[x,o-1]:='0';
end;
end;
for komb := 1 to k do
begin
for x:=1 to stringgrid1.rowcount do
begin
res:='';
t:=stringgrid1.cells[1,x-1];
memo1.lines.add(t);
pozice:=mistoznamenka(t);
memo1.lines.add('pozice znamenka :' +inttostr(pozice));
if pozice=2 then
begin
c:=t[1];
memo1.lines.add('jednopísmenná proměnná ' +c);
vyrok1:=arr[c,komb];
if vyrok1=true then memo1.lines.add('!!!TRUE!!!');
end
else
begin
for i:=1 to pozice do if t[i]='"' then break;
i:=i+1;
while not (t[i]='"') do
begin
if t[i]<>'"' then res:=res+t[i];
i:=i+1;
end;
memo1.lines.add('výsledek :' +res);
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]
then break;
vyrok1:=strtobool(stringgrid1.Cells[1+komb,i-1]);
end;
res:='';
if length(t)=pozice+1 then
begin
c:=t[pozice+1];
memo1.lines.add('jednopísmenná proměnná2:'+c);
vyrok2:=arr[c,komb];
if vyrok1=true then memo1.lines.add('!!!TRUE!!!');
end
else
begin
for i:=pozice+1 to length(t) do if t[i]='"' then break;
i:=i+1;
while not (t[i]='"') do
begin
if t[i]<>'"' then res:=res+t[i];
i:=i+1;
end;
memo1.lines.add('výsledek2 :' +res);
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]
then break;
vyrok2:=strtobool(stringgrid1.Cells[1+komb,i-1]);
end;
case t[pozice] of
'&':b:=konjunkce(vyrok1,vyrok2);
'D':b:=disjunkce(vyrok1,vyrok2);
'I':b:=implikace(vyrok1,vyrok2);
'E':b:=ekvivalence(vyrok1,vyrok2);
end;
if b=true then stringgrid1.cells[1+komb,x-1]:='1';
if b=false then stringgrid1.Cells[1+komb,x-1]:='0';
end;
end;
end;
function tform1.mistoznamenka(t:string):longint;
var i:longint;
begin
for i:=1 to length(t) do if (t[i]='&') or (t[i]='D')
or (t[i]='I') or (t[i]='E') then
begin
result:=i;
exit;
end;
end;
function TForm1.konjunkce(a: Boolean; b: Boolean):boolean;
begin
if a and b then result:=true else result:=false;
end;
function TForm1.hranata(t: string):boolean;
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='[' then result:=true;
end;
function TForm1.slozena(t: string):boolean;
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='{' then result:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
tokenizer;
vyhodnotto;
Button2.enabled:=false;
Button1.enabled:=true;
end;
function TForm1.disjunkce(a: Boolean; b: Boolean):boolean;
begin
if a or b then result:=true else result:=false;
end;
function TForm1.implikace(a: Boolean; b: Boolean):boolean;
begin
if (a=true) and (b=false) then result:=false else result:=true;
end;
function TForm1.ekvivalence(a: Boolean; b: Boolean):boolean;
begin
if a=b then result:=true else result:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.lines.Clear;
end;
function TForm1.pocetpismen(t:string):longint;
var c:char;
i,a:longint;
ar:array['a'..'z'] of boolean;
begin
t:=edit1.text;
a:=0;
for c:='a' to 'z' do ar[c]:=true;
for i:=1 to length(t) do
begin
for c := 'a' to 'z' do if t[i]=c then
begin
if ar[c]=true then
begin
ar[c]:=false;
a:=a+1;
end;
end;
end;
result:=a;
end;
function tform1.nenizav(t:string):boolean;
begin
result:=true;
if kulata(t) or hranata(t) or slozena(t) then result:=false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;
function tform1.odzavorkuj(t: string):string;
var i:longint;
puv,res:string;
begin
puv:=t;
result:='';
if hranata(t) then
begin
for I := 1 to length(t) do
begin
if (t[i]<>'[') and (t[i]<>']')then res:=res+t[i];
if t[i]='[' then res:=res+'(';
if t[i]=']' then res:=res+')';
end;
end;
t:=res;
if slozena(t) then
begin
res:='';
for I := 1 to length(t) do
begin
if (t[i]<>'{') and (t[i]<>'}')then res:=res+t[i];
if t[i]='{' then res:=res+'[';
if t[i]='}' then res:=res+']';
end;
end;
if kulata(puv)=true then result:=puv else result:=res;
memo1.lines.add(result);
end;
procedure tform1.tokenizer;
var t, res:string;
i,x,y,z:longint;
c:char;
nalezeno:boolean;
begin
z:=0;
t:=edit1.text;
repeat
begin
for i:=1 to length(t) do
begin
nalezeno:=false;
c:=t[i];
if c='(' then
begin
nalezeno:=true;
z:=z+1;
x:=i+1;
res:='';
c:='0';
while not (c=')') do
begin
c:=t[x];
if c<>')' then res:=res+c;
x:=x+1;
end;
end;
if nalezeno then break;
end;
if nalezeno then
begin
memo1.lines.add('VK' + inttostr(z) + ' : ' + res);
stringgrid1.cells[0,z-1]:='VK'+inttostr(z);
stringgrid1.cells[1,z-1]:=res;
stringgrid1.RowCount:=stringgrid1.RowCount+1;
res:='';
for y:=1 to i-1 do res:=res+t[y];
res:=res+ ('"VK' + inttostr(z)+'"');
for y:=x to length(t) do res:=res+t[y];
t:=res;
end;
memo1.lines.add(res);
if nenizav(t)=false then t:=odzavorkuj(t);
end
until nenizav(t)=true;
stringgrid1.cells[0,z]:='Result';
stringgrid1.cells[1,z]:=t;
end;
end.
Nahlásit jako SPAM
IP: 83.69.32.–
Zjistit počet nových příspěvků
