0 / 0 / 0
Регистрация: 13.02.2011
Сообщений: 71
1

Дорисовать руки человечку

12.05.2011, 09:48. Показов 880. Ответов 1
Метки нет (Все метки)

надо добавить руки человечку...

программа

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
uses crt, man;
 
var key: char;
    d: word;
    color: word;
 
begin
  ClrScr;
  WriteLn('ЃҐЈ / е®¤мЎ  (b/i)');  ReadLn(key);
  if UpCase(key) = 'B' then
  begin
    d := 15;
    color := 1;
  end;
  if UpCase(key) = 'I' then
  begin
    d := 150;
    color := 2;
  end;
  InitGraphMode;
  Draw(d, color);
  ReadLn;
end.

модуль
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
unit man;
 
interface
uses crt,graph;
 
    procedure InitGraphMode;
    procedure Draw(d: word; color: word);
 
implementation
 
  procedure InitGraphMode;
  var gd,gm:integer;
  begin
    gd:=vga;gm:=2;
    initgraph(gd,gm,'');
  end;
 
  procedure Draw(d: word; color: word);
  var x,y: integer;
    size:word;
    p1,p2:pointer;
  begin
    size:=ImageSize(0,0,20,100);{размер области}
    setlinestyle(0,0,3);
   {первый образ}      SetColor(color)   ;
    pieslice(10,10,0,360,10);
    fillellipse(10,40,10,20);
    line(8,60,0,100);line(12,60,20,100);
    {второй образ}          SetColor(color);
    pieslice(60,10,0,360,10);
    fillellipse(60,40,10,20);
    line(60,60,60,100);
    getmem(p1,size);
    getimage(0,0,20,100,p1^);
    getmem(p2,size);
    getimage(50,0,70,100,p2^);
    cleardevice;
    x:=0;y:=200;
    line(0,300,640,300);
 
    repeat
      putimage(x,y,p1^,1);
      delay(d);
      putimage(x,y,p1^,1);
      putimage(x,y,p2^,1);
      delay(d);
      putimage(x,y,p2^,1);
      x:=x+10;
    until x>getmaxX-20;
 
    freemem(p1,size);
    freemem(p2,size);
 
  end;
 
 
 
end.
Добавлено через 1 час 44 минуты
ещё надо цвет фона в МОДУЛЕ поменять на белый
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
12.05.2011, 09:48
Ответы с готовыми решениями:

Дорисовать снеговика
Вот к этой программке нужно что-то..елочку например..дорисовать снеговика..выручайте.графику вообще...

Дорисовать рисунок путем добавления двух дуг
Program lr; uses graph,crt; var graphmode, graphdriver, errorcode: integer; begin...

Покер. Расчёт эквити руки vs руки(диапазон)
Никаких примеров подобных алгоритмов на делфи в инете не нашёл, поэтому решил написать сам. ...

По данным таблицы посчитать, у скольких женщин показатель для левой руки больше показателя для правой руки

1
Почетный модератор
64254 / 47554 / 32739
Регистрация: 18.05.2008
Сообщений: 115,182
12.05.2011, 13:21 2
Вот поправил, при ходьбе более-мене, бег плохо. Вообще нужно рисовать не 2, а три фазы движения и отдельно для бега и ходьбы, при беге ноги сгибаются в колене, а руки в локте.
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
unit man;
 
interface
uses crt,graph;
 
procedure InitGraphMode;
procedure Draw(d: word; color: word);
 
implementation
 
procedure InitGraphMode;
var gd,gm:integer;
begin
gd:=vga;gm:=2;
initgraph(gd,gm,'');
setbkcolor(15);
end;
 
procedure Draw(d: word; color:word);
var x,y: integer;
    size:word;
    p1,p2:pointer;
begin
size:=ImageSize(0,0,60,100);
setlinestyle(0,0,3);
SetColor(color);
{тело}
pieslice(30,10,0,360,10);
fillellipse(30,40,10,20);
{ноги}
line(28,60,18,100);
line(32,60,40,100);
{руки}
line(38,28,60,55);
line(30,28,10,60);
 
SetColor(color);
pieslice(100,10,0,360,10);
fillellipse(100,40,10,20);
line(100,60,100,100);
line(100,28,100,55);
 
getmem(p1,size);
getimage(0,0,60,100,p1^);
getmem(p2,size);
getimage(63,0,123,100,p2^);
cleardevice;
x:=0;y:=200;
line(0,300,640,300);
repeat
 putimage(x,y,p1^,1);
 delay(d);
 putimage(x,y,p1^,1);
 putimage(x,y,p2^,1);
 delay(d);
 putimage(x,y,p2^,1);
 x:=x+10;
until x>getmaxX-20;
 
freemem(p1,size);
freemem(p2,size);
 
end;
 
end.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
12.05.2011, 13:21
Помогаю со студенческими работами здесь

Дорисовать проект
Нужно дорисовать в pascal abc. Тут нарисована ракета . Нужно еще нарисовать звезды и планету (чтоб...

Дорисовать ёлку!
Нужен домик и ёлка, вот есть домик, как туда добавить ёлку: uses graphABC; var x1,y1,x2,y2,i,j:...

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

Дорисовать кубик рубик
Господа требуется через canvas на форме нарисовать кубик рубик Лицевую часть сделал, а вот боковую...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru