НОУ ИНТУИТ | Программирование на Free Pascal и Lazarus. Лекция 4: Подпрограммы

Учитесь и получайте официальные документы БЕСПЛАТНО. Вы можете поддержать наш проект.

Регистрация Вход

Твой путь к знаниям!

Опубликован: 10.04.2015 | Уровень: для всех | Доступ: платный | ВУЗ: Компания ALT Linux

|

Вам нравится? Нравится 17 студентам

| Поделиться |

Поддержать программу

ЗАДАЧА 4.6. Создать программу для решения уравнений:

линейное ;
квадратное ;
кубическое ax^3 + bx^2 + cx + d.

Решение линейного уравнения тривиально: x = -b/a ; алгоритмы решения квадратного и кубического уравнений подробно рассмотрены в задачах 3.4 и 3.5.

Создадим новый проект. Свойства формы настроим по табл. 4.1, за исключением свойства Caption, которому присвоим значение Решение уравнения. Компоненты на форме разместим так, как показано на рис. 4.4.

Обратите внимание, что на форме появились не знакомые нам компоненты. Это CheckBox — флажок и RadioGroup — группа переключателей.

Компонент флажок CheckBox используется для того, чтобы пользователь могут указать свое решение: да или нет. Установлен флажок или нет, определяет свойство Checked (true, false). В составе диалогового окна может быть несколько таких компонентов, причём состояние любого из них не зависит от состояния остальных.

Компонент группа переключателей RadioGroup объединяет в себе несколько переключателей. Каждый размещённый в нём переключатель помещается в специальный список Items и доступен по номеру, установленному в свойстве ItemIndex. После размещения на форме компонент пуст. Чтобы создать в нём хотя бы один переключатель, нужно выделить его, обратиться к инспектору объектов и выбрать свойство Items — редактор списка. Строки, набранные в редакторе, используются как поясняющие надписи справа от переключателей, а их количество определяет количество переключателей в группе. В нашем случае окно редактора списка будет иметь вид, как на рис. 4.5.

Рис. 4.4. Процесс создания формы к задаче 4.6

Рис. 4.5. Окно редактора списка

После создания компонента группа переключателей, его свойство номер переключателя ItemIndex по умолчанию равно _1. Это означает, что ни один компонент в группе не установлен. Чтобы в момент появления компонента на экране один из переключателей был отмечен, нужно либо на этапе конструирования формы, либо программно присвоить свойству ItemIndex номер одного из элементов списка, учитывая, что нумерация начинается с нуля.

С остальными компонентами, размещёнными на форме, пользователь уже знаком. На рис. 4.6, рис. 4.7, рис. 4.8 видно, как работает программа. Пользователю предоставляется возможность выбрать вид решаемого уравнения, ввести его коэффициенты и указать, какие решения — действительные или комплексные (если это возможно) — он хотел бы получить.

Рис. 4.6. Решение линейного уравнения

Рис. 4.7. Решение квадратного уравнения

Рис. 4.8. Решение кубического уравнения

