| ← Июнь 2020 → | ||||||
|
1
|
3
|
4
|
5
|
7
|
||
|---|---|---|---|---|---|---|
|
8
|
9
|
10
|
11
|
12
|
13
|
14
|
|
15
|
16
|
17
|
18
|
19
|
20
|
21
|
|
22
|
23
|
24
|
25
|
27
|
28
|
|
|
29
|
30
|
|||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru/
Открыта:
14-03-2002
Статистика
0 за неделю
RFpro.ru: Программирование на Delphi и Lazarus
| РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты в разделе
∙ Pascal / Delphi / Lazarus
Уважаемые эксперты! Пожалуйста, ответьте на вопрос:
Дата отправки: 27.05.2020, 15:40 Консультирует Зенченко Константин Николаевич (Старший модератор): Здравствуйте, mortex.official! Код (Pascal) :: выделить код unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private{ Private declarations }
public{ Public declarations }
end;
const
szV=30;
szH=100;
szF=10;
var
Form1: TForm1;
Step:integer;
implementation
{$R *.dfm}
procedure Gauss(var a:TStringGrid;b:integer);
const
e=1E-20;{программный ноль, все что меньше - считается нулем}
var
i,j:integer;
c,d:double;
f:string;
begin
if b<a.RowCount then
begin
if abs(StrToFloat(a.Cells[b,b]))<e then
begin
i:=b+1;
while(i<a.RowCount)and(StrToFloat(a.Cells[b,i])<e)do inc(i);
if i=a.RowCount then ShowMessage('Два и больше решений')
else
begin
for j:=b to a.ColCount-1 do
begin
f:=a.Cells[j,b];
a.Cells[j,b]:=a.Cells[j,i];
a.Cells[j,i]:=f;
end;
ShowMessage('перестановка строк');
end;
end;
for i:=a.ColCount-1 downto b do
a.Cells[i,b]:=FloatToStr(StrToFloat(a.Cells[i,b])/StrToFloat(a.Cells[b,b]));
for i:=b+1 to a.RowCount-1 do
for j:=a.ColCount-1 downto b do
a.Cells[j,i]:=FloatToStr(StrToFloat(a.Cells[j,i])-StrToFloat(a.Cells[b,i])*StrToFloat(a.Cells[j,b]));
if b<a.RowCount then Gauss(a,b+1);
end
else
begin
repeat;
dec(b);
i:=a.ColCount-1;
c:=StrToFloat(a.Cells[i,b]);
dec(i);
while b<i do
begin
c:=c-StrToFloat(a.Cells[i,b])*StrToFloat(a.Cells[i,0]);
dec(i);
end;
a.Cells[b,0]:=FloatToStr(c);
until b=1;
for i:=1 to a.ColCount-2 do
a.Cells[i,0]:='X'+intToStr(i)+'='+a.Cells[i,0];
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
{заменяем инспектор объектов}
Button1.Left:=szF+1;
StringGrid1.Left:=szF;
Label1.Left:=szF;
Label1.Top:=szF;
Label1.Height:=szV;
label1.Caption:='Введите параметры и нажмите "Счет"';
Button1.Caption:='Счет';
StringGrid1.Top:=Label1.Top+Label1.Height+szF;
Button1.Top:=StringGrid1.Top+1;
StringGrid1.DefaultColWidth:=szH;
StringGrid1.DefaultRowHeight:=szV;
Button1.Width:=StringGrid1.DefaultColWidth;
Button1.Height:=StringGrid1.DefaultRowHeight;
StringGrid1.Width:=StringGrid1.DefaultColWidth*StringGrid1.ColCount+10;
StringGrid1.Height:=StringGrid1.DefaultRowHeight*StringGrid1.RowCount+10;
Form1.Height:=StringGrid1.Height+9*szF;
Form1.Width:=StringGrid1.Width+3*szF;
for i:=1 to StringGrid1.ColCount-2 do StringGrid1.Cells[i,0]:='x'+intToStr(i);
for i:=1 to StringGrid1.RowCount-1 do StringGrid1.Cells[0,i]:=IntToStr(i);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
w:double;
x,y:integer;
z:boolean;
begin
z:=True;
for x:=1 to StringGrid1.ColCount-1 do
for y:=1 to StringGrid1.RowCount-1 do
if z then
if not TryStrToFloat(StringGrid1.Cells[x,y],w)then
begin
z:=False;
ShowMessage('Неверный параметр, введите снова');
StringGrid1.Col:=x;
StringGrid1.Row:=y;
end;
if z then
begin
Button1.Hide;
Gauss(StringGrid1,1);
end;
end;
end.Проверялось по примеру, взятому тут.  Удачи!
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
|
| В избранное | ||
