Мансуров. Основы программирования в среде Lazarus. 2010

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

unit Unit1;

{$mode objfpc}{$H+} interface

uses

Classes, SysUtils, FileUtil, LResources, Forms,

Controls, Graphics, Dialogs, ActnList, Menus, StdActns,

ComCtrls, TAGraph, TASeries;

type

{ TForm1 }

TForm1 = class(TForm)

A_Grafic_Curve: TAction;

A_Grafic_Exp: TAction;

A_Calculate: TAction;

ActionList1: TActionList;

Chart1: TChart;

A_Exit: TFileExit;

FileOpen1: TFileOpen;

ImageList1: TImageList;

MainMenu1: TMainMenu;

Menu_Curve: TMenuItem;

Menu_Exp: TMenuItem;

Menu_Calculate: TMenuItem;

MCalculate: TMenuItem;

Menu_Grafic: TMenuItem;

Menu_Exit: TMenuItem;

Menu_File: TMenuItem;

Menu_Open: TMenuItem;

ToolBar1: TToolBar;

TB_Open: TToolButton;

751

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

TB_Exit: TToolButton;

TB_Divide_1: TToolButton;

TB_Calculate: TToolButton;

TB_Divide_2: TToolButton;

TB_Graf_Exp: TToolButton;

TB_Graf_Curve: TToolButton;

procedure A_CalculateExecute(Sender: TObject); procedure A_ExitExecute(Sender: TObject); procedure A_Grafic_CurveExecute(Sender: TObject); procedure A_Grafic_ExpExecute(Sender: TObject); procedure FileOpen1Accept(Sender: TObject); procedure FormCreate(Sender: TObject);

private

{private declarations } public

{public declarations } end;

procedure gauss(vector: array of real; b: array of real; var x: array of real; n: byte;

var solve: byte);

//Процедура решения СЛАУ методом Гаусса

//n - размерность системы,

//solve=0, если решение единственное,

//solve=1, если система не имеет решения,

//solve=2, если система имеет бесконечное количество решений,

function fx(t: real): real;

//Функция, подбираемая методом

//наименьших квадратов

function stepen( x: real; n: byte): real;

752

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

// Функция возведения в степень var

Form1: TForm1; n: byte;

x1, y1: real;

x, y, z: array of real; implementation

function fx(t: real): real; begin

Result:= z[0] + z[1]*t + z[2]*t*t + z[3]*t*t*t + z[4]*sqr(sqr(t));

end;

function stepen( x: real; n: byte): real;

// процедура возведения в целую степень

var

i: integer;

begin

Result:= 1;

for i:= 1 to n do

Result:= Result*x;

end;

// Реализация метода Гаусса

procedure Gauss(vector: array of real; b: array of real; var x: array of real; n: byte;

var solve: byte);

var

a: array of array of real; { матрица коэффициентов системы,

двумерный динамический массив}

i, j, k, p, r: integer;

753

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

m, s, t: real;

begin

SetLength(a, n, n); // установка фактического размера массива

{ Преобразование одномерного массива в двумерный } k:=0;

for i:=0 to n-1 do for j:=0 to n-1 do begin

a[i, j]:= vector[k]; k:=k+1;

end;

for k:=0 to n-2 do begin

for i:=k+1 to n-1 do begin

if (a[k, k]=0) then begin

{ перестановка уравнений}

p:=k; // в алгоритме используется буква l, но она похожа на 1

// Поэтому используем идентификатор p for r:=i to n-1 do

begin

if abs(a[r, k]) > abs(a[p, k]) then p:=r; end;

if p<>k then begin

for j:= k to n-1 do begin

t:=a[k, j];

754

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

a[k, j]:=a[p, j]; a[p, j]:=t;

end;

t:=b[k];

b[k]:=b[p];

b[p]:=t;

end;

end; // конец блока перестановки уравнений m:=a[i,k]/a[k, k];

a[i, k]:=0;

for j:=k+1 to n-1 do begin

a[i, j]:=a[i, j]-m*a[k, j]; end;

b[i]:= b[i]-m*b[k]; end;

end;

{Проверка существования решения} if a[n-1,n-1] <> 0 then begin

x[n-1]:=b[n-1]/a[n-1,n-1]; for i:=n-2 downto 0 do begin

