Praktikum_2008

b:=StrToFloat(Edit2.Text);

c:=StrToFloat(Edit3.Text);

p:=(a+b+c)/2;

If (a+b>c) and (a+c>b) and (b+c>a) Then begin Tan_Pol_Ugla:=Sqrt((p-a)*(p-b)/(p*(p-c))); Ugol_b_Rad:=Arctan(Tan_Pol_Ugla)*2; Ugol_b_Grad:=Ugol_b_Rad/pi*180; GMS(Ugol_b_Grad,G,M,S);

Label5.Caption:='Угол, противолежащий стороне c,

равен'+#13+IntToStr(G)+'гр. '

+IntToStr(M)+'мин. '+FloatToStrF(S,ffFixed,3,1)+'сек.' end

Else Label5.Caption:='ТРЕУГОЛЬНИК НЕ СУЩЕСТВУЕТ'; end;

procedure TForm1.Button2Click(Sender: TObject); begin

Edit1.Text:=' ';

Edit2.Text:=' ';

Edit3.Text:=' '; end;

procedure TForm1.Button3Click(Sender: TObject); begin

Form1.Close

end;

end.

Возможный результат решения:

442

end;

procedure TForm1.Button1Click(Sender: TObject); var

k:integer; // число, факториал которого надо вычислить f:integer; // значение факториала числа k

begin

k := StrToInt(Edit1.Text); f := factorial(k);

label2.caption:='Факториал числа '+Edit1.Text +' равен '+IntToStr(f);

end;

end.

Возможный результат решения:

Задача

Составить программу для вычисления значений выражений

P=(x1+y1)/2 и Q=(x2+y2)/2, где x1 и x2 — корни квадратного уравнения с коэффициентами A, B, C, а y1 и y2 — корни квадратного уравнения с коэффициентами D, F, G. Если хотя бы одно из уравнений не имеет действительных корней выдать на экран сообщение об этом и прекратить выполнение программы.

В программе разработать функцию для проверки введенных в

поле ввода данных. Вводить в поле ввода можно только числа. Десятичным разделителем является запятая. Для вычисления корней квадратного уравнения разработать процедуру.

Компоненты

444

445

Проект формы

446

Текст модуля

unit Unit1;

………..

var

Form1: TForm1;

A,B,C:Real;// коэффициенты первого квадратного уравнения D,F,G:Real;// коэффициенты второго квадратного уравнения implementation

{$R *.dfm}

{Функция проверяет, является ли введенное значение числом. Допустимыми значениями в числе являются цифры от 0 до 9, минус в качестве первого символа, одна десятичная запятая. Функция принимает значение Истина, если в строке встретился запрещенный символ.} function CheckEdit(s:string):boolean;

// s строка символов, передаваемая из поля ввода

Var i:integer;// номер по порядку символа в строке символов Z:integer;// счетчик запятых

begin

CheckEdit:=False;// значению функции присваивается ЛОЖЬ Z:=0;// обнуление счетчика десятичных запятых

// цикл выполняется столько раз, сколько символов

//во введенной строке for i:=1 to Length(S) do Begin

//если в строке встречается запятая, счетчик увеличивается на 1 if s[i]=',' Then Z:=Z+1;

//если символ не относится к числу допустимых, значение

//функции принимает значение ИСТИНА

447

if not(s[i] in ['0'..'9','-',','])Then CheckEdit:=True

//иначе, если не первый символ равен минусу или счетчик

//запятых больше или равен 2,

//значение функции принимает значение ИСТИНА

else if ((i<>1) and (S[i]='-')) or (Z>=2) Then CheckEdit:=True end;

end;

//процедура вычисления корней квадратного уравнения procedure Root(A,B,C:Real;Var R:Boolean;Var X1,X2:Real); Var DT:Real;//дискриминант

begin

//признак действительных решений у уравнения

//принимает значение ИСТИНА

R:=True; DT:=sqr(B)-4*A*C; if DT>0 Then begin

X1:=(-B-sqrt(DT))/(2*A);

X2:=(-B+sqrt(DT))/(2*A); end

else

//признак действительных решений у уравнения

//принимает значение ЛОЖЬ

R:=False;

end;

procedure TForm1.Button2Click(Sender: TObject); begin

Form1.Close

end;

// процедура обработки события — переход вниз из поля ввода procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift:

TShiftState); begin

// если была нажата клавиша «ENTER», то если значение вызванной

// функции проверки допустимости символов в строке, которой

//в качестве фактического параметра передается содержимое поля //ввода, равно истине (символ недопустим), то поле ввода

//очищается и фокус остается в нем

if Key=VK_RETURN

then if CheckEdit(Edit1.Text) Then begin Edit1.Clear; Edit1.SetFocus end

// иначе фокус переносится в следующее поле ввода

448

Else Edit2.SetFocus;

end;

//процедура аналогична процедуре

//procedure TForm1.Edit1KeyDown

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin

if Key=VK_RETURN

then if CheckEdit(Edit2.Text) Then begin Edit2.Clear; Edit2.SetFocus end

Else Edit3.SetFocus; end;

// процедура аналогична procedure TForm1.Edit1KeyDown procedure TForm1.Edit3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

If Key=VK_RETURN

then if CheckEdit(Edit3.Text) Then begin Edit3.Clear; Edit3.SetFocus end

Else Edit4.SetFocus; end;

// процедура аналогична procedure TForm1.Edit1KeyDown procedure TForm1.Edit4KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

If Key=VK_RETURN

then if CheckEdit(Edit4.Text) Then begin Edit4.Clear; Edit4.SetFocus end

Else Edit5.SetFocus; end;

// процедура аналогична procedure TForm1.Edit1KeyDown procedure TForm1.Edit5KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

If Key=VK_RETURN

then if CheckEdit(Edit5.Text) Then begin Edit5.Clear;

449

Edit5.SetFocus end

Else Edit6.SetFocus; end;

// процедура аналогична procedure TForm1.Edit1KeyDown procedure TForm1.Edit6KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

If Key=VK_RETURN

then if CheckEdit(Edit6.Text) Then begin Edit6.Clear; Edit6.SetFocus end

Else Button1.SetFocus; end;

// процедура связанная с кнопкой вычислить procedure TForm1.Button1Click(Sender: TObject);

Var R1,R2:Boolean;{признаки решения первого и второго квадратных уравнений }

P,Q:Real;// значения вычисляемых выражений X1,X2:Real;// корни первого уравнения Y1,Y2: Real;// корни второго уравнения

begin

//инициализация переменных

X1:=0;X2:=0;

Y1:=0;Y2:=0;

//ввод из полей ввода коэффициентов уравнений

A:=StrToFloat(Edit1.Text);

B:=StrToFloat(Edit2.Text);

C:=StrToFloat(Edit3.Text);

D:=StrToFloat(Edit4.Text);

F:=StrToFloat(Edit5.Text);

G:=StrToFloat(Edit6.Text);

//вызов процедуры вычисления корней квадратного уравнения

//(для двух уравнений), если уравнение не имеет

//действительных корней, признак решения

//принимает значение ложь

Root(A,B,C,R1,X1,X2);

Root(D,F,G,R2,Y1,Y2); if not(R1) Then begin

ShowMessage('Уравнение 1 действительных корней не имеет'); Exit // прекращение выполнения программы

450