Далее приведён текст программного модуля с комментариями:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, E x t C t r l s;
type
TForm1 = class (TForm)
Label1 : TLabel;
Label2 : TLabel;
Label3 : TLabel;
Label4 : TLabel;
Label5 : TLabel;
Edit1 : TEdit;
Edit2 : TEdit;
Edit3 : TEdit;
Edit4 : TEdit;
CheckBox1 : TCheckBox;
CheckBox2 : TCheckBox;
Button1 : TButton;
Button2 : TButton;
RadioGroup1 : TRadioGroup;
Button3 : TButton;
procedure FormCreate ( Sender : TObject );
procedure Button2Click ( Sender : TObject );
procedure Button3Click ( Sender : TObject );
procedure Button1Click ( Sender : TObject );
procedure RadioGroup1Click ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
//Щелчок по кнопке НАЙТИ КОРНИ.
procedure TForm1. Button1Click ( Sender : TObject );
	//Решение линейного уравнения.
	procedure korni_1 ( a, b : real; var x_ : string );
		var x : real;
	begin
		x:=-b/a;
		x_:= FloatToStrF ( x, ffFixed, 5, 2 );
	end;
	//Решение квадратного уравнения.
	procedure korni_2 ( a, b, c : real; var x1_, x2_ : string;
			var pr : byte );
		var d, x1, x2 : real;
	begin
		d:=b * b-4*a*c;
		if d<0 then
		begin
			x1:=-b /(2 * a );
			x2:= sqrt ( abs ( d ) ) / ( 2 * a );
			x1_:= FloatToStrF ( x1, ffFixed, 5, 2 )
				+ ’+i * ’+FloatToStrF ( x2, ffFixed, 5, 2 );
			x2_:= FloatToStrF ( x1, ffFixed, 5, 2 )
				+ ’- i * ’+FloatToStrF ( x2, ffFixed, 5, 2 );
			pr : = 2; //Комплексные корни.
		end
	else
	begin
		x1:=(_b+sqrt ( d ) ) / 2 / a;
		x2:=(_b_sqrt ( d ) ) / ( 2 _ a );
		x1_:= FloatToStrF ( x1, ffFixed, 5, 2 );
		x2_:= FloatToStrF ( x2, ffFixed, 5, 2 );
		pr : = 1; //Действительные корни.
	end
end;
//Решение кубического уравнения.
procedure korni_3 ( a, b, c, d : real; var x1_, x2_, x3_ : string;
		var pr : byte );
	var r, s, t, p, q, ro, f i, u, v, x1, x2, x3, h, g : real;
begin
	r :=b/a;
	s := c /a;
	t :=d/a; p :=(3 * s -r * r ) / 3; q:=2 * r * r * r /27- r * s/3+ t;
	d :=( p /3) * sqr ( p/3)+ sqr ( q / 2 );
	if d<0 then
	begin
		ro := sqrt (-p * p * p / 27 );
		fi :=-q /(2 * ro );
		fi := pi /2-arctan ( fi / sqrt (1 - fi * fi ) );
		//Вычисление действительных корней уравнения.
		x1 :=2 * exp (1/3 * ln ( ro ) ) * cos ( fi /3) - r / 3;
		x2 :=2 * exp (1/3 * ln ( ro ) ) * cos ( fi /3+2* p i /3) - r / 3;
		x3 :=2 * exp (1/3 * ln ( ro ) ) * cos ( fi /3+4* p i /3) - r / 3;
		x1_:= FloatToStrF ( x1, ffFixed, 5, 2 );
		x2_:= FloatToStrF ( x2, ffFixed, 5, 2 );
		x3_:= FloatToStrF ( x3, ffFixed, 5, 2 );
		pr : = 1; //Действительные корни.
	end
	else
	begin
		if -q/2+ sqrt ( d)>0 then
			u:=exp (1/3 * ln (-q/2+ sqrt ( d ) ) )
		else
			if -q/2+ sqrt ( d)<0 then
				u:=-exp (1/3 * ln ( abs(-q/2+ sqrt ( d ) ) ) )
		else u : = 0;
			if -q/2- sqrt ( d)>0 then
				v:=exp (1/3 * ln (-q/2- sqrt ( d ) ) )
		else
			if -q/2- sqrt ( d)<0 then
				v:=-exp (1/3 * ln ( abs(-q/2- sqrt ( d ) ) ) )
			else v : = 0;
		x1:=u+v-r / 3; //Вычисление действительного корня.
		//Вычисление комплексных корней.
		h:=-(u+v)/2 - r / 3;
		g :=(u-v )/2 * sqrt ( 3 );
		x1_:= FloatToStrF ( x1, ffFixed, 5, 2 );
		x2_:= FloatToStrF ( h, ffFixed, 5, 2 )
			+ ’+i * ’+FloatToStrF ( g, ffFixed, 5, 2 );
		x3_:= FloatToStrF ( h, ffFixed, 5, 2 )
			+ ’- i * ’+FloatToStrF ( g, ffFixed, 5, 2 );
		pr : = 2; //Один действительный и два комплексных корня.
	end
end;
//Обработка события щелчок по кнопке НАЙТИ КОРНИ.
var
	a_, b_, c_, d_ : real;
	kod_a, kod_b, kod_c, kod_d : integer;
	_x, _x1, _x2, _x3 : string; _pr : byte;