s:=0;

for j:=i+1 to n-1 do begin

s:=s-a[i, j]*x[j]; end;

x[i]:=(b[i] + s)/a[i, i];

755

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

end;

solve:= 0;

end

else

if b[n-1] = 0 then

begin

MessageDlg('Система имеет бесконечное ' +

'количество решений', mtInformation,[mbOK], 0); solve:= 2;

end else begin

MessageDlg('Система не имеет решений',

mtInformation,[mbOK], 0);

solve:= 1; end;

{ освобождение памяти } a:=nil;

end;

{ TForm1 }

procedure TForm1.FileOpen1Accept(Sender: TObject);

// процедура выбора, открытия и чтения файла данных

var

f: TextFile;

i: integer;

Fname: string;

begin

Fname:= FileOpen1.Dialog.FileName;

Fname:= UTF8ToSys(Fname); //преобразование в системную кодировку

756

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

AssignFile(f, Fname);

Reset(f);

// отключение контроля ошибок ввода/вывода

{$I-}

// чтение количества экспериментальных точек

Readln(f, n);

if IOResult <> 0 then

begin

ShowMessage('Ошибка при чтении из файла!');

exit;

end;

// распределение памяти под массивы

SetLength(x, n);

SetLength(y, n);

for i:= 0 to n - 1 do begin

read(f, x[i]);

if IOResult <> 0 then begin

ShowMessage('Ошибка при чтении из файла!'); exit;

end;

end;

for i:= 0 to n - 1 do begin

read(f, y[i]);

if IOResult <> 0 then begin

ShowMessage('Ошибка при чтении из файла!');

757

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

exit;

end;

end; {$I+}

CloseFile(f);

A_Calculate.Enabled:= true;

end;

procedure TForm1.FormCreate(Sender: TObject); begin

Chart1.Title.Text.Text:='Метод наименьших квадратов'; A_Calculate.Enabled:= false; A_Grafic_Exp.Enabled:= false; A_Grafic_Curve.Enabled:= false;

Chart1.Visible:= false; end;

procedure TForm1.A_ExitExecute(Sender: TObject); begin

Close;

end;

procedure TForm1.A_Grafic_CurveExecute(Sender: TObject);

{Процедура вывода совмещенных графиков экспериментальных данных по точкам и подобранной методом наименьших квадратов кривой, наилучшим образом приближающейся к экспериментальным данным}

var

i: integer;

gr1, gr2: TLineSeries;

begin

758

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

Chart1.Visible:= true;

gr1:= TLineSeries.Create(Chart1); gr1.ShowPoints := true; // график с точками gr1.ShowLines := false; // не соединять точки линиями

Chart1.AddSeries(gr1);

gr2:= TLineSeries.Create(Chart1); gr2.ShowLines := true; Chart1.AddSeries(gr2);

for i:= 0 to n - 1 do gr1.AddXY(x[i], y[i]); for i:= 0 to n - 1 do gr2.AddXY(x[i], fx(x[i]));

end;

procedure TForm1.A_Grafic_ExpExecute(Sender: TObject);

{Процедура вывода графика экспериментальных

данных по точкам}

var

i: integer;

gr1: TLineSeries; begin

Chart1.Visible:= true;

gr1:= TLineSeries.Create(Chart1); Chart1.AddSeries(gr1);

for i:= 0 to n - 1 do gr1.AddXY(x[i], y[i]);

end;

procedure TForm1.A_CalculateExecute(Sender: TObject); var

i, j, k, l: integer;

759

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

b, vector: array of real; s: real;

solve: byte; begin

SetLength(z, 5);

SetLength(b, 5); SetLength(vector, 25); j:= 0;

for k:= 0 to 4 do for l:= 0 to 4 do begin

s:= 0;

for i:= 0 to n - 1 do

s:= s + stepen(x[i], k+l); vector[j]:= s;

j:= j+1; end;

for k:= 0 to 4 do begin

s:= 0;

for i:= 0 to n - 1 do

s:= s + y[i]*stepen(x[i], k); b[k]:= s;

end;

gauss(vector, b, z, 5, solve); // решение СЛАУ if solve = 0 then

begin

A_Grafic_Exp.Enabled:= true;

A_Grafic_Curve.Enabled:= true;

760