Implementation
{$R *.dfm}
// рисует звезду
procedure TForml.StarLine(xO,yO,r: integer); // xO,yO - координаты центра звезды
//г — радиус звезды
var
р : array[1..11] of TPoint; // массив координат лучей
a: integej:; // угол между осью ОХ и прямой, соединяющей
// центр звезды и конец луча или впадину
i: integer;
begin
а := 18; // строим от правого гор. луча for i:=l to 10 do
begin
if (i mod 2=0) then begin // впадина
p[I].x := xO+Round(r/3*cos(a*2*pi/360)); p[i].y:=yO-Round(r/3*sin(a*2*pi/360));
end
else
begin // луч
p[i].x:=xO+Round(r*cos(a*2*pi/360)); p[i].y:=y0-Round(r*sin(a*2*pi/360) ) ; end;
a := a+36; end;
p[ll].X :=p[l].X; // чтобы замкнуть контур звезды
p[11].y:=p[1].y;
Canvas.Polyline (p) ; // начертить контур звезды end;
// нажатие кнопки мыши
procedure TForml.FormMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = rabLeft // нажата левая кнопка? then Canvas.Pen.Color := clBlack
else Canvas.Pen.Color := clRed;
StarLine (x, y, 30);
end;
end.
26. Напишите профамму, по поверхности окна которой перемещается случайным образом (прыгает) изображение веселой рожицы, на котором пользователь может сделать щелчок кнопкой мыши. Профамма должна завершить работу после того, как пользователь сделает 10 щелчков кнопкой мыши. Рекомендуемый вид окна в начале работы профаммы приведен на рис. 1.21.
unit tir_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
60
Част
Примеры и задачи
61
Рис. 1.21. Окно программы Тир
type
TForml = class(TForm)
Timer: TTimer;
Labell: TLabel;
Buttonl: TButton;
procedure TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ForroMouseDown(Sender: TObject; Button: TMouseButton Shift: TShiftState; X, Y: Integer);
procedure ButtonlClick(Sender: TObject); private
{ Private declarations } public
I Public declarations }
I
объявление процедур помещено сюда, чтобы процедуры имели прямой доступ к форме, на которой они рисуют
procedure PaintFace(x,y: integer); // рисует рожицу procedure EraseFace(x,y: integer); // стирает рожицу
end;
var
Forml: TForml; fx,fy: integer; n: integer;
p: integer;
// координаты рожицы
// количество щелчков кнопкой мыши
// количество попаданий
IBplementation
// рисует рожицу
procedure TForml. PaintFace (х, у: integer) ;
begin
Canvas.Pen.Color \* clBlack; // цвет линий
Canvas.Brush.Color := clYellow; // цвет закраски
// рисуем рожицу
Canvas.Ellipse(x,y,x+30,Y+30); // лицо
Canvas.Ellipse (x+9,y+10,x+U,y+13); // левый глаз
Canvas.Ellipse (х+19,У+Ю,х+21,у+13); // правый глаз
Canvas.Arc(x+4,y+4,x+26,y+26,x,y+20,x+30,y+20) ; // улыбка
end;
// стирает рожицу
procedure TForml.EraseFace(x,у: integer);
begin
// зададим цвет границы и цвет закраски,
// совпадающий с цветом формы. По умолчанию
// цвет формы - clBtnFace (см. в Object Inspector)
Canvas.Pen.Color := clBtnFace; // цвет окружности
Canvas.Brush.Color := clBtnFace; // цвет закраски
Canvas.Ellipse (x, у,х+ЗО,у+30) ;
end;
($R *.dfm}
procedure TForml. TimerTimer (Sender: TObj ect) ; begin
EraseFace(fx,fy);
// новое положение рожицы
fx:= Random(ClientWi.dth-30); // 30 - это диаметр рожицы
fy:= Random(ClientHeight-30) ;
PaintFace (fx,fy) ; end;
Procedure TForml. FormCreate (Sender: TOb j ect) ; begin
// исходное положение рожицы
fx:=100;
fy:=100;
Randomize; // инициализация генератора
// случайных чисел
end;
62
Час
Примеры и задачи
63
Кривая
третьего порядка
(а3)
получается
путем
соединения
четырех
кривых второго
порядка:
d2,
a2,
а2
и Сг
procedure TForml.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); begin
inc(n); // кол-во щелчков
if (x > fx) and (x < fx+30) and
(y > fy) and (y < fy+30) then begin
// щелчок по рожице inc(p) ;
end;
if n = 10 then begin
// игра закончена
Timer.Enabled := False; // остановить таймер ShowMessage('Выстрелов: 10. Попаданий: ' + IntToStr(p)+'.');
EraseFace(fx,fy);
Labell.Visible := True;
Buttonl.Visible : = True;
// теперь кнопка и сообщение снова видны
end;
end;
// щелчок на кнопке Ok
procedure TForml.ButtonlClick(Sender: TObject);
begin
Labell.Visible := False; // скрыть сообщение Buttonl.Visible := False; // скрыть кнопку Timer.Enabled := True; // пуск таймера
var
Р:
integer
=
5; u= integer
=
7;
end.
27. Напишите программу, которая на поверхности формы черчивает кривую Гильберта (рис. 1.22). Пример кривой Гш берта пятого порядка приведен на рис. 1.23.
A1 b1
Ci a.
Кривая второго
порядка (а2) образуется
путем соединения
четырех кривых
первого порядка:
di, аи а: и Ct
Кривые первого
порядка получаются
путем соединения
кривых нулевого
Рис. 1.22. Кривые Гильберта
порядка (точек)
Рис. 1.23. Кривая Гильберта пятого порядка
// порядок кривой //длина штриха
Кривая Гильберта состоит из четырех соединенных прямыми элементов: a, b,c и d .
Каждый элемент строит соответствующая процедура. } Procedure a(i:integer; canvas: TCanvas); forward;
64
Примеры и задачи
65
procedure
с(i:integer;
canvas: TCanvas); forward;
procedure
d(i:integer;
canvas: TCanvas); forward;
// Элементы кривой
procedure a(i: integer; canvas: TCanvas); begin
if i > 0 then begin
d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X+u, canvas.PenPos.Y);
a(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
a(i-l, canvas);
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
c(i-l, canvas); end;
end;
procedure b(i: integer; canvas: TCanvas); begin
if i > 0 then begin
c(i-l, canvas);
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
b(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
b(i~l, canvas) ;
canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
d(i-l, canvas); end;
end;
procedure c(i: integer; canvas: TCanvas); begin
if i > 0 then begin
b(i-l, canvas);
canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y-u);
c(i-l, canvas);
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
c(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
a(i-l, canvas); end;
end;
procedure d(i: integer; canvas: TCanvas); begin
if i > 0 then begin
a(i-li canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u) , d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y) , d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u),
b (i-1, canvas);
end;
end;
// обработка события OnPaint
procedure TForml.FormPaint(Sender: TObject); begin
Forml.Canvas.MoveTo(u,u);
a(5,Forml.Canvas) ; // вычертить кривую Гильберта end;
Рис. 1.24. Координатная
сетка
w
66
ЧастьЩ
Примеры и задачи
67
//
обработка
события
OnPaint
procedure TForml.FormPaint(Sender: TObject);
var
xO,yO:integer; // координаты начала координатных осей
dx,dy: integer; // шаг координатной сетки (в пикселах) h,w:integer; // высота и ширина области вывода координатной
// сетки х,у:integer;
lx,ly:real; dlx,dly:real; cross:integer; dcross:integer;
begin
xO:=3O; yO:=22O; dx:=40; dy:=40; dcross:=1;
// метки (оцифровка) линий сетки по X и У
// шаг меток (оцифровки) линий сетки по X и Y
// счетчик не оцифрованных линий сетки
// количество не оцифрованных линий
// между оцифрованными
// оси начинаются в точке (40,250) // шаг координатной сетки 40 пикселов // помечать линии сетки X: 1 — каждую; // 2 — через одну;
dlx:=0.5;
dly:=1.0;
h:=200;
w:=300;
// шаг меток оси X
// шаг меток оси Y, метками будут: 1,2, 3 // и т.д
// линия сетки
Pen.Style:=psDot;
MoveTo(x,yO-3);LineTo(x,yO-h); Pen.Style:=psSolid;
lx:=lx+dlx;
x:=x+dx;
until (x>xO+w);
// засечки, сетка и оцифровка по оси У
y:=yO-dy;
ly:=dly;
// засечка //оцифровка
// линия сетки
repeat
MoveTo(хО-3,у);LineTo(xO+3,y);
TextOut(xO-20,y,FloatToStr(ly))
Pen.Style:=psDot;
MoveTo(xO+3,y); LineTo(xO+w,y);
Pen.Style:=psSolid;
y:=y-dy;
ly:=ly+dly; until (y<yO-h);
end;
end;
29. Напишите программу, которая на поверхности формы вычерчивает график функции, например 2 sin(x) e*/5. Вид окна во время работы программы приведен на рис. 1.25.
with forml.Canvas do begin
cross:=dcross;
// ось X // ось У
MoveTo(xO,yO); LineTo(xO,yO-h);
MoveTo(xO,yO); LineTo(xO+w,yO);
// засечки, сетка и оцифровка по оси X
x:=xO+dx;
lx:=dlx;
repeat
MoveTo(x,yO-3);LineTo(x,yO+3); // засечка
cross:=cross-l;
if cross = 0 then //оцифровка
begin
TextOut(x-8,yO+5,FloatToStr(lx)); cross:=dcross;
end;
Рис. 1.25. Окно программы График функции
68
Част
Примеры и задачи
69
// Функция, график которой надо построить Function f(x:real):real;
begin
f:=2*Sin(x)*exp(x/5); end;
// строит график функции
procedure GrOfFunc;
var
xl,x2:real; // границы изменения аргумента функции yl,y2:real; // границы изменения значения функции x:real; // аргумент функции
у:real; // значение функции в точке х
dx:real; // приращение аргумента
l,b:integer; // левый нижний угол области вывода графика w,h:integer; // ширина и высота области вывода графика mx,my:real; // масштаб по осям X и У
хО,уО:integer; // точка — начало координат
begin
// область вывода графика
1:10; // X — координата левого верхнего
// угла
b:=Forml.ClientHeight-20;
h:=Forml.ClientHeight-4
0; w:=Forml.Width-40;
// угла
// высота
// ширина
xl:=O; // нижняя граница диапазона аргумента
х2:=25; // верхняя граница диапазона аргумента
dx:=0.01; // шаг аргумента
// найдем максимальное и минимальное значения
// функции на отрезке [xl,x2]
yl:=f(xl); // минимум
у2:=f(xl); // максимум
x:=xl;
repeat
у := f(x);
if у < yl then yl:=y;
if у > y2 then y2:=y;
x:=x+dx;
until (x>=x2);
// вычислим масштаб
my:=h/abs(y2-yl); // масштаб по оси
mx:=w/abs(x2-x1);// масштаб по оси
// оси
хО:=1;
yO:=b-Abs(Round(yl*my));
with forml.Canvas do begin
// оси
MoveTo(l,b);LineTo(l,b-h);
MoveTo(xO, yO);LineTo(xO+w, yO);
TextOut(1+5,b-h,FloatToStrF(y2,ffGeneral,6,3)); TextOut(1+5,b,FloatToStrF(yl, ffGeneral, 6,3)) ;
// построение графика
x:=xl;
repeat
y:=f(x);
Pixels[xO+Round(x*mx),yO-Round(y*my)]:=clRed; x:=x+dx;
until (x>=x2);
end; end;
procedure TForml.FormPaint(Sender: TObject); begin
GrOfFunc; end;
// изменился размер окна программы
procedure TForml.FormResize(Sender: TObject); begin
// очистить форму
forml .Canvas. FillRect (Rect (0, 0, ClientWidth, clientHeight) ) ;
// построить график
GrOfFunc; end;
30. Напишите программу, которая выводит на экран гистограмму, например, результатов контрольной работы- Пример окна программы во время ее работы приведен на рис. 1 .26.
70
Час
Примеры и задачи
71
Рис. 1.26. Окно программы Гистограмма