begin
	case RadioGroup1. ItemIndex of
	0 : //Пользователь выбрал первый переключатель из группы.
	begin
		//Ввод исходных данных.
		val ( Edit1. Text, a_, kod_a );
		val ( Edit2. Text, b_, kod_b );
		//Ввод прошел успешно.
		if ( kod_a=0) and ( kod_b=0) then
		begin
			if a_<>0 then //Первый коэффициент не ноль.
			begin
				//Решение линейного уравнения.
				korni_1 (a_, b_, _x );
				//Вывод найденного значения.
				MessageDlg ( ’Решение линейного уравнения x= ’
					+_x, mtInformation, [ mbOk ], 0 );
			end
			else //Первый коэффициент равен нулю,
				//вывод соответствующего сообщения.
				MessageDlg ( ’Нет корней ! ’, mtInformation,
					[mbOk ], 0 );
		end
		else //Некорректный ввод данных.
			MessageDlg ( ’Ошибка при вводе коэффициентов ! ’,
				mtInformation, [ mbOk ], 0 );
	end;
1 : //Пользователь выбрал второй переключатель из группы.
begin
	//Ввод исходных данных.
	val ( Edit1. Text, a_, kod_a );
	val ( Edit2. Text, b_, kod_b );
	val ( Edit3. Text, c_, kod_c );
	//Ввод прошел успешно.
	if ( kod_a=0) and ( kod_b=0) and ( kod_c=0) then
	begin
		if a_<>0 then //Первый коэффициент не ноль.
		begin
		//Решение квадратного уравнения.
		korni_2 (a_, b_, c_, _x1, _x2, _pr );
		//В переменной _pr содержится информация
		//о типе корней:
		//1 - действительные, 2 - комплексные.
		//Оба флажка не установлены.
		if ( CheckBox1. Checked=false ) and
				( CheckBox2. Checked=false ) then
			MessageDlg ( ’Выберите_тип_решения ’,
				mtInformation, [ mbOk ], 0 );
		//Оба флажка установлены.
		if CheckBox1. Checked and CheckBox2. Checked then
			MessageDlg ( ’Решение_квадратного_уравнения ’
				+chr (13)+ ’  X1= ’+_x1+ ’  X2= ’+_x2,
					mtInformation, [ mbOk ], 0 );
		//Установлен первый флажок,
		//корни действительные.
		if CheckBox1. Checked and
			( CheckBox2. Checked=false ) and ( _pr=1) then
				MessageDlg ( ’Дейсивительные корни  ’,
				’квадратного уравнения ’+ chr (13)+ ’  X1= ’+
				_x1+ ’  X2= ’+_x2, mtInformation, [ mbOk ], 0 );
		//Установлен второй флажок,
		//корни действительные.
		if ( CheckBox1. Checked=false ) and
			CheckBox2. Checked and ( _pr=1) then
			MessageDlg ( ’Уравнение имеет только  ’,
			’действительные корни. ’, mtInformation, [ mbOk ], 0 );
		//Установлен первый флажок, корни комплексные.
		if CheckBox1. Checked and
			( CheckBox2. Checked=false ) and ( _pr=2) then
			MessageDlg ( ’В уравнении действительных  ’,
			’корней нет ’, mtInformation, [ mbOk ], 0 );
		//Установлен второй флажок, корни комплексные.
		if ( CheckBox1. Checked=false ) and
			CheckBox2. Checked and ( _pr=2) then
			MessageDlg ( ’Комплексные корни квадратного  ’,
			’уравнения ’+ chr (13)+ ’  X1= ’+_x1+ ’  X2= ’+_x2,
			mtInformation, [ mbOk ], 0 );
		end
		else //Первый коэффициент равен нулю.
			MessageDlg ( ’Первый коэффициент не должен быть  ’,
			’нулевым ! ’, mtInformation, [ mbOk ], 0 );
	end //Некорректный ввод данных.
	else MessageDlg ( ’Ошибка при вводе коэффициентов ! ’,
		mtInformation, [ mbOk ], 0 );
