Форум программистов, компьютерный форум, киберфорум
Наши страницы

Turbo Pascal

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 1, средняя оценка - 5.00
Puporev
Модератор
52389 / 40236 / 13575
Регистрация: 18.05.2008
Сообщений: 92,996
15.01.2010, 08:23 #31
График функции с имитацией курсора, положение которого показывает значение функции в данной точке.
Предложено форумчанином Inside.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
program lr_19;
uses crt,graph;
type fun=function(x:real):real;
var gd,gm:integer;
{$f+}
function f(x:real):real;
begin
f:=0.25*x*sqr(x)+x-1.2502
end;
{$f-}
procedure Graffun(xn,xk,ok:real;xa,ya,xb,yb:integer;f:fun);
var y,x,hx,hx1,ymin,ymax,mx,my,yy,sx,sy:real;
    i,x1,y1,x2,y2,hy:integer;
    st:string;
procedure maxmin;
begin
x:=xn;
ymax:=-1e30;
ymin:=1e30;
while x<=xk do
      begin
      y:=f(x);
      if y>ymax then ymax:=y;
      if y<ymin then ymin:=y;
      x:=x+hx1
      end;
ymax:=round(ymax/ok+0.4999)*ok;
ymin:=round(ymin/ok-0.5)*ok;
end;
procedure graf;
begin
setlinestyle(0,0,3);
x:=xn;
setcolor(4);
x1:=round(mx*x+sx);
y1:=round(-my*f(x)+sy);
while x<=xk-hx1 do
 begin
  x:=x+hx1;
  x2:=round(mx*x+sx);
  y2:=round(-my*f(x)+sy);
  line(x1,y1,x2,y2);
  x1:=x2;
  y1:=y2
 end
end;
begin
hx1:=(xk-xn)/200;
maxmin;
hx:=(xk-xn)/10;
hy:=(yb-ya) div 8;
mx:=(xb-xa)/(xk-xn);
my:=(yb-ya)/(ymax-ymin);
sy:=ya+my*ymax;
sx:=xa-mx*xn;
setfillstyle(1,7);
bar(xa,ya,xb,yb);
setlinestyle(0,0,1);
settextjustify(1,2);
settextstyle(0,0,1);
x:=xn;
i:=round(mx*x+sx);
while i<=xb+1 do
 begin
  setcolor(15);
  line(i,ya,i,yb);
  setcolor(14);
  str(x:4:2,st);
  outtextxy(i,yb+3,st);
  x:=x+hx;
  i:=round(mx*x+sx)
 end;
settextjustify(2,1);
i:=yb;
while i>=ya do
 begin
  setcolor(15);
  line(xa,i,xb,i);
  yy:=(sy-i)/my;
  setcolor(14);
  str(yy:4:2,st);
  outtextxy(xa-3,i,st);
  i:=i-hy
 end;
graf;
end;
procedure Kurcorx(xn,xk,ok:real;xa,ya,xb,yb:integer;f:fun);
var my,sy,ymin,ymax,x,mx,sx,y,hx,hx1:real;
    i,y1,i1,hi:integer;
    st:string;
    ch:char;
procedure maxmin;
begin
x:=xn;
ymax:=-1e30;
ymin:=1e30;
while x<=xk do
  begin
   y:=f(x);
   if y>ymax then ymax:=y;
   if y<ymin then ymin:=y;
   x:=x+hx1
 end;
ymax:=round(ymax/ok+0.4999)*ok;
ymin:=round(ymin/ok-0.5)*ok;
end;
procedure out;
begin
setcolor(11); setlinestyle(0,0,3);
hx1:=(xk-xn)/200;
maxmin;
x:=(i-sx)/mx;
my:=(yb-ya)/(ymax-ymin);
sy:=ya+my*ymax;
y1:=round(-my*f(x)+sy);
line(i,y1,i,y1+10);
line(i,y1,i-3,y1+5);
line(i,y1,i+3,y1+5)
end;
procedure quit;
begin
setfillstyle(1,1);
bar(xb+15,yb-55,xb+86,yb-43);
setcolor(15);
settextjustify(0,0);
outtextxy(xb+18,yb-45,'QUIT-ESC');
end;
begin
mx:=(xb-xa)/(xk-xn);
sx:=xa-mx*xn;
hi:=4;i:=xa;i1:=yb;
quit;
setwritemode(xorput);
out;
while true do
 begin
  ch:=readkey; if ch=#27 then exit;
  if ch=#0 then
   begin
    ch:=readkey;
    case ch of
    #75:begin
        out;
        i:=i-hi;
        {i1:=i1+hi;}
        if i<xa then i:=xa;
        {if i1>yb then i1:=yb;}
        out
        end;
    #77:begin
        out;
        i:=i+hi;
        {i1:=i1-hi;}
        if i>xb then i:=xb;
        {if i1<ya then i1:=ya;}
        out
        end;
    #71:begin
        out;
        i:=xa;
        out
        end;
    #79:begin
        out;
        i:=xb;
        out
        end;
    end;
