Материал: Мансуров. Основы программирования в среде 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