end;
2 : //Пользователь выбрал третий переключатель из группы.
begin
	//Ввод исходных данных.
	val ( Edit1. Text, a_, kod_a );
	val ( Edit2. Text, b_, kod_b );
	val ( Edit3. Text, c_, kod_c );
	val ( Edit4. Text, d_, kod_d );
	//Ввод прошел успешно.
	if ( kod_a=0) and ( kod_b=0) and ( kod_c=0) and
			( kod_d=0) then
	begin
		if a_<>0 then //Первый коэффициент не ноль.
		begin
		//Решение кубического уравнения.
		//В переменной _pr содержится информация
		//о типе корней:
		//1 - действительные,
		//2 - один действительный и два комплексных.
		korni_3 (a_, b_, c_, d_, _x1, _x2, _x3, _pr );
		//Оба флажка не установлены.
		if ( CheckBox1. Checked=false ) and
		( CheckBox2. Checked=false ) then
			MessageDlg ( ’Выберите тип решения ’,
			mtInformation, [ mbOk ], 0 );
		//Оба флажка установлены.
		if CheckBox1. Checked and CheckBox2. Checked then
			MessageDlg ( ’Корни кубического ’,
				’уравнения ’+ chr (13)+ ’ _X1= ’+_x1+
				’  X2= ’+_x2+ ’  X3= ’+_x3,
					mtInformation, [ mbOk ], 0 );
		//Установлен первый флажок,
		//корни действительные.
		if CheckBox1. Checked and
			( CheckBox2. Checked=false ) and ( _pr=1) then
				MessageDlg ( ’Действительные корни  ’,
				’кубического уравнения ’+chr (13)+
				’  X1= ’+_x1+ ’  X2= ’+_x2+ ’  X3= ’+_x3,
					mtInformation, [ mbOk ], 0 );
		//Установлен первый флажок, корни комплексные.
		if CheckBox1. Checked and
			( CheckBox2. Checked=false ) and ( _pr=2) then
			MessageDlg ( ’Действительные корни  ’,
				’кубического_уравнения ’+chr (13)+
				’  X1= ’+_x1, mtInformation, [ mbOk ], 0 );
		//Установлен второй флажок, корни комплексные.
		if ( CheckBox1. Checked=false ) and
			CheckBox2. Checked and ( _pr=2) then
			MessageDlg ( ’Комплексные корни кубического_ ’,
			’уравнения ’+ chr (13)+ ’  X1= ’+_x2+ ’  X2= ’+_x3,
			mtInformation, [ mbOk ], 0 );
		//Установлен второй флажок,
		//корни действительные.
		if ( CheckBox1. Checked=false ) and
			CheckBox2. Checked and ( _pr=1) then
			MessageDlg ( ’Уравнение имеет только  ’,
			’действительные корни. ’,
			mtInformation, [ mbOk ], 0 );
		end
		else
			MessageDlg ( ’Первый коэффициент не должен быть  ’,
				’нулевым ! ’, mtInformation, [ mbOk ], 0 );
		end
		else //Некорректный ввод данных.
			MessageDlg ( ’Ошибка при вводе коэффициентов ! ’,
				mtInformation, [ mbOk ], 0 );
	end;
	end;
	end;
//Щелчок по кнопке ОЧИСТИТЬ.
procedure TForm1. Button2Click ( Sender : TObject );
begin
	Label1. Caption := ’Введите коэффициенты ’;
	Label2. Caption := ’ a= ’;
	Label3. Caption := ’ b= ’;
	Label4. Caption := ’ c= ’;
	Label5. Caption := ’ d= ’;
	Edit1. Text := ’ 0.00 ’;
	Edit2. Text := ’ 0.00 ’;
	Edit3. Text := ’ 0.00 ’;
	Edit4. Text := ’ 0.00 ’;
	Button1. Caption := ’НАЙТИ КОРНИ ’;
	Button2. Caption := ’ОЧИСТИТЬ ’;
	Button3. Caption := ’ВЫХОД ’;
	CheckBox1. Caption := ’Действительные корни ’;
	CheckBox2. Caption := ’Комплексные корни ’;
	CheckBox1. Checked := true;
	Label4. Enabled := false;
	Label5. Enabled := false;
	Edit3. Enabled := false;
	Edit4. Enabled := false;
	CheckBox2. Enabled := false;
	RadioGroup1. ItemIndex : = 0;