x:=(i-sx)/mx;
y:=f(x);
setviewport(xb+15,yb-30,getmaxx,yb,false);
setcolor(14);
clearviewport;
str(x:4:2,st);
outtextxy(4,12,'X='+st);
str(y:5:2,st);
outtextxy(4,27,'F='+st);
setviewport(0,0,getmaxx,getmaxy,true);
end
end
end;
begin
gd:=detect;
initgraph(gd,gm,'');
setbkcolor(9);
Graffun(1.5,6.5,0.5,60,8,getmaxx-90,getmaxy-23,f);
Kurcorx(1.5,6.5,0.5,60,8,getmaxx-90,getmaxy-23,f);
closegraph;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
15.01.2010, 08:23
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Графика в Турбо Паскаль (Turbo Pascal):

Графика в Турбо Паскаль - Turbo Pascal
(b+\sqrt{b-4ac}/2a)-a*a*a*c - помогите как это записать в турбо паскале напишите кто нить полную программу пожалуйста!

Графика в Турбо Паскаль - Turbo Pascal
Не могли бы вы посоветовать книгу или дать ссылку на форуме где подробно описана работа с графикой , особенно рисовка движения разными...

Графика в Турбо Паскаль - Turbo Pascal
ситуация следующая. написала програму в которой задаешь координаты точки и в зависимости от ее места нахождения в фигуре закрашеной или не...

Графика в Турбо Паскаль не работает - Turbo Pascal
Люди помогите плиз. У меня windows 7 когда я пытаюсь запустить программу с модулем graph, на Turbo pascal, то он мне выдает ошибку...

построение графика на Турбо Паскаль - Turbo Pascal
Помогите пожалуйста Y=(x*(3-x))/(1-x)*sqr(1-x)

