Добрый день! Написал программу, которая выводит таблицу истинности для заданной функции, например:
функция F=x1^x2 выводится таблица истинности
procedure TForm1.Button1Click(Sender: TObject);
var X, T, myCol: integer;
begin
StringGrid1.RowCount := 1 shl StringGrid1.ColCount;
for X := 0 to StringGrid1.RowCount - 1 do
begin
T := X;
for myCol := StringGrid1.ColCount downto 1 do
begin
StringGrid1.Cells[myCol - 1, X] := IntToStr(T mod 2);
T := T div 2;
end;
end;
end;
repeat
for b:=ee to length(str4) do
begin
if (str4[b] in ['0'..'9']) then
begin
if (str4[b+1] in ['0'..'9']) then
begin
per:=1;
chislo:=copy(str4,b,2);
ch:=stringgrid1.Cells[strtoint(chislo)-1,j];
str4[b]:=ch[1];
delete(str4,b+1,1);
break;
end
else
begin
ch:=stringgrid1.cells[strtoint(str4[b])-1,j];
str4[b]:=ch[1];
end;
end;
end;
ee:=b;
inc(ee);
b:=ee;
if b>length(str4) then break;
until ee=length(str4);
for i:=1 to stringgrid1.colCount do
begin
while k<8 do
Begin
if length(str3)=1 then break; ///////////
inc(k);
ch:=mas[k];
for b:=p to length(str3) do
Begin
if (ch[1]=str3[b]) then Begin
case ch[1] of
'!':begin
if str3[b+1]='0' then ch1:='1'
else ch1:='0';
str3[b+1]:=ch1[1];
delete(str3,b,1);
k:=0;
p:=1;
end;
'^':Begin
if (str3[b-1]=str3[b+1])and(str3[b-1]='1') then
ch1:='1'
else ch1:='0';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
'+':begin
if (str3[b-1]=str3[b+1]) then
ch1:='0'
else ch1:='1';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
'v':Begin
if(str3[b-1]='1')or(str3[b+1]='1') then ch1:='1'
else ch1:='0';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
End;
'>':begin
if (str3[b-1]='1')and(str3[b+1]='0') then
ch1:='0'
else ch1:='1';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
'~':begin
if ((str3[b-1]='0')and(str3[b+1]='0'))or
((str3[b-1]='1')and(str3[b+1]='1')) then
ch1:='1'
else ch1:='0';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
'|':begin
if (str3[b-1]='1')and(str3[b+1]='1') then
ch1:='0'
else ch1:='1';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
'<':begin
if (str3[b-1]='0')and(str3[b+1]='0') then
ch1:='1'
else ch1:='0';
str3[b-1]:=ch1[1];
delete(str3,b,2);
p:=1;
k:=0;
end;
end;
end;
end;
end;
end;
Ну, давай начнем с последней проблемы:
StringGrid1.RowCount := 1 shl StringGrid1.ColCount;- отрабатывает за 3-4 секунды при 18-ти элементах...
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 0, 0); // Раз
for X := 0 to StringGrid1.RowCount-1 do
begin
T := X;
for myCol := StringGrid1.ColCount downto 1 do
begin
StringGrid1.Cells[myCol - 1, X] := IntToStr(T mod 2);
T := T div 2;
end;
end;
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 1, 0); // Два
StringGrid1.Refresh; // Три
Сделал как Вы сказали, при 17 элементах таблица заполняется примерно за минуту-две, а при 18 просто зависает. Наверное из-за компьютера, не очень мощный.
когда ввожу 14 элементов затем функцию, при нажатии примерно раз 10 на кнопку "Посчитать" пояляется ошибка
Такое может быть из-за компилятора самого Delphi?
У меня Delphi Enterprise version 7.0 Build(4.453)
// Пишем отдельную процедуруНа моей машине заполняет Грид (при введении числа 18) меньше, чем за полсекунды. Попробуй...
procedure FillSG(var SG: TStringGrid; n: integer);
var i, j, k, curr, count: integer;
begin
count := 1 shl n;
SG.ColCount := n;
SG.RowCount := count;
for i := 0 to Pred(n) do
begin
SG.Rows[i].BeginUpdate;
curr := 0;
for j := 1 to (1 shl i) do
begin
for k := 1 to (count div 2) do
begin
SG.Cells[i, curr] := '0'; inc(curr);
end;
for k := 1 to (count div 2) do
begin
SG.Cells[i, curr] := '1'; inc(curr);
end;
end;
count := count div 2;
SG.Rows[i].EndUpdate;
end;
end;
// и вызываем ее для заполнения Грида:
// ...
stringgrid1.Visible:=true;
kolvo_el:=edit1.Text;
k:=strtoint(kolvo_el);
rr:=2;
for tt:=1 to k-1 do
begin
rr:=2*rr;
end;
stringgrid2.RowCount:=rr;
FillSG(StringGrid1, k); // <--- Вот оно !!!
// Все остальное я не менял, осталось как было
kol2:=1;
// ...
У меня все равно такая же проблема с ошибками, при вводе большого количества элементов. Сегодня попробывал на другой версии Delphi при 19 элементах все прекрасно считает и выводит, Спасибо Вам большое за помощь, все работает.