end;
//Щелчок по кнопке ВЫХОД.
procedure TForm1. Button3Click ( Sender : TObject );
begin
	close;
end;
//Событие открытие формы.
procedure TForm1. FormCreate ( Sender : TObject );
begin
	Label1. Caption := ’Введите коэффициенты ’;
	Label2. Caption := ’ a= ’;
	Label3. Caption := ’ b= ’;
	Label4. Caption := ’ c= ’;
	Label5. Caption := ’ d= ’;
	Edit1. Text := ’ 0.00 ’;
	Edit2. Text := ’ 0.00 ’;
	Edit3. Text := ’ 0.00 ’;
	Edit4. Text := ’ 0.00 ’;
	Button1. Caption := ’НАЙТИ КОРНИ ’;
	Button2. Caption := ’ОЧИСТИТЬ ’;
	Button3. Caption := ’ВЫХОД ’;
	CheckBox1. Caption := ’Действительные корни ’;
	CheckBox2. Caption := ’Комплексные корни ’;
	CheckBox1. Checked := true;
	Label4. Enabled := false;
	Label5. Enabled := false;
	Edit3. Enabled := false;
	Edit4. Enabled := false;
	CheckBox2. Enabled := false;
	RadioGroup1. ItemIndex : = 0;
end;
//Выбор переключателя из группы.
procedure TForm1. RadioGroup1Click ( Sender : TObject );
begin
	case RadioGroup1. ItemIndex of
	0 : //Выбран первый из списка.
	begin
		Label2. Enabled := true;
		Label3. Enabled := true;
		Edit1. Enabled := true;
		Edit2. Enabled := true;
		Label2. Caption := ’ a= ’;
		Label3. Caption := ’ b= ’;
		Edit1. Text := ’ 0.00 ’;
		Edit2. Text := ’ 0.00 ’;
		Label4. Enabled := false;
		Label5. Enabled := false;
		Edit3. Enabled := false;
		Edit4. Enabled := false;
		CheckBox2. Enabled := false;
	end;
	1 : //Выбран второй из списка.
	begin
		Label2. Enabled := true;
		Label3. Enabled := true;
		Label4. Enabled := true;
		Edit1. Enabled := true;
		Edit2. Enabled := true;
		Edit3. Enabled := true;
		Label2. Caption := ’ a= ’;
		Label3. Caption := ’ b= ’;
		Label4. Caption := ’ c= ’;
		Edit1. Text := ’ 0.00 ’;
		Edit2. Text := ’ 0.00 ’;
		Edit3. Text := ’ 0.00 ’;
		Label5. Enabled := false;
		Edit4. Enabled := false;
		CheckBox2. Enabled := true;
	end;
	2 : //Выбран третий из списка.
	begin
		Label2. Enabled := true;
		Label3. Enabled := true;
		Label4. Enabled := true;
		Label5. Enabled := true;
		Edit1. Enabled := true;
		Edit2. Enabled := true;
		Edit3. Enabled := true;
		Edit4. Enabled := true;
		Label2. Caption := ’ a= ’;
		Label3. Caption := ’ b= ’;
		Label4. Caption := ’ c= ’;
		Label4. Caption := ’ d= ’;
		Edit1. Text := ’ 0. 0 0 ’;
		Edit2. Text := ’ 0. 0 0 ’;
		Edit3. Text := ’ 0. 0 0 ’;
		Edit4. Text := ’ 0. 0 0 ’;
		CheckBox2. Enabled := true;
	end;
	end;
	end;
end.

Дальше >>

Программирование на Free Pascal и Lazarus

Программирование на Free Pascal и Lazarus

Подпрограммы

Вопросы и ответы

Студенты

Авторизоваться

Программирование на Free Pascal и Lazarus

Программирование на Free Pascal и Lazarus

Подпрограммы

Вопросы и ответы

Студенты