TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Díky moc!
Příspěvky odeslané z IP adresy 83.69.32.–
Danstahr
Danstahr
je to soutěž Pařmen 2008 na warforu
http://www1.warforum.cz/viewtopic.php?t=649367
Danstahr
každý hledá odpovědi svým způsobem... já sem hledal a na nic jsem nepřišel... držim si 2. míasto a pochopitelně o něj nechci přijít a absolutně nemám tušení, z čeho to může být... alespoň nějaký malý náznak pls... :smile7:
Danstahr
prosím prosím pomozte...
Danstahr
Zdravím,
potřebuju nutně vědět z jaký je to hry... Pomozte lidé dobří!
http://www.edisk.cz/stahni/26701/poznas_hru25.mp3_1.84MB.htmlTak jsem si s tím ještě trošku pohrál, snad je to poznat... ;) Formátování vstupu tam není, protože k tomu bude GUI které si to bude hlídat samo...
unit unita;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls,StrUtils;
const
maxvyrok='o';
type
TArr = array ['a'..maxvyrok,1..32768{2 na cistupis(maxvyrok)}] of boolean;
TForm1 = class(TForm)
Go: TButton;
Edit1: TEdit;
Memo1: TMemo;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Restart: TButton;
procedure RestartClick(Sender: TObject);
procedure GoClick(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;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function tform1.cistupis(i: longint):char;//jednoduše přiřadí dané číslici písmeno
begin
Result := Chr(i + 96)
end;
function tform1.kulata(t: string):boolean; //zjistí, zda je v řetězci kulatá závorka
begin
result:=(Pos('(', t) > 0)
end;
function tform1.hranata(t: string):boolean; //zjistí, zda je v řetězci hranatá závorka
begin
result:=(Pos('[', t) > 0)
end;
function TForm1.slozena(t: string):boolean;
begin
result:=(Pos('{',t)>0);
end;
function tform1.odzavorkuj(t: string):string; //převede všechny závorky o stupeň níž, pokud je v řetězci kulatá závorka, vrátí původní řetězec
begin
if kulata(t) then result:=t
else
begin
if slozena(t) and not hranata(t) then //ušetří se celý cyklus tím, že rovnou složená ->kulatá
begin //oproti složená -> hranatá -> kulatá
t := AnsiReplaceText(t, '{', '(');
t := AnsiReplaceText(t, '}', ')');
end
else
begin
t := AnsiReplaceText(t, '[', '(');
t := AnsiReplaceText(t, ']', ')');
t := AnsiReplaceText(t, '{', '[');
t := AnsiReplaceText(t, '}', ']');
end;
result:=t;
end;
end;
procedure tform1.tokenizer;//celá procedura dělí řetězec do částí po závorkách - na konci je výstup bez závorek
var t, res:string;
i,x,z:longint;
begin
z:=0;//proměnná Z určuje celkový počet podvýroků
t:=edit1.text;
repeat
begin
if kulata (t) then
begin
z:=z+1;
i:=pos('(',t);//najdeme první kulatou závorku;
x:=pos(')',t);//v řetězci najdeme konečnou závorku
stringgrid1.cells[0,z-1]:='VK'+inttostr(z);//do prvního sloupečku stringgridu zapiš VK a číslo výroku... výrazem VK se posléze nahradí závorka
res:=copy(t,i+1,x-i-1);//zjistí obsah závorky;
stringgrid1.cells[1,z-1]:=res; //do druhého sloupečku StringGridu zapiš původní obsah závorky
stringgrid1.RowCount:=stringgrid1.RowCount+1;//přidej řádek do StringGridu
res:=copy(t,1,i-1);//zjistí co je před závorkou
res:=res+('"VK' + inttostr(z)+'"');//místo závorky napiš "VKx", x je číslo podvýroku
res:=res+copy(t,x+1,length(t));;//a zbytek opiš
t:=res;//a ulož upravený řetězec do var t, se kterou se pracuje...
end;
if nenizav(t)=false then t:=odzavorkuj(t);//pokud je v řetězci závorka tak proveď funkci odzavorkuj
end
until nenizav(t)=true;//a celé to opakuj dokud řetězec nebude bez závorek
stringgrid1.cells[0,z]:='Result';//a na poslední řádek do StringGridu připiš RESULT
stringgrid1.cells[1,z]:=t; //a to, co z původního řetězce zbylo
end;
function tform1.nenizav(t:string):boolean;//zjistí, jestli je v řetězci závorky
begin
result:=true;
if kulata(t) or hranata(t) or slozena(t) then result:=false;
end;
function TForm1.konjunkce(a: Boolean; b: Boolean):boolean; //logické operace...
begin
if a and b then result:=true else result:=false;
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.GoClick(Sender: TObject);
begin
tokenizer;
vyhodnotto;
Go.Enabled:=false;
Restart.Enabled:=true;
end;
function TForm1.pocetpismen(t:string):longint;//zjistí počet písmen v řetězci
var c:char;
i,a:longint;
ar:array['a'..maxvyrok] of boolean;
begin
t:=Edit1.text;
a:=0; //začátek - 0 písmen
for c:='a' to maxvyrok do ar[c]:=true; //zatím žádné písmeno nebylo nalezeno
for i:=1 to length(t) do if (t[i] in ['a'..maxvyrok]) then//pro celý řetězec udělej
begin
if ar[t[i]]=true then //pokud to písmeno ještě nebylo nalezeno pak
begin
ar[t[i]]:=false;//to písmeno označ za nalezené
a:=a+1; //a přičti k počtu písmen 1
end;
end;
result:=a;//a jako výstupní hodnotu uveď a=počet písmen
end;
procedure TForm1.RestartClick(Sender: TObject);
var FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;
procedure TForm1.vyhodnotto;
var pismen,kombinaci,o,krok,x,pozice,i,komb,subr:longint;
arr:Tarr;
b,vyrok1,vyrok2:boolean;
t,res:string;
c:char;
begin
pismen:=pocetpismen(Edit1.Text);//zjistíme počet písmen = počet výroků zadaných na začátku
kombinaci:=nmocnina(2,pismen); //počet kombinací je 2 na počet výroků
stringgrid1.colcount:=2+kombinaci; //sloupečky jsou standartně 2 + počet kombinací, pro každou 1 sloupec
stringgrid1.defaultcolwidth:=(stringgrid1.width-10) div stringgrid1.colcount; //nastav šířku sloupců tak, aby se to vešlo
for o := 1 to pismen do //vyplní tabulku hodnot - a : 1010, b : 1100...
begin
krok:=nmocnina(2,o-1);//krok - určuje, po kolika vyplněných polích se střídá 1 a 0, např. pro krok 2 bude řetězec 1100...
for x:=1 to kombinaci do if (((x-1)div krok)mod 2)=0 then
{tohle se mi moc líbí - funguje to takhle :
pokud x celočíselně dělím krokem, dostanu vždy řadu číslic za sebou, číslice se změní právě po
počtu číslic, které udává krok. Např. pro krok=4 a pro x=1-16 dostanu 0001111222233334.
protože se mi však nehodí to, že začínám pouze třemi a ne 4 číslicemi. proto od x odečtu 1.
pak už dostanu x z intervalu 0-15 a řetězec bude vypadat 0000111122223333. Pokud tyto čísla zbytkově
dělím dvěma, pak výsledkem celé operace nahoře je 0000111100001111. Jelikož se ale většinou začíná
jedničkou a ne nulou, proto pro nulu nastavuji true a pro 1 false.}
begin
arr[cistupis(o),x]:=true;//příslušné políčko bool pole true
stringgrid2.cells[0,o-1]:=cistupis(o);//a zapiš do 2. stringgridu proměnnou
stringgrid2.cells[x,o-1]:='1'; //a její hodnotu
end
else
begin
arr[cistupis(o),x]:=false; //totéž, akorát s fasle
stringgrid2.cells[0,o-1]:=cistupis(o);
stringgrid2.cells[x,o-1]:='0';
end;
end;
for komb := 1 to kombinaci do //pro každou z kombinací proveď
begin
for x:=1 to stringgrid1.rowcount do //pro všechny sloupce SG proveď
begin
t:=stringgrid1.cells[1,x-1]; //načte do t řetězec ze SG - výrok
pozice:=mistoznamenka(t); //zjistíme polohu logické spojky v řetězci
if pozice=2 then//pokud je pozice znaménka 2, pak to znamená, že před
begin//znaménkem se nachází pouze jednopísmenná proměnná, kterou je třeba hledat v původní tabulce jednoduchých výroků
c:=t[1];//tak si zjistíme, co je to za výrok
vyrok1:=arr[c,komb];//najdeme si v poli pravd. hodnotu pro příslušnou kombinaci
end
else //jinak to znamená, že se před tím nachází nějaký výrok typu "VKx"
begin
i:=pos('"',t);//poloha prvních uvozovek
subr:=pos('"',copy(t,i+1,pozice-i-1))-1;//určíme délku textu mezi uvozovkami
res:=copy(t,i+1,subr);//do res uložíme to, co je mezi uvozovkami
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]//a hledej to, co je mezi uvozovkami ve SG...
then begin
vyrok1:=strtobool(stringgrid1.Cells[1+komb,i-1]);
break;
end;
end;
if length(t)=pozice+1 then //to samé co před spojkou provede s částí za spojkou
begin
c:=t[pozice+1];
vyrok2:=arr[c,komb];
end
else
begin
i:=pos('"',copy(t,pozice+1,length(t)-pozice-2))+pozice;
subr:=pos('"',copy(t,i+1,length(t)-i))-1;
res:=copy(t,i+1,subr);
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]
then begin
vyrok2:=strtobool(stringgrid1.Cells[1+komb,i-1]);
break;
end;
end;
case t[pozice] of //a pošle to na vyhodnocení do podprocedury
'&':b:=konjunkce(vyrok1,vyrok2);
'D':b:=disjunkce(vyrok1,vyrok2);
'I':b:=implikace(vyrok1,vyrok2);
'E':b:=ekvivalence(vyrok1,vyrok2);
end;
if b then stringgrid1.cells[1+komb,x-1]:='1' else stringgrid1.Cells[1+komb,x-1]:='0'; //a zapíše do SG
end;
end;
end;
function tform1.nmocnina(zaklad: longint; exponent: longint):longint; //vrátí entou mocninu čísla, pro moje potřeby to takhle naprosto stačí...
var i:longint;
begin
result:=1;
for I := 1 to exponent do result:=result*zaklad;
end;
function tform1.mistoznamenka(t:string):longint; //určí pozici log. spojky
var i:longint;
begin
for i:=1 to length(t) do if t[i] in ['&','I','E','D'] then
begin
result:=i;
exit;
end;
end;
end.0) ti chci poděkovat, že se se mnou vůbec zabýváš :))
1) předěláno + upravený Tokenizer (na zbytek kódu nebyl čas) :) fakt moc díky za ty tipy na jeden řádek řikám když něco nevim (v prvotní fázi, když si to pak rozebírám ke konci, už to třeba vygooglim :) ) , tak se to místo googlení snažim vyřešit tim, co vim. Sice se nenaučim nový příkazy , ale snažim si rozvíjet logický myšlení tim, že přemejšlim jak to vyřešit pomocí toho co vim.
2) nevím, jaký má konkrétně tohle význam, ale budiž...
3) jo, už jsem si všimnul že ten podělanej text Memo1 je ve v Object Inspectoru ve Strings :)
4) předěláno
5) nevim, jsem v prváku na střední a jen dělám to co umim, vždycky byla kulatá - hranatá - složená...
6) hmm... dobře no s těmi konstantami...
a ta fce cistupis je náramně zajímavá, díky za tip... předpokládám, že slovíčko "in" znamená "z intervalu"... akorát nechápu kousíček Chr(Poradie + Pred(97)) - co je to to pred?
trochu bordelu nakonec :
unit unita;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls,StrUtils;
const
maxvyrok='o';
type
TArr = array ['a'..maxvyrok,1..32768] of boolean;
TForm1 = class(TForm)
Go: TButton;
Edit1: TEdit;
Memo1: TMemo;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Restart: TButton;
procedure RestartClick(Sender: TObject);
procedure GoClick(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;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function tform1.cistupis(i: longint):char;//jednoduše přiřadí dané číslici písmeno
begin
Result := Chr(i + 96)
end;
function tform1.kulata(t: string):boolean; //zjistí, zda je v řetězci kulatá závorka
begin
result:=(Pos('(', t) > 0)
end;
function tform1.hranata(t: string):boolean; //zjistí, zda je v řetězci hranatá závorka
begin
result:=(Pos('[', t) > 0)
end;
function TForm1.slozena(t: string):boolean;
begin
result:=(Pos('{',t)>0);
end;
function tform1.odzavorkuj(t: string):string; //převede všechny závorky o stupeň níž, pokud je v řetězci kulatá závorka, vrátí původní řetězec
begin
if kulata(t) then result:=t
else
begin
t := AnsiReplaceText(t, '[', '(');
t := AnsiReplaceText(t, ']', ')');
t := AnsiReplaceText(t, '{', '[');
t := AnsiReplaceText(t, '}', ']');
result:=t;
end;
end;
procedure tform1.tokenizer;//celá procedura dělí řetězec do částí po závorkách - na konci je výstup bez závorek
var t, res:string;
i,x,y,z:longint;
c:char;
nalezeno:boolean;
begin
z:=0;//proměnná Z určuje celkový počet podvýroků
t:=edit1.text;
repeat
begin
if kulata (t) then
begin
res:='';
z:=z+1;
i:=pos('(',t);//najdeme první kulatou závorku;
x:=pos(')',t);//v řetězci najdeme konečnou závorku
stringgrid1.cells[0,z-1]:='VK'+inttostr(z);//do prvního sloupečku stringgridu zapiš VK a číslo výroku... výrazem VK se posléze nahradí závorka
for y := i+1 to x-1 do res:=res+t[y];
stringgrid1.cells[1,z-1]:=res; //do druhého sloupečku StringGridu zapiš původní obsah závorky
stringgrid1.RowCount:=stringgrid1.RowCount+1;//přidej řádek do StringGridu
res:='';
for y:=1 to i-1 do res:=res+t[y];//všechno, co bylo před závorkou, zkopíruj do výstupu res
res:=res+ ('"VK' + inttostr(z)+'"');//místo závorky napiš "VKx", x je číslo podvýroku
for y:=x+1 to length(t) do res:=res+t[y];//a zbytek opiš
t:=res;//a ulož upravený řetězec do var t, se kterou se pracuje...
end;
if nenizav(t)=false then t:=odzavorkuj(t);//pokud je v řetězci závorka tak proveď funkci odzavorkuj
end
until nenizav(t)=true;//a celé to opakuj dokud řetězec nebude bez závorek
stringgrid1.cells[0,z]:='Result';//a na poslední řádek do StringGridu připiš RESULT
stringgrid1.cells[1,z]:=t; //a to, co z původního řetězce zbylo
showmessage('');
end;
function tform1.nenizav(t:string):boolean;//zjistí, jestli je v řetězci závorky
begin
result:=true;
if kulata(t) or hranata(t) or slozena(t) then result:=false;
end;
function TForm1.konjunkce(a: Boolean; b: Boolean):boolean; //logické operace...
begin
if a and b then result:=true else result:=false;
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.GoClick(Sender: TObject);
begin
tokenizer;
vyhodnotto;
Go.Enabled:=false;
Restart.Enabled:=true;
end;
function TForm1.pocetpismen(t:string):longint;//zjistí počet písmen v řetězci
var c:char;
i,a:longint;
ar:array['a'..'z'] of boolean;
begin
t:=Edit1.text;
a:=0; //začátek - 0 písmen
for c:='a' to 'z' do ar[c]:=true; //zatím žádné písmeno nebylo nalezeno
for i:=1 to length(t) do //pro celý řetězec udělej
begin
for c := 'a' to 'z' do if t[i]=c then //otestuj to na každé písmeno
begin
if ar[c]=true then //pokud to písmeno ještě nebylo nalezeno pak
begin
ar[c]:=false;//to písmeno označ za nalezené
a:=a+1; //a přičti k počtu písmen 1
end;
break;//nemá smysl dál testovat
end;
end;
result:=a;//a jako výstupní hodnotu uveď a=počet písmen
end;
procedure TForm1.RestartClick(Sender: TObject);
var FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;
procedure TForm1.vyhodnotto;
var pismen,kombinaci,o,krok,x,pozice,i,komb:longint;
arr:Tarr;
b,vyrok1,vyrok2:boolean;
t,res:string;
c:char;
begin
pismen:=pocetpismen(Edit1.Text);//zjistíme počet písmen = počet výroků zadaných na začátku
kombinaci:=nmocnina(2,pismen); //počet kombinací je 2 na počet výroků
memo1.lines.add('--------Začíná vyhodnotto--------'); //kontrola do mema
memo1.lines.add(inttostr(pismen));
memo1.lines.add(inttostr(kombinaci));
stringgrid1.colcount:=2+kombinaci; //sloupečky jsou standartně 2 + počet kombinací, pro každou 1 sloupec
stringgrid1.defaultcolwidth:=(stringgrid1.width-10) div stringgrid1.colcount; //nastav šířku sloupců tak, aby se to vešlo
for o := 1 to pismen do //vyplní tabulku hodnot - a : 1010, b : 1100...
begin
krok:=nmocnina(2,o-1);//krok - určuje, po kolika vyplněných polích se střídá 1 a 0, např. pro krok 2 bude řetězec 1100...
memo1.lines.add('krok' + inttostr(krok)); //kontrola
for x:=1 to kombinaci do if (((x-1)div krok)mod 2)=0 then
{tohle se mi moc líbí - funguje to takhle :
pokud x celočíselně dělím krokem, dostanu vždy řadu číslic za sebou, číslice se změní právě po
počtu číslic, které udává krok. Např. pro krok=4 a pro x=1-16 dostanu 0001111222233334.
protože se mi však nehodí to, že začínám pouze třemi a ne 4 číslicemi. proto od x odečtu 1.
pak už dostanu x z intervalu 0-15 a řetězec bude vypadat 0000111122223333. Pokud tyto čísla zbytkově
dělím dvěma, pak výsledkem celé operace nahoře je 0000111100001111. Jelikož se ale většinou začíná
jedničkou a ne nulou, proto pro nulu nastavuji true a pro 1 false.}
begin
arr[cistupis(o),x]:=true;//příslušné políčko bool pole true
stringgrid2.cells[0,o-1]:=cistupis(o);//a zapiš do 2. stringgridu proměnnou
stringgrid2.cells[x,o-1]:='1'; //a její hodnotu
end
else
begin
arr[cistupis(o),x]:=false; //totéž, akorát s fasle
stringgrid2.cells[0,o-1]:=cistupis(o);
stringgrid2.cells[x,o-1]:='0';
end;
end;
for komb := 1 to kombinaci do //pro každou z kombinací proveď
begin
for x:=1 to stringgrid1.rowcount do //pro všechny sloupce SG proveď
begin
res:='';
t:=stringgrid1.cells[1,x-1]; //načte do t řetězec ze SG - výrok
memo1.lines.add(t); //kontrola
pozice:=mistoznamenka(t); //zjistíme polohu logické spojky v řetězci
memo1.lines.add('pozice znamenka :' +inttostr(pozice));//kontrola
if pozice=2 then//pokud je pozice znaménka 2, pak to znamená, že před
begin//znaménkem se nachází pouze jednopísmenná proměnná, kterou je třeba hledat v původní tabulce jednoduchých výroků
c:=t[1];//tak si zjistíme, co je to za výrok
memo1.lines.add('jednopísmenná proměnná ' +c);//ověření
vyrok1:=arr[c,komb];//najdeme si v poli pravd. hodnotu pro příslušnou kombinaci
if vyrok1=true then memo1.lines.add('!!!TRUE!!!'); //zkouška
end
else //jinak to znamená, že se před tím nachází nějaký výrok typu "VKx"
begin
for i:=1 to pozice do if t[i]='"' then break;//až najdeš uvozovky, ukonči hledání
i:=i+1;//nastaví pozici za uvozovkami
while not (t[i]='"') do //dokud nenajdeš další uvozovky, tak
begin
if t[i]<>'"' then res:=res+t[i]; //do res zapisuj to, co je mezi nimi
i:=i+1;
end;
memo1.lines.add('výsledek :' +res); //zkouška
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]//a hledej to, co je mezi uvozovkami ve SG...
then break;//pokud najdeš, ukonči hledání
vyrok1:=strtobool(stringgrid1.Cells[1+komb,i-1]);//ve SG je uspořádáno následovně : název výroku (VK2) vyjádření výroku pomocí předem známých
//"VK1"Db a pak hodnoty pro dané kombinace (1 nebo 0), tuhle hodnotu si vezme
end;
res:='';
if length(t)=pozice+1 then //to samé co před spojkou provede s částí za spojkou
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 //a pošle to na vyhodnocení do podprocedury
'&':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'; //a zapíše do SG
if b=false then stringgrid1.Cells[1+komb,x-1]:='0';
end;
end;
end;
function tform1.nmocnina(zaklad: longint; exponent: longint):longint; //vrátí entou mocninu čísla, pro moje potřeby to takhle naprosto stačí...
var i:longint;
begin
result:=1;
for I := 1 to exponent do result:=result*zaklad;
end;
function tform1.mistoznamenka(t:string):longint; //určí pozici log. spojky
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;
end.Tak jsem trochu něco předělal a hlavně přidal komentáře, tak snad se v tom líp vyznáš :
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;
public
end;
var
Form1: TForm1;
implementation
function tform1.cistupis(i: longint):char;//jednoduše přiřadí dané číslici písmeno
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.kulata(t: string):boolean; //zjistí, zda je v řetězci kulatá závorka
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='(' then
begin
result:=true;
exit;
end;
end;
function TForm1.hranata(t: string):boolean; //zjistí, jestli je hranatá závorka
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='[' then
begin
result:=true;
exit;
end;
end;
function TForm1.slozena(t: string):boolean; //zjistí, zda je složená závorka
var i:longint;
begin
result:=false;
for I := 1 to length(t) do if t[i]='{' then
begin
result:=true;
exit;
end;
end;
function tform1.odzavorkuj(t: string):string; //převede všechny závorky o stupeň níž, pokud je v řetězci kulatá závorka, vrátí původní řetězec
var i:longint;
res:string;
begin
if kulata(t) then
begin
result:=t;
memo1.lines.add('Breakovano');
exit;
end;
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;
result:=res;
memo1.lines.add(result);
end;
procedure tform1.tokenizer;//celá procedura dělí řetězec do částí po závorkách - na konci je výstup bez závorek
var t, res:string;
i,x,y,z:longint;
c:char;
nalezeno:boolean;
begin
z:=0;//proměnná Z určuje celkový počet podvýroků
t:=edit1.text;
repeat
begin
for i:=1 to length(t) do //hledáme kulatou závorku
begin
nalezeno:=false; //standartně je nenalezena
c:=t[i];
if c='(' then //pokud to najde závorku, pak
begin
nalezeno:=true; //je nalezena
z:=z+1; //počet podvýroků se zvyšuje o 1
x:=i+1; //když i je pozice závorky, x je o 1 větší než pozice závorky - budeme začínat za závorkou
res:=''; //výsledek je nic, zatím...
while not (c=')') do //dokud nenajde konec závorky, tak
begin
c:=t[x]; //čti po znacích řetězec za závorkou
if c<>')' then res:=res+c; //a ukládej ho do proměnné res
x:=x+1;
end;
end;
if nalezeno then break; //a pokud nalezlo tak ukonči "hledací" cyklus
end;
if nalezeno then //a pokračuj tímto :
begin
memo1.lines.add('VK' + inttostr(z) + ' : ' + res); //jen kontrolní výpis do mema
stringgrid1.cells[0,z-1]:='VK'+inttostr(z);//do prvního sloupečku stringgridu zapiš VK a číslo výroku... výrazem VK se posléze nahradí závorka
stringgrid1.cells[1,z-1]:=res; //do druhého sloupečku StringGridu zapiš původní obsah závorky
stringgrid1.RowCount:=stringgrid1.RowCount+1;//přidej řádek do StringGridu
res:='';//vynuluj výstupní řetězec
for y:=1 to i-1 do res:=res+t[y];//všechno, co bylo před závorkou, zkopíruj do výstupu res
res:=res+ ('"VK' + inttostr(z)+'"');//místo závorky napiš "VKx", x je číslo podvýroku
for y:=x to length(t) do res:=res+t[y];//a zbytek opiš
t:=res;//a ulož upravený řetězec do var t, se kterou se pracuje...
end;
memo1.lines.add(res);//zas jen kontrola...
if nenizav(t)=false then t:=odzavorkuj(t);//pokud je v řetězci závorka tak proveď funkci odzavorkuj
end
until nenizav(t)=true;//a celé to opakuj dokud řetězec nebude bez závorek
stringgrid1.cells[0,z]:='Result';//a na poslední řádek do StringGridu připiš RESULT
stringgrid1.cells[1,z]:=t; //a to, co z původního řetězce zbylo
end;
function tform1.nenizav(t:string):boolean;//zjistí, jestli je v řetězci závorky
begin
result:=true;
if kulata(t) or hranata(t) or slozena(t) then result:=false;
end;
function TForm1.konjunkce(a: Boolean; b: Boolean):boolean; //logické operace...
begin
if a and b then result:=true else result:=false;
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;
function TForm1.pocetpismen(t:string):longint;//zjistí počet písmen v řetězci
var c:char;
i,a:longint;
ar:array['a'..'z'] of boolean;
begin
t:=edit1.text;
a:=0; //začátek - 0 písmen
for c:='a' to 'z' do ar[c]:=true; //zatím žádné písmeno nebylo nalezeno
for i:=1 to length(t) do //pro celý řetězec udělej
begin
for c := 'a' to 'z' do if t[i]=c then //otestuj to na každé písmeno
begin
if ar[c]=true then //pokud to písmeno ještě nebylo nalezeno pak
begin
ar[c]:=false;//to písmeno označ za nalezené
a:=a+1; //a přičti k počtu písmen 1
end;
break;//nemá smysl dál testovat
end;
end;
result:=a;//a jako výstupní hodnotu uveď a=počet písmen
end;
procedure TForm1.vyhodnotto;
var pismen,kombinaci,o,krok,x,pozice,i,komb:longint;
arr:Tarr;
b,vyrok1,vyrok2:boolean;
t,res:string;
c:char;
begin
pismen:=pocetpismen(Edit1.Text);//zjistíme počet písmen = počet výroků zadaných na začátku
kombinaci:=nmocnina(2,pismen); //počet kombinací je 2 na počet výroků
memo1.lines.add('--------Začíná vyhodnotto--------'); //kontrola do mema
memo1.lines.add(inttostr(pismen));
memo1.lines.add(inttostr(kombinaci));
stringgrid1.colcount:=2+kombinaci; //sloupečky jsou standartně 2 + počet kombinací, pro každou 1 sloupec
stringgrid1.defaultcolwidth:=(stringgrid1.width-10) div stringgrid1.colcount; //nastav šířku sloupců tak, aby se to vešlo
for o := 1 to pismen do //vyplní tabulku hodnot - a : 1010, b : 1100...
begin
krok:=nmocnina(2,o-1);//krok - určuje, po kolika vyplněných polích se střídá 1 a 0, např. pro krok 2 bude řetězec 1100...
memo1.lines.add('krok' + inttostr(krok)); //kontrola
for x:=1 to kombinaci do if (((x-1)div krok)mod 2)=0 then
{tohle se mi moc líbí - funguje to takhle :
pokud x celočíselně dělím krokem, dostanu vždy řadu číslic za sebou, číslice se změní právě po
počtu číslic, které udává krok. Např. pro krok=4 a pro x=1-16 dostanu 0001111222233334.
protože se mi však nehodí to, že začínám pouze třemi a ne 4 číslicemi. proto od x odečtu 1.
pak už dostanu x z intervalu 0-15 a řetězec bude vypadat 0000111122223333. Pokud tyto čísla zbytkově
dělím dvěma, pak výsledkem celé operace nahoře je 0000111100001111. Jelikož se ale většinou začíná
jedničkou a ne nulou, proto pro nulu nastavuji true a pro 1 false.}
begin
arr[cistupis(o),x]:=true;//příslušné políčko bool pole true
stringgrid2.cells[0,o-1]:=cistupis(o);//a zapiš do 2. stringgridu proměnnou
stringgrid2.cells[x,o-1]:='1'; //a její hodnotu
end
else
begin
arr[cistupis(o),x]:=false; //totéž, akorát s fasle
stringgrid2.cells[0,o-1]:=cistupis(o);
stringgrid2.cells[x,o-1]:='0';
end;
end;
for komb := 1 to kombinaci do //pro každou z kombinací proveď
begin
for x:=1 to stringgrid1.rowcount do //pro všechny sloupce SG proveď
begin
res:='';
t:=stringgrid1.cells[1,x-1]; //načte do t řetězec ze SG - výrok
memo1.lines.add(t); //kontrola
pozice:=mistoznamenka(t); //zjistíme polohu logické spojky v řetězci
memo1.lines.add('pozice znamenka :' +inttostr(pozice));//kontrola
if pozice=2 then//pokud je pozice znaménka 2, pak to znamená, že před
begin//znaménkem se nachází pouze jednopísmenná proměnná, kterou je třeba hledat v původní tabulce jednoduchých výroků
c:=t[1];//tak si zjistíme, co je to za výrok
memo1.lines.add('jednopísmenná proměnná ' +c);//ověření
vyrok1:=arr[c,komb];//najdeme si v poli pravd. hodnotu pro příslušnou kombinaci
if vyrok1=true then memo1.lines.add('!!!TRUE!!!'); //zkouška
end
else //jinak to znamená, že se před tím nachází nějaký výrok typu "VKx"
begin
for i:=1 to pozice do if t[i]='"' then break;//až najdeš uvozovky, ukonči hledání
i:=i+1;//nastaví pozici za uvozovkami
while not (t[i]='"') do //dokud nenajdeš další uvozovky, tak
begin
if t[i]<>'"' then res:=res+t[i]; //do res zapisuj to, co je mezi nimi
i:=i+1;
end;
memo1.lines.add('výsledek :' +res); //zkouška
for i := 1 to stringgrid1.rowcount do if res=stringgrid1.Cells[0,i-1]//a hledej to, co je mezi uvozovkami ve SG...
then break;//pokud najdeš, ukonči hledání
vyrok1:=strtobool(stringgrid1.Cells[1+komb,i-1]);//ve SG je uspořádáno následovně : název výroku (VK2) vyjádření výroku pomocí předem známých
//"VK1"Db a pak hodnoty pro dané kombinace (1 nebo 0), tuhle hodnotu si vezme
end;
res:='';
if length(t)=pozice+1 then //to samé co před spojkou provede s částí za spojkou
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 //a pošle to na vyhodnocení do podprocedury
'&':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'; //a zapíše do SG
if b=false then stringgrid1.Cells[1+komb,x-1]:='0';
end;
end;
end;
function tform1.nmocnina(zaklad: longint; exponent: longint):longint; //vrátí entou mocninu čísla, pro moje potřeby to takhle naprosto stačí...
var i:longint;
begin
result:=1;
for I := 1 to exponent do result:=result*zaklad;
end;
function tform1.mistoznamenka(t:string):longint; //určí pozici log. spojky
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;
procedure TForm1.Button2Click(Sender: TObject); //spouštěcí čudlík
begin
tokenizer;
vyhodnotto;
Button2.enabled:=false;
Button1.enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject); //vymaže memo při startu
begin
memo1.lines.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject); //restart programu
var
FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;
end.Danstahr
jasně, chápu, řikám že je to zatím hodně user nonfriendly, z čehož plynou ty vyjímky, uživ. prostředí kompletně předělám ještě, tohle je jen kostra... má to určovat pravdivostní hodnotu výroků zadaných s logickými spojkami &,D,I,E (konjunkce, disjunkce, implikace, ekvivalence) a výroky a až o.
ke kritice :
1) komentáře - já tomu rozumím a to, že tam nejsou, jsem se omluvil, a dopíšu je tam až to bude komplet :)
2) a 3) jo, já vim že mám v kódu bordel :)
4) nevim na co narážíš
5) ten příkaz na hledání subřetězce jsem neznal, tak díky :) jo a přidat break snad neni problém :)
6) o té kulaté závorce vim, moje blbost, že nevim jak ukončit proceduru, nějak mi to zlobilo tak jsem to ošetřil vyjímkou na konci řetězce.
má to fungovat asi takhle :
pokud najde kulatou závorku, nedělej nic
pokud najde hranaté, předělej je na kulaté
pokud najde složené, přepiš je na hranaté
spoustu procedur v Delphi neznám, proto občas takovéhle řešení "nadlouho"...
7) další věc, o které jsem nevěděl...
8) jo vim, že tam mám chybu, ale tu už jsem opravil...
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.Danstahr
To Danstahr : Omlouvám se, nevšiml jsem si že jde o Phyton... :( :smile12:
Danstahr
Není to můj kód, někde jsem ho našel, už nevím přesně kde :
procedure TForm1.Button1Click(Sender: TObject);
var
FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;
