Ий способ.
Program Demo_3;
Uses Graph,Crt;
Var
P :Pointer; {определяем нетипизированный указатель}
Size :Word;
Driver,Mode,i:Integer;
Begin
Driver:=Detect;
InitGraph(Driver,Mode,'');
{рисуем закрашенный шарик}
SetBkColor(Black);
SetColor(Red);
Circle(30,30,15);
SetFillStyle(SolidFill,Blue);
FloodFill(30,30,Red);
size:=ImageSize(5,5,50,50); {определяет объем памяти,}
{необходимый для сохранения изображения}
GetMem(P,Size); {выделяет память в динамически}
{распределяемой области размером в size байт}
GetImage(5,5,50,50,P^); {запоминаем изображение}
PutImage(i,i,P^,XorPut); {стираем изображение}
for i:=5 to 300 do
Begin
PutImage(i,i,P^, XorPut); {выводим изображение}
Delay(3000); {пауза}
PutImage(i,i,P^,XorPut); {стираем изображение}
end;
ReadLn;
CloseGraph;
End.
Примеры программ работы с графикой
1. Построение мозаичных изображений.
Мозаичное изображение можно построить с помощью рисования прямоугольников. Для задания изображения нужно сформировать матрицу, содержащую вид этого изображения. Каждый элемент матрицы с координатами (i,j) – номер цвета, которым нужно закрасить прямоугольник, находящийся на пересечении i-ой строки и j-го столбца.
Пример. Создать мозаичное изображение вида:
Program Demo_1;
Uses Crt,Graph;
Const
h=10; {высота прямоугольника}
B: array[1..5,1..5] of 0..2=
((0,0,1,0,0), {задаем матрицу размером 5x5}
(0,1,0,1,0), {тип 0..2 – количество используемых цветов}
(1,0,2,0,1),
(0,1,0,1,0),
(0,0,1,0,0));
Var
Driver,Mode,i,j,x,y:Integer;
Begin
Driver:=Detect;
InitGraph(Driver,Mode,'');
For i:=1 to 5 do
Begin
y:=i*h;
for j:=1 to 5 do
Begin
x:=75+j*h;
case B[i,j] of
0:SetFillStyle(1,White); {меняем цвет заполнения}
1:SetFillStyle(1,Blue); {в зависимости от значения}
2:SetFillStyle(1,Yellow) {элемента матрицы}
end;
Bar(x,y,x+h,y+h); {рисуем прямоугольник}
end;
end;
ReadLn;
CloseGraph;
End.
2. Построение графика функции.
Для построения графика функции прежде всего нужно построить систему координат, так как для графического режима она отличается от привычной для пользователя (ось oy направлена сверху вниз, начало координат находится в левом верхнем углу экрана).
| Система координат графического экрана | Декартова система координат |
Для преобразования координат точки (x,y) декартовой системы координат в координаты точки (X,Y) системы координат графического режима можно использовать преобразования:
где wm, wn – масштабные коэффициенты по осям, (wx,wn) – координаты центра начала декартовой системы координат на графическом экране.
Пример: построить график функции y=sin(x).
Program Demo_2;
Uses Graph;
Const
a=-10; {[a,c] – отрезок, на котором строится график функции}
c=10;
wm=50; {масштабный множитель по оси ox}
wn=50; {масштабный множитель по оси oy}
Var
Driver,Mode:Integer;
i,wx,wy :Integer;
x,y:Real;
Begin
Driver:=Detect;
InitGraph(Driver,Mode,'');
{Задаем координаты начала системы координат в центре экрана}
wx:=GetMaxX div 2;
wy:=GetMaxY div 2;
{Рисуем оси}
SetColor(Red);
SetLineStyle (SolidLn,0,ThickWidth);
Line(0,wy,GetMaxX,wy); {ox}
Line(wx,0,wx,GetMaxY); {oy}
{Подписи осей}
SetColor(White);
OutTextXY(wx+7,4,'Y');
OutTextXY(GetMaxX-8,wy+6,'X');
{Вертикальные линии сетки}
SetColor(Green);
SetLineStyle (SolidLn,0,NormWidth);
i:=1;
While (wx-i*wm>0) or (wx+i*wm<GetMaxX) do
Begin
Line(wx-i*wm,0,wx-i*wm,GetMaxY);
Line(wx+i*wm,0,wx+i*wm,GetMaxY);
Inc(i);
end;
{Горизонтальные линии сетки}
i:=1;
While (wy-i*wn>0) or (wy+i*wn<GetMaxY) do
Begin
Line(0,wy-i*wn,GetMaxX,wy-i*wn);
Line(0,wy+i*wn,GetMaxX,wy+i*wn);
Inc(i);
end;
{Строим график точками}
i:=a*wm;
While i<=c*wm do
Begin
x:=i/wm;
y:=sin(x);
PutPixel(Round(wx+wm*x),Round(wy+wn*y),White);
i:=i+1;
end;
ReadLn;
CloseGraph;
End.
3. Построение круговых и столбчатых диаграмм.
Построить круговую и столбчатую диаграммы, содержащие сведения о знаменитых алмазах следующего вида:
Для построения диаграмм нужно определить 2 массива: первый содержит значения массы в каратах (массив А[1..5]), второй – названия алмазов (массив Y[1..5]).
Расчет высоты столбика производится следующим образом:
· находим самый большой алмаз (max). Пусть этому значению соответствует столбик в 200 пиксел;
· высота каждого столбика равна 
.
Градусная мера угла для построения круговых диаграмм рассчитывается так:
· находим сумму в каратах всех знаменитых алмазов (sum). Этому значению будет соответствует угол в 3600;
· градусную меру каждого угла определим из формулы 
.
Program Demo_3;
Uses Graph,Crt;
Type
Mas1=array[1..5] of Real;
Mas2=array[1..5] of String[15];
Const
N=5; {количество данных}
A:Mas1=(3106,971,968,787,770); {значения}
Y:Mas2=('Куллинан','Эльсценсиор',
'Сьерра-Леоне','Великий Могол',
'Река Уойе'); {подписи данных}
Var
Driver,Mode :Integer;
Z :array[1..N] of Integer;
T :String[15];
max,sum :Real;
y0,y1,y2,h,pr,x,rx,osn,
ras,I :Integer;
{Круговая диаграмма}
Procedure Sect;
Begin
OutTextXY(100,30,
'Знаменитые алмазы (масса в каратах)');
{расчет общей суммы}
sum:=0;
For i:=1 to N do
sum:=sum+A[i];
For i:=1 to N do
Z[i]:=Round(a[i]*360/sum);
y0:=0;
{рисование сектора}
For i:=1 to N do
Begin
SetFillStyle(2,i+1);
PiesLice(325,190,y0,y0+z[i],140);
y0:=y0+z[i];
end;
y1:=50;
y2:=70;
{рисование легенды и подписи к ней}
For i:=1 to N do
Begin
SetFillStyle(2,i+1);
Bar3d(20,y1,60,y2,5,True);
Str(A[i]:6:1,t);
OutTextXY(70,y1+10,t);
y1:=y1+30;
y2:=y2+30;
end;
ReadLn;
End;
{Столбчатая диаграмма}
Procedure Stol;
Begin
ClearDevice;
x:=50;
rx:=30; {ширина столбика}
ras:=Round(500/N); {расстояние между столбиками}
osn:=250; {координата основания}
Rectangle(x,osn,500, osn+35);
SetTextStyle(4,0,2);
pr:=0;
OutTextXY(100,30,
'Знаменитые алмазы (масса в каратах)');
max:=A[1];
For i:=1 to N do
If A[i]>max then max:=A[i];
For i:=1 to N do
Begin
OutTextXY(x+10,osn+5,Y[i]);
h:=Trunc(A[i]*200/max); {высота}
SetFillStyle(9,i+10);
Bar (x, 250-h,x+rx, osn);
Str(a[i]:6:1,t);
OutTextXY(x,250-h-12,t);
x:=x+ras;
end;
ReadLn;
end;
Begin
Driver:=Detect;
InitGraph(Driver,Mode,'');
Stol;
Sect;
CloseGraph;
End.
Дата добавления: 2015-04-15; просмотров: 709;