If b>c thenBegin x: =b; b: =c; c: =x; end; If a> b then Begin x: =a; a: =b; b: =x; end; // Проверка существования такого треугольника If (a< =0) or ((a+b)< =c) then Begin showmessage('Это не треугольник'); edit2.SetFocus; exit; end; fl: =false; iw: =image1.Width; ih: =image1.Height; k: =iw / ak; //коэффициент масштабирования if c< =ak then Begin fl: =true; showmessage('Пройдет'); End Else //сторона треугольника больше диагонали квадрата If c> ak*sqrt(2) then Begin showmessage('Не пройдет'); exit; End Else Begin y1: =sqrt(sqr(c)-sqr(ak)); ap: =4*sqr(ak)+4*sqr(y1); bp: =4*y1*(sqr(a)-sqr(b)-sqr(ak)-sqr(y1)); cp: =sqr(sqr(b))+sqr(sqr(a))+sqr(sqr(ak))+sqr(sqr(y1))+ 2*(-sqr(a)*sqr(b)+sqr(b)*sqr(ak)+sqr(b)*sqr(y1)-sqr(a)*sqr(ak)- sqr(a)*sqr(y1)+sqr(ak)*sqr(y1)-2*sqr(ak)*sqr(b)); d: =sqr(bp)-4*ap*cp; If d< 0 then Begin showmessage('Не пройдет'); exit; end; y: =(-bp+sqrt(d))/(2*ap); x: =sqr(b)-sqr(y); If (x< 0) or (y> ak) then Begin showmessage('Не пройдет'); exit; end; x: =sqrt(x); If y> ak then Begin showmessage('Не пройдет'); exit; End Else Begin fl: =true; showmessage('Пройдет');; end; end; If not fl then exit; p[0].X: =0; p[0].Y: =0; // очистка Image и задание параметров изображения image1.Picture: =nil; image1.Canvas.Pen.Color: =clred; //image1.Canvas.Brush.Style: =bscross; image1.Canvas.Brush.Color: =clred; image1.Canvas.Rectangle(0, 0, round(ak*k), round(ak*k)); image1.Canvas.Brush.Color: =clgreen; //Если большая сторона треугольника меньше // стороны квадрата if c< =ak then Begin p[1].X: =round(c*k); p[1].Y: =0; x: =(sqr(b)-sqr(a)+sqr(c))/(2*c); y: =sqrt((sqr(b)-sqr(x))); p[2].x: =round(x*k); p[2].y: =round(y*k); image1.Canvas.Polygon(p); exit; end; //Если большая сторона треугольника больше // стороны квадрата y1: =sqrt(sqr(c)-sqr(ak)); p[1].X: =round(ak*k); p[1].Y: =round(y1*k); // x: =(sqr(b)-sqr(a)+sqr(y1)-2*y*y1+sqr(ak))/(2*ak); // y: =sqrt((sqr(b)-sqr(x))); p[2].x: =round(x*k); p[2].y: =round(y*k); image1.Canvas.Polygon(p);
end; // Обработка вводимых символов в поля Edit procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); Var edit: tedit; Begin edit: =sender as tedit; Case key of '0'..'9', #8:; '-': begin if (edit.Text='') then key: =#0 Else if (edit.Text< > '') and ((copy(edit.Text, length(edit.Text), 1)='E') or (copy(edit.Text, length(edit.Text), 1)='e')) then key: ='-' Else key: =#0; end; '+': begin if (edit.Text='') then key: ='+' Else if (edit.Text< > '') and ((copy(edit.Text, length(edit.Text), 1)='E') or (copy(edit.Text, length(edit.Text), 1)='e')) then key: ='+' Else key: =#0; end; ', ', '.': begin key: =decimalseparator; If pos(decimalseparator, edit.Text)< > 0 then key: =#0 end; 'E', 'e': begin key: ='E'; if ((pos('E', edit.Text)< > 0) or (pos('e', edit.Text)< > 0)) or ((length(edit.Text)=1) and ((copy(edit.Text, 1, 1)='-') or (copy(edit.Text, 1, 1)='+'))) or ((length(edit.Text)=0) And ((pos('E', edit.Text)=0) or (pos('e', edit.Text)=0))) then key: =#0; end; #13: case edit.Tag of //обработка нажатия клавиши Enter // предварительно вручную устанавливаем свойства tag // для каждого edit-а 0: edit2.SetFocus; 1: edit3.SetFocus; 2: edit4.SetFocus; 3: button1.SetFocus; End e l se key: =#0; end;
end;
end.
Обработка нажатия клавиш при вводе достаточно сложная процедура и не идеальная. Но все-таки она требует пояснений. С одной стороны для всех Edit-ов обработка одинакова, за исключением обработки нажатия кпавиши Enter. Поэтому объявлена переменная edit: tedit, которой в начале процедуры присваивается значение параметра sender: edit: =sender as tedit. Для выполнения различных действий при нажатии Enter для каждого Edit-а установлено свое, отличное от других, свойство Tag. Для предоставления пользователю возможности ввода чисел в нормальной форме обрабатывается нажатие клавиш латинских ‘E’ и ‘e’ для ввода порядка числа. Вместо обработки каждой нажатой клавиши можно было обработать ошибки конвертирования при преобразовании из строки в число.
|