Построение графика функции в турбо-Паскаль - Turbo Pascal
Как построить график данной функции в паскаль?(2*(1+0.7*(sin(10^7*t))*(sin(10^8*t))

157
ЛоРД_Оледжан
Программист
56 / 54 / 7
Регистрация: 23.07.2009
Сообщений: 336
31.01.2010, 15:25 #32
Эта программа демонстрирует 3Д вращение каркаса куба по различным осям
Скорость вращения зависит от "кривости" модуля CRT
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Program Kub;
Uses Graph,Crt;
Type
    mas=array[1..8] of real;
Var
   ro,teta,phi,d,rebro:real;
   xk,yk,zk:mas;
   xv,yv,zv:mas;
   V:array [1..4,1..4] of real;
   i,GrDrive,GrMode:integer;
   minx,miny,maxx,maxy,fx,fy,f,c1,c2:real;
   t,f1,wx1,wy1,wx2,wy2:integer;
   q:char;
Function mult(x,y,z:real; n:integer):real;
Begin
 xv[n]:=x*v[1,1]+y*v[2,1]+z*v[3,1]+v[4,1];
 yv[n]:=x*v[1,2]+y*v[2,2]+z*v[3,2]+v[4,2];
 zv[n]:=x*v[1,3]+y*v[2,3]+z*v[3,3]+v[4,3];
End;
Begin
 GrDrive:=Detect;
 InitGraph(GrDrive,GrMode,'');
 t:=0;
 f1:=0;
 d:=1400;
 Repeat
  SetColor(0);
  line(round(xv[1]),round(yv[1]),round(xv[2]),round(yv[2]));
  line(round(xv[2]),round(yv[2]),round(xv[3]),round(yv[3]));
  line(round(xv[3]),round(yv[3]),round(xv[4]),round(yv[4]));
  line(round(xv[4]),round(yv[4]),round(xv[1]),round(yv[1]));
  line(round(xv[5]),round(yv[5]),round(xv[6]),round(yv[6]));
  line(round(xv[6]),round(yv[6]),round(xv[7]),round(yv[7]));
  line(round(xv[7]),round(yv[7]),round(xv[8]),round(yv[8]));
  line(round(xv[8]),round(yv[8]),round(xv[5]),round(yv[5]));
  line(round(xv[1]),round(yv[1]),round(xv[5]),round(yv[5]));
  line(round(xv[2]),round(yv[2]),round(xv[6]),round(yv[6]));
  line(round(xv[3]),round(yv[3]),round(xv[7]),round(yv[7]));
  line(round(xv[4]),round(yv[4]),round(xv[8]),round(yv[8]));
  rebro:=100;
  ro:=1360;
  t:=t+1;
  f1:=f1+1;
  if t=90 then t:=0;
  if f1=90 then f1:=0;
  teta:=t*pi/180;
  phi:=f1*pi/180;
  xk[1]:=rebro;    yk[1]:=-rebro;   zk[1]:=-rebro;
  xk[2]:=rebro;    yk[2]:=rebro;    zk[2]:=-rebro;
  xk[3]:=-rebro;   yk[3]:=rebro;    zk[3]:=-rebro;
  xk[4]:=-rebro;   yk[4]:=-rebro;   zk[4]:=-rebro;
  xk[5]:=rebro;    yk[5]:=-rebro;   zk[5]:=rebro;
  xk[6]:=rebro;    yk[6]:=rebro;    zk[6]:=rebro;
  xk[7]:=-rebro;   yk[7]:=rebro;    zk[7]:=rebro;
  xk[8]:=-rebro;   yk[8]:=-rebro;   zk[8]:=rebro;
 
  v[1,1]:=-sin(teta); v[1,2]:=-cos(phi)*cos(teta); v[1,3]:=-sin(phi)*cos(teta);
  v[2,1]:=cos(teta);  v[2,2]:=-cos(phi)*sin(teta); v[2,3]:=-sin(phi)*sin(teta);
  v[3,1]:=0;          v[3,2]:=sin(phi);            v[3,3]:=-cos(phi);
  v[4,1]:=0;          v[4,2]:=0;                   v[4,3]:=ro;
 
  for i:=1 to 8 do
   begin
    mult(xk[i],yk[i],zk[i],i);
    xv[i]:=d*xv[i]/zv[i];
    yv[i]:=d*yv[i]/zv[i];
  end;
  SetViewPort(250,200,350,300,false);
  SetColor(10);
  line(round(xv[1]),round(yv[1]),round(xv[2]),round(yv[2]));
  line(round(xv[2]),round(yv[2]),round(xv[3]),round(yv[3]));
  line(round(xv[3]),round(yv[3]),round(xv[4]),round(yv[4]));
  line(round(xv[4]),round(yv[4]),round(xv[1]),round(yv[1]));
  line(round(xv[5]),round(yv[5]),round(xv[6]),round(yv[6]));
  line(round(xv[6]),round(yv[6]),round(xv[7]),round(yv[7]));
  line(round(xv[7]),round(yv[7]),round(xv[8]),round(yv[8]));
  line(round(xv[8]),round(yv[8]),round(xv[5]),round(yv[5]));
  line(round(xv[1]),round(yv[1]),round(xv[5]),round(yv[5]));
  line(round(xv[2]),round(yv[2]),round(xv[6]),round(yv[6]));
  line(round(xv[3]),round(yv[3]),round(xv[7]),round(yv[7]));
  line(round(xv[4]),round(yv[4]),round(xv[8]),round(yv[8]));
  delay(1000);
 Until KeyPressed;
 CloseGraph;
End.
Добавлено через 4 часа 40 минут
Алгоритм вращения 3Д куба с разноцветными гранями имеются мелкие коментарии принципа роботы программы
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
uses Graph, Crt;
 
procedure DrawCube;
label
  nextj;
type
  cube=array[1..8] of record x,y,z:integer end;
 
{verts-koordinatu (x,y,z) vershin figyru}
const
 verts:cube=(
 (x: 1; y: 1; z: 1),  {1-a vershina}
 (x: 1; y: 1; z:-1),  {2}
 (x: 1; y:-1; z: 1),  {3}
 (x: 1; y:-1; z:-1),  {4}
 (x:-1; y: 1; z: 1),  {5}
 (x:-1; y: 1; z:-1),  {6}
 (x:-1; y:-1; z: 1),  {7}
 (x:-1; y:-1; z:-1)); {8}
 
 {g- eto opisanie iz kakih vershin v sostoiat grani
     (v massive legat nomera tochec v nymeracii verts) }
 g:array[1..6, 1..4] of shortint=
 ((1,2,4,3),
  (1,2,6,5),
  (1,3,7,5),
  (3,4,8,7),
  (2,4,8,6),
  (5,6,8,7));
 
 
var
  Alfa,Beta,Gamma, {proekcii edinichnogo vectora povorota (ego dlina=1)}
  Teta,            {ygol povorota tochek prostranstva}
  DT:real;         {pribavka ygla Teta}
  c:cube;          {massiv dlia koordinat vrashaemuh vershin}
 
 procedure Rotate(var x,y,z:integer);
 {povorot tochki vokrug edinichnogo vektora (Alfa, Beta, Gamma) na ygol Teta}
 var
   cosT, sinT, One_cosT, AOne_cosT, BOne_cosT,GsinT:real;
   xn,yn,zn:integer;
 begin
   {eto slognoe preobrathovanie vziato iz spravochnika po stereometrii}
   cosT:=cos(Teta);
   sinT:=sin(Teta);
   One_cosT :=1.0-cosT;
   AOne_cosT:=Alfa*One_cosT;
   BOne_cosT:=Beta*One_cosT;
   GsinT:=Gamma*sinT;
 
   xn:=trunc(
      x*( cosT      + Alfa  * AOne_cosT)+
      y*( GsinT     + Beta  * AOne_cosT)+
      z*(-Beta*sinT + Gamma * AOne_cosT));
 
   yn:=trunc(
      x*(-GSinT     + Beta  * AOne_cosT)+
      y*( cosT      + Beta  * BOne_cosT)+
      z*( Alfa*sinT + Gamma * BOne_cosT));
 
   zn:=trunc(
      x*( Beta*sinT + Gamma * AOne_cosT)+
      y*(-alfa*sinT + Gamma * BOne_cosT)+
      z*( cosT      + Gamma*Gamma*One_cosT));
 
   x:=xn; y:=yn; z:=zn;
 end;
 
 function minz:integer;
 {nahogdenie samoi "zadnei" tochki, t.e. s min Z}
 var j,m:integer;
 begin
   m:=1;
   for j:=2 to 8 do
     if c[j].z<c[m].z then m:=j;
   minz:=m;
 end;
 
 
var
  Pnts:array[1..5] of record {Byfer dlia risovania tochek grani cherez FillPoly}
    x,y:integer
  end;
  min:integer;      {nomer samoi "zadnei" tochki}
  x0,y0:integer;    {centr izobrajenia}
  a: integer;       {Koef. yvelichenia izobrajenia}
 
  i,j,k:integer;    {Parametru ciklov}
  page:word;
 
begin
 page:=0;
 x0:=120;
 y0:=100;
 
 a:=40;
 Alfa:=0.6;
 Beta:=0.7;
 Gamma:=sqrt(1.0-Alfa*Alfa-Beta*Beta); {3-mernaia teorema Pifagora}
 Teta:=0;
 DT:=2*Pi/100;{2.0*Pi/20;}
 
 {Masshtabiryem i povorachivaem vse vershinu na ygol Teta}
 for i:=1 to 8 do
  begin
   c[i].x:=verts[i].x*a;
   c[i].y:=verts[i].y*a;
   c[i].z:=verts[i].z*a;
   Rotate(c[i].x,c[i].y,c[i].z)
  end;
 min:=MinZ; {Nahodim samyi zadniy vershiny}
 SetVisualPage((Page+1)mod 2);
 
 for k:=0 to 2500 do
  begin
    SetActivePage(page); {delaem aktivnoi nevidimyiy stranicy}
 
 
    for j:=1 to 6 do
      begin
        {propysk nevidimoi grani iz samoiy "zadnei" tockoi}
        for i:=1 to 4 do if min=g[j,i] then goto nextj; {goto neobhodim!}
        {prohodim po vershinam grani}
        for i:=1 to 4 do
          begin
           {Berem proekciy vershinu na ploskosti xoy  }
           Pnts[i].x:=x0+c[g[j,i]].x;
           Pnts[i].y:=y0+trunc(0.775*c[g[j,i]].y) {0.775- k-t sgatia EGA HI}
          end;
        SetFillStyle(SolidFill, word(j+8)); {Kagdoi grani svoia zakraska}
        {Pnts[5]:=Pnts[1];}    {eto nygno pri DrawPoly}
        FillPoly(4,Pnts);
        nextJ:
      end;
 
    SetVisualPage(Page);       {pokazivaem risynok: delaem vidimoi stranicy}
    SetActivePage((Page+1)mod 2); {delaem aktivnoi nevid. str. dlia Bar}
 
    {Povorachivaem vershinu}
    for i:=1 to 8 do
      begin
        c[i].x:=verts[i].x*a;
        c[i].y:=verts[i].y*a;
        c[i].z:=verts[i].z*a;
        Rotate(c[i].x,c[i].y,c[i].z)
      end;
    min:=MinZ;
 
    SetFillStyle(SolidFill, Black);
    Bar(0,0,x0*2,y0*2);           {stiraem staroe izobragenie na nevid. str.}
    Teta:=Teta+DT;                {yvelichivaem ygol povorota}
    Page:=(Page+1)mod 2;          {meniaem stranicy (0->1; 1->0) }
    if KeyPressed then
    exit;
  end;
end;
 
 
var drv,mode:integer;
begin
  drv:=EGA;
  mode:=EGAHI;
  InitGraph(drv,mode,'C:\compilat\tp\bgi');
  DrawCube;
  CloseGraph;
end.
0
MicM
822 / 480 / 90
Регистрация: 29.12.2009
Сообщений: 1,097
Завершенные тесты: 1
14.02.2010, 08:50 #33
Белый прямоугольник движущийся под управлением стрелок, выход по нажатии клавиши Esc.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
uses crt,graph;
var
gd,gm,x,y,dx,dy:integer;
ch:char;
procedure dvizhenie(dx,dy:integer);
begin
setfillstyle (1,black);
bar (x,y,x+100,y+10);
x:=x+dx;
y:=y+dy;
setfillstyle (1,white);
bar (x,y,x+100,y+10);
end;
begin
gd:=detect;
initgraph (gd,gm,'bgi');
x:=270;y:=240;
bar (x,y,x+100,y+10);
repeat
ch:=readkey;
if ch=#0 then begin
ch:=readkey;
case ch of
#80:dvizhenie(0,5);
#72:dvizhenie (0,-5);
#77:dvizhenie (5,0);
#75:dvizhenie (-5,0);
end;
end;
until ch=#27;
end.
1
WolfCF
25.02.2010, 07:49
  #34

Не по теме:

так вот же идентичный рисунок http://www.cyberforum.ru/pascal/thread56317.html#post309305

0
Puporev
Модератор
52389 / 40236 / 13575
Регистрация: 18.05.2008
Сообщений: 92,996
25.02.2010, 07:58 #35
Да уж, кто-то у кого-то скопипастил. Поскольку Давид был первым, сообщение yura`, удаляю.
0
yura`
11 / 8 / 0
Регистрация: 09.02.2010
Сообщений: 107
17.03.2010, 16:26 #36
Дельфин: с размерами сетки изменяется и размер самого дельфина:


Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
uses crt,graph;
var a,b:array [1..100] of PointType;
i,j,x,y,gd,gm,k:integer;
begin
clrscr;
write('Vvedite rozmer setki: ');
readln(x); y:=x;
gd:=Detect;
InitGraph(gd,gm,'');
i:=0; j:=0;
SetBkColor(15);
SetPalette(5,0);
SetColor(5);
while i<=x*30 do begin
Line(0+i,0,0+i,y*20);
i:=i+x;
end;
while j<=y*20 do begin
Line(0,0+j,x*30,0+j);
j:=j+y;
end;
i:=1;
a[i].x:=x*29; a[i].y:=y*11; inc(i);
a[i].x:=x*29; a[i].y:=y*12; inc(i);
a[i].x:=x*28; a[i].y:=y*13; inc(i);
a[i].x:=x*24; a[i].y:=y*13; inc(i);
a[i].x:=x*20; a[i].y:=y*14; inc(i);
a[i].x:=x*18; a[i].y:=y*17; inc(i);
a[i].x:=x*17; a[i].y:=y*17; inc(i);
a[i].x:=x*17; a[i].y:=y*14; inc(i);
a[i].x:=x*13; a[i].y:=y*14; inc(i);
a[i].x:=x*5; a[i].y:=y*11; inc(i);
a[i].x:=x*3; a[i].y:=y*14; inc(i);
a[i].x:=x*2; a[i].y:=y*14; inc(i);
a[i].x:=x*2; a[i].y:=y*11; inc(i);
a[i].x:=x*3; a[i].y:=y*10; inc(i);
a[i].x:=x*2; a[i].y:=y*9; inc(i);
a[i].x:=x*2; a[i].y:=y*4; inc(i);
a[i].x:=x*3; a[i].y:=y*4; inc(i);
a[i].x:=x*5; a[i].y:=y*9; inc(i);
a[i].x:=x*13; a[i].y:=y*6; inc(i);
a[i].x:=x*13; a[i].y:=y*3; inc(i);
a[i].x:=x*14; a[i].y:=y*3; inc(i);
a[i].x:=x*17; a[i].y:=y*6; inc(i);
a[i].x:=x*22; a[i].y:=y*7; inc(i);
a[i].x:=x*24; a[i].y:=y*8; inc(i);
a[i].x:=x*25; a[i].y:=y*10; inc(i);
a[i].x:=x*29; a[i].y:=y*11; inc(i);
k:=i;
i:=1;
b[i].x:=x*22; b[i].y:=y*9; inc(i);
b[i].x:=x*22; b[i].y:=y*10; inc(i);
b[i].x:=x*23; b[i].y:=y*10; inc(i);
b[i].x:=x*22; b[i].y:=y*9; inc(i);
SetColor(5);
SetLineStyle(0,1,3);
DrawPoly(k,a);
DrawPoly(i,b);
ReadKey;
end.
0
Quatroom
3 / 3 / 0
Регистрация: 12.10.2009
Сообщений: 47
17.03.2010, 18:03 #37
Вот божья коровка:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
program gra;
uses crt,Graph;
var
Gd, Gm: Integer;
x, y: real;
px,pa,py,i,q,a,t:integer;
begin
     clrscr;
     Gd := Detect;
     InitGraph(Gd, Gm, '');
     ellipse(100,90, 0, 360, 40, 60);
     circle(100,145,20);
     line(141,90,156,90);
     line(156,90,171,95);
     line(135,60,150,60);
     line(150,60,171,65);
     line(135,120,150,120);
     line(150,120,171,125);
     line(60,90,35,90);
     line(35,90,20,95);
     line(41,60,65,60);
     line(41,60,25,65);
     line(65,120,40,120);
     line(40,120,25,125);
     circle(80,100,5);
     circle(80,120,5);
     circle(90,90,5);
     circle(80,70,5);
     circle(110,70,5);
     circle(100,50,5);
     circle(120,100,5);
     circle(120,80,5);
     circle(90,155,2);
     circle(110,155,2);
     readln ;
     closegraph;
end.
0
yura`
11 / 8 / 0
Регистрация: 09.02.2010
Сообщений: 107
17.03.2010, 18:04 #38
Красивая красная розочка:


Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Uses Graph,MyGraph,Crt;
Var i,x,y,j,x0,y0:integer;
f,df:real;
a,b: array[1..30] of Pointtype;
Const r=150; n=6;
 
begin
Init;
j:=1;
f:=0;
x0:=GetMaxX div 2;
y0:=GetMaxY div 2;
SetColor(4);
df:=2*Pi/n;
For i:=1 to n+1 do
begin{2}
x:=x0+Round(r*cos(f));
y:=y0-Round(r*sin(f));
a[i].x:=x; a[i].y:=y;
f:=f+df;
end{2};
Circle(x0,y0,r);
Arc(a[1].x,a[1].y,a[1].x+11,a[1].x+120+11,r);
Arc(a[2].x,a[2].y,a[2].x+120+26,a[2].x+240+26,r);
Arc(a[3].x,a[3].y,a[3].x+360-4,a[3].x+480-4,r);
Arc(a[4].x,a[4].y,a[4].x+840+11,a[4].x+960+11,r);
Arc(a[5].x,a[5].y,a[5].x+480-4,a[5].x+600-4,r);
Arc(a[6].x,a[6].y,a[6].x+26,a[6].x+120+26,r);
Readln;
CloseGraph;
end.
0
ateccc
0 / 0 / 0
Регистрация: 30.01.2010
Сообщений: 10
27.03.2010, 11:00 #39
Есть собственная разработка лабораторной работы по физике на паскале с имитацией процесса с помощью графики. Если интересно могу кинуть... правда она без коментов.
0
Puporev
Модератор
52389 / 40236 / 13575
Регистрация: 18.05.2008
Сообщений: 92,996
27.03.2010, 11:21 #40
ateccc, Давай показывай, комментарии не обязательно, просто в начале напиши подробное условие задачи.
1
ateccc
0 / 0 / 0
Регистрация: 30.01.2010
Сообщений: 10
31.03.2010, 00:35 #41
Выкладываю архив с лабой по физике.
Условие задачи следующее.

По обе стороны обевращающегося вала подвешено 2 гирьки с разной массой(точно не помню какой у нас был вес) которые соеденены между собой нерозтяжной(по условии) нитью. Тело с большей массой поднимают на определенную высоту и отпускают, задача найти его ускорение.

Это вкратце - деталей не пню так как прога писалась 4 года назад.

Структура моей проги довольно сложная - используется много разных процедур, и писалась она еще обычном редакторе Паскаля(под дос) потому в архиве и есть кейрус.
Прделагаю сделать полный розбор полета - найдете много полезных готовых процедур который можно разобрать...и и спользовать в своих прогах.


завтра буду на работе и подробно отпишу.... так как сейчас нет времени

юзайте на здоровье!!!
0
ateccc
0 / 0 / 0
Регистрация: 30.01.2010
Сообщений: 10
31.03.2010, 11:52 #42
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure slrkur(kur:boolean);
var reg:Registers;
    lang:longint;
begin
reg.ah:=1;
if kur then begin
   if lang=$b800 then begin
   reg.ch:=6;
   reg.cl:=7;
   end
   else begin
   reg.ch:=12;
   reg.cl:=13;
   end;
   Intr(16,reg);
   end
   else begin
   reg.ch:=32;
   reg.cl:=7;
   Intr(16,reg);
   end;
   end;
Данная процедура делает невидимым либо же видимым курсор в зависимости от значения переменной kur:boolean (false or true).
0
Puporev
Модератор
52389 / 40236 / 13575
Регистрация: 18.05.2008
Сообщений: 92,996
31.03.2010, 12:05 #43
ateccc, Я так понял, это для текстового режима?
0
ateccc
0 / 0 / 0
Регистрация: 30.01.2010
Сообщений: 10
31.03.2010, 12:14 #44
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure box(x1,y1,x2,y2: integer; color:byte);
var k:integer;
begin
textcolor(color);
GotoXY(x1,y1);write(#201);
For k:=x1+1 to x2-1 do write(#205);
write(#187);
For k:=y1+1 to y2-1 do begin
GotoXY(x1,k);write(#186);
GotoXY(x2,k);write(#186);
                       end;
GotoXY(x1,y2);write(#200);
for k:=x1+1 to x2-1 do write(#205);
write(#188);
end;
Рисуем рамку с координатами x1,x2,y1,y2 и цветом color
x1,x2 - координаты левого верхнего угла;
y1,y2 - координаты правого нижнего угла;
Пример:
Pascal
1
box(3,3,33,9,7);
не забивайте это все еще текстовой режим !!!

Добавлено через 2 минуты
Цитата Сообщение от Puporev Посмотреть сообщение
ateccc, Я так понял, это для текстового режима?
Да все верно!
0
Puporev
Модератор
52389 / 40236 / 13575
Регистрация: 18.05.2008
Сообщений: 92,996
31.03.2010, 12:20 #45
Да все верно!
Но в графическом режиме курсор не видим, а от этой процедуры он все рано не покажется.
А в текстовом хорошо работает. А то есть только стандартный способ уменьшить его до минимальных размеров.
0
31.03.2010, 12:20
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
31.03.2010, 12:20
Привет! Вот еще темы с ответами:

Графика в Турбо Паскаль. Нарисовать телефон - Turbo Pascal
Кто может нарисовать такое??

Графика в Турбо Паскаль. Нарисовать мобильный телефон - Turbo Pascal
Помогите написать графику.Нужно нарисовать мобильный телефон

Графика в Турбо Паскаль. Нарисовать флаг Македонии - Turbo Pascal
Помогите пожалуста, нужно нарисовать флаг Македонии у паскале.

Графика в Турбо Паскаль. Разносторонний треугольник, вращающийся вокруг центра тяжести - Turbo Pascal
Изобразить на экране разносторонний треугольник, вращающийся вокруг центра тяжести в плоскости экрана. Центр тяжести это точка...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
45
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru