Анимации на Pascal ABC.NET

@bogdasin123 · Регистрация: 25.03.2017

Студворк — интернет-сервис помощи студентам

В чем может быть проблема ? Когда нажимаю на клавиши машина перемещаеться, но все линии не успевают перерисоваться и заливаеться вся страница.

Вот листинг :

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
uses GraphABC ; 
  var
    dx , dy : integer ;  
  
 procedure KeyDown( key : integer ) ; 
 begin 
  case key of 
      VK_Up : dx := - 80 ;
    VK_Down : dx := + 80 ;
    VK_Left : dy := - 50 ; 
   VK_Right : dy :=  + 50
   end;
  end;
  begin
  
  SetWindowIsFixedSize( true );  
  SetWindowSize( 800 , 640 );   
    
  LockDrawing ;
     repeat 
     clearwindow;
   line (200 , 638 , 200, 0  );
   line (600 , 638 , 600, 0  ); 
   line (200 , 638 , 600 , 638 ) ;
   line (200 , 0 , 600 , 0 ) ; 
  
   line (355  , 182 , 355 , 000 ) ;
   line (355 , 000 , 415 , 000 ) ;
   line (415 , 000 , 415 , 182 ) ;
   line (415 , 182 , 355 , 182 ) ;
    
  line ( 323 + dy , 313 + dx , 323 + dy, 527 + dx) ;
  line ( 323 + dy, 372 + dx, 302 + dy, 377 + dx) ;
  line ( 302 + dy, 377 + dx, 302 + dy, 382 + dx) ;
  line ( 302 + dy, 382 + dx, 323 + dy, 377 + dx) ;
  arc ( 392 + dy, 470 + dx, 90 , 220 , 320 ) ;
  line ( 461 + dy, 528 + dx, 461 + dy, 313 + dx) ; 
  line ( 461 + dy, 372 + dx, 482 + dy, 376 + dx) ;//
  line ( 482 + dy, 376 + dx, 480 + dy, 382 + dx) ;
  line ( 480 + dy, 382 + dx, 461 + dy, 381 + dx) ; 
  arc ( 365 + dy, 340 + dx, 50 , 145 , 110 ) ;
  line ( 347 + dy, 293 + dx, 430 + dy, 293 + dx) ; 
  arc ( 422 + dy, 343 + dx, 50 , 90 , 38 ) ;
  rectangle (358 + dy, 403 + dx, 425 + dy, 428 + dx) ;
   arc ( 390 + dy, 543 + dx, 190 , 108 , 72 ) ;
   line ( 331 + dy, 362 + dx, 348 + dy, 394 + dx) ; 
   line ( 348 + dy, 394 + dx, 434 + dy, 394 + dx); 
   line ( 434 + dy, 394 + dx, 448 + dy, 362 + dx) ;
   line ( 323 + dy, 434 + dx, 338 + dy, 437 + dx) ;
   line ( 338 + dy, 437 + dx, 336 + dy, 397 + dx) ; 
   line ( 336 + dy, 397 + dx, 323 + dy, 378 + dx) ; 
   line ( 338 + dy, 437 + dx, 338 + dy, 482 + dx ) ; 
   line ( 338 + dy, 482 + dx, 323 + dy, 483 + dx) ; 
   
   line ( 461 + dy, 436 + dx, 445 + dy, 439 + dx) ; 
   line ( 445 + dy, 439 + dx, 444 + dy, 398 + dx) ; 
   line ( 444 + dy, 398 + dx, 461 + dy, 381 + dx) ;
   line ( 445 + dy, 439 + dx, 445 + dy, 481 + dx) ; 
   line ( 445 + dy, 481 + dx, 461 + dy, 481 + dx) ;
    
   arc ( 392 + dy, 360 + dx, 160 , 250 , 288 ) ;
   arc ( 392 + dy, 340 + dx, 160 , 253 , 286 ) ;
   line ( 345 + dy, 493 + dx, 338 + dy, 510 + dx) ; 
   line ( 436 + dy, 493 + dx, 441 + dy, 512 + dx) ;
   
   line ( 318 + dy, 484 + dx, 323+ dy, 483 + dx) ; 
   line ( 318 + dy, 484 + dx, 318+ dy , 520 + dx) ; 
   line ( 318 + dy, 520 + dx, 323+ dy , 520 + dx) ; 
   
   line ( 461 + dy, 482 + dx, 466+ dy, 483 + dx) ; 
   line ( 461 + dy, 484 + dx, 461+ dy , 520 + dx) ; 
   line ( 461 + dy, 520 + dx, 466+ dy , 520 + dx) ; 
   line ( 466 + dy, 483 + dx, 466+ dy , 520 + dx) ; 
    
   line ( 323 + dy, 333 + dx, 317+ dy , 333 + dx) ; 
   line ( 317 + dy, 333 + dx, 317+ dy , 370 + dx) ;
   line ( 317 + dy, 370 + dx, 323+ dy , 370 + dx) ; 
   
  
   line ( 461 + dy, 334 + dx, 467+ dy , 335 + dx)  ;
   line ( 467 + dy, 335 + dx, 467+ dy , 368 + dx) ; 
   line ( 467 + dy, 368 + dx, 461+ dy , 368 + dx) ; 
   
    arc ( 311 + dy, 269 + dx, 50 , 285 , 330 ) ;
    arc ( 473 + dy, 270 + dx, 50 , 210 , 255 ) ; 
   
   floodFill ( 270 + dy, 149 + dx, cllightgray ) ;
   floodFill ( 380 + dy, 314 + dx, clRed ) ; 
   floodFill ( 336 + dy, 305 + dx, clYellow ) ; 
   floodFill ( 446 + dy, 308 + dx, clYellow ) ; 
   floodfill ( 390 + dy, 379 + dx, cldeepSkyBlue ); 
   Floodfill ( 332 + dy, 421 + dx, cldeepSkyBlue );
   FloodFill ( 329 + dy, 465 + dx, cldeepSkyBlue );
   FloodFill ( 385 + dy, 511 + dx, cldeepSkyBlue );
   floodFill ( 450 + dy, 420 + dx, cldeepSkyBlue );
   FloodFill ( 450 + dy, 450 + dx, cldeepSkyBlue );
   Floodfill ( 365 + dy, 411 + dx, clblack ) ; 
   floodFill ( 320 + dy, 357 + dx, clblack ) ; 
   FloodFill ( 320 + dy, 505 + dx, clblack ) ; 
   FloodFill ( 464 + dy, 500 + dx, clblack ) ;
   FloodFill ( 463 + dy, 349 + dx, clblack ) ; 
   FloodFill ( 311 + dy, 377 + dx, clred ) ; 
   FloodFill ( 470 + dy, 377 + dx, clred ) ;  
  
  RedRaw ;
   OnKeyDown := KeyDown ;
   until False ;
  end.

@volvo · 17.06.2017, 11:43

Читай комментарии к коду. Особенно в 111-ой строке.

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
uses GraphABC ; 
var
  dx, dy: integer;
  changed: boolean := true; // Делаем раз
 
procedure KeyDown(key: integer ) ;
begin
  case key of 
    VK_Up: begin dx := -80;changed := true end; // Тут изменяем Changed 
    VK_Down: begin dx := +80;changed := true end;
    VK_Left: begin dy := -50;changed := true end;
    VK_Right: begin dy := +50;changed := true end
  end;
end;
 
begin
  OnKeyDown := KeyDown;
  SetWindowIsFixedSize(true );  
  SetWindowSize(800, 640 );   
  
  LockDrawing;
  repeat
    if changed then // перерисовываем только если были изменения
    begin
      clearwindow;
      line(200, 638, 200, 0  );
      line(600, 638, 600, 0  ); 
      line(200, 638, 600, 638 );
      line(200, 0, 600, 0 ); 
      
      line(355, 182, 355, 000 );
      line(355, 000, 415, 000 );
      line(415, 000, 415, 182 );
      line(415, 182, 355, 182 );
      
      line(323 + dy, 313 + dx, 323 + dy, 527 + dx);
      line(323 + dy, 372 + dx, 302 + dy, 377 + dx);
      line(302 + dy, 377 + dx, 302 + dy, 382 + dx);
      line(302 + dy, 382 + dx, 323 + dy, 377 + dx);
      
      arc(392 + dy, 470 + dx, 90, 220, 320 );
      line(461 + dy, 528 + dx, 461 + dy, 313 + dx); 
      line(461 + dy, 372 + dx, 482 + dy, 376 + dx);//
      line(482 + dy, 376 + dx, 480 + dy, 382 + dx);
      line(480 + dy, 382 + dx, 461 + dy, 381 + dx); 
      
      arc(365 + dy, 340 + dx, 50, 145, 110 );
      line(347 + dy, 293 + dx, 430 + dy, 293 + dx); 
      arc(422 + dy, 343 + dx, 50, 90, 38 );
      rectangle(358 + dy, 403 + dx, 425 + dy, 428 + dx);
      arc(390 + dy, 543 + dx, 190, 108, 72 );
      line(331 + dy, 362 + dx, 348 + dy, 394 + dx); 
      line(348 + dy, 394 + dx, 434 + dy, 394 + dx); 
      line(434 + dy, 394 + dx, 448 + dy, 362 + dx);
      line(323 + dy, 434 + dx, 338 + dy, 437 + dx);
      line(338 + dy, 437 + dx, 336 + dy, 397 + dx); 
      line(336 + dy, 397 + dx, 323 + dy, 378 + dx); 
      line(338 + dy, 437 + dx, 338 + dy, 482 + dx ); 
      line(338 + dy, 482 + dx, 323 + dy, 483 + dx); 
      
      line(461 + dy, 436 + dx, 445 + dy, 439 + dx); 
      line(445 + dy, 439 + dx, 444 + dy, 398 + dx); 
      line(444 + dy, 398 + dx, 461 + dy, 381 + dx);
      line(445 + dy, 439 + dx, 445 + dy, 481 + dx); 
      line(445 + dy, 481 + dx, 461 + dy, 481 + dx);
      
      arc(392 + dy, 360 + dx, 160, 250, 288 );
      arc(392 + dy, 340 + dx, 160, 253, 286 );
      line(345 + dy, 493 + dx, 338 + dy, 510 + dx); 
      line(436 + dy, 493 + dx, 441 + dy, 512 + dx);
      
      line(318 + dy, 484 + dx, 323 + dy, 483 + dx); 
      line(318 + dy, 484 + dx, 318 + dy, 520 + dx); 
      line(318 + dy, 520 + dx, 323 + dy, 520 + dx); 
      
      line(461 + dy, 482 + dx, 466 + dy, 483 + dx); 
      line(461 + dy, 484 + dx, 461 + dy, 520 + dx); 
      line(461 + dy, 520 + dx, 466 + dy, 520 + dx); 
      line(466 + dy, 483 + dx, 466 + dy, 520 + dx); 
      
      line(323 + dy, 333 + dx, 317 + dy, 333 + dx); 
      line(317 + dy, 333 + dx, 317 + dy, 370 + dx);
      line(317 + dy, 370 + dx, 323 + dy, 370 + dx); 
      
      
      line(461 + dy, 334 + dx, 467 + dy, 335 + dx);
      line(467 + dy, 335 + dx, 467 + dy, 368 + dx); 
      line(467 + dy, 368 + dx, 461 + dy, 368 + dx); 
      
      arc(311 + dy, 269 + dx, 50, 285, 330 );
      arc(473 + dy, 270 + dx, 50, 210, 255 ); 
      
      floodFill(270 + dy, 149 + dx, cllightgray );
      floodFill(380 + dy, 314 + dx, clRed ); 
      floodFill(336 + dy, 305 + dx, clYellow ); 
      floodFill(446 + dy, 308 + dx, clYellow ); 
      floodfill(390 + dy, 379 + dx, cldeepSkyBlue ); 
      Floodfill(332 + dy, 421 + dx, cldeepSkyBlue );
      FloodFill(329 + dy, 465 + dx, cldeepSkyBlue );
      FloodFill(385 + dy, 511 + dx, cldeepSkyBlue );
      floodFill(450 + dy, 420 + dx, cldeepSkyBlue );
      FloodFill(450 + dy, 450 + dx, cldeepSkyBlue );
      Floodfill(365 + dy, 411 + dx, clblack ); 
      floodFill(320 + dy, 357 + dx, clblack ); 
      FloodFill(320 + dy, 505 + dx, clblack ); 
      FloodFill(464 + dy, 500 + dx, clblack );
      FloodFill(463 + dy, 349 + dx, clblack ); 
      FloodFill(311 + dy, 377 + dx, clred ); 
      FloodFill(470 + dy, 377 + dx, clred );  
      
      FloodFill(360, 100, clWhite); // Вот она, магия !!!
      SetBrushColor(clWhite);
      RedRaw;
      changed := false; // объект перерисован, возвращаем Changed в False
    end
    
  until False;
end.

@Puporev · 17.06.2017, 12:26

Что-то сколько ни смотрел разницы с этими строками

Pascal
1
2
 FloodFill(360, 100, clWhite); // Вот она, магия !!!
 SetBrushColor(clWhite);

и без них не заметил.

@volvo · 17.06.2017, 12:28

Без них есть кратковременное мигание красным цветом всего графического окна, с ними - нет.

@Puporev · 17.06.2017, 12:38

Странно, у меня такого нет, правда 1 раз мигнуло голубым в сером поле...

Новые блоги и статьи Все статьи Все блоги /
Звёздная пыль kumehtar 20.06.2025 Я просто это себе представляю: как создавался этот мир. Как энергия слипалась в маленькие частички. Как они собирались в первые звёзды, как во вселенной впервые появился Свет. Как эти звёзды. . .	Создание нейросети с PyTorch AI_Generated 19.06.2025 Ключевое преимущество PyTorch — его питоновская натура. В отличие от TensorFlow, который изначально был построен как статический вычислительный граф, PyTorch предлагает динамический подход. Это. . .	JWT аутентификация в ASP.NET Core UnmanagedCoder 18.06.2025 Разрабатывая веб-приложения, я постоянно сталкиваюсь с дилеммой: как обеспечить надежную аутентификацию пользователей без ущерба для производительности и масштабируемости? Классические подходы на. . .	Краткий курс по С# aaLeXAA 18.06.2025 Здесь вы найдете все необходимые функции чтоб написать програму на C# Задание 1: КЛАСС FORM 1 public partial class Form1 : Form { Spisok listin = new Spisok(); . . .	50 самых полезных примеров кода Python для частых задач py-thonny 17.06.2025 Эффективность работы разработчика часто измеряется не количеством написаных строк, а скоростью решения задач. Готовые сниппеты значительно ускоряют разработку, помогают избежать типичных ошибок и. . .
C# и продвинутые приемы работы с БД stackOverflow 17.06.2025 Каждый . NET разработчик рано или поздно сталкивается с ситуацией, когда привычные методы работы с базами данных превращаются в источник бессонных ночей. Я сам неоднократно попадал в такие ситуации,. . .	Angular: Вопросы и ответы на собеседовании Reangularity 15.06.2025 Готовишься к техническому интервью по Angular? Я собрал самые распространенные вопросы, с которыми сталкиваются разработчики на собеседованиях в этом году. От базовых концепций до продвинутых. . .	Архитектура Onion в ASP.NET Core MVC stackOverflow 15.06.2025 Что такое эта "луковая" архитектура? Термин предложил Джеффри Палермо (Jeffrey Palermo) в 2008 году, и с тех пор подход только набирал обороты. Суть проста - представьте себе лук с его. . .	Unity 4D GameUnited 13.06.2025 Четырехмерное пространство. . . Звучит как что-то из научной фантастики, правда? Однако для меня, как разработчика со стажем в игровой индустрии, четвертое измерение давно перестало быть абстракцией из. . .	SSE (Server-Sent Events) в ASP.NET Core и .NET 10 UnmanagedCoder 13.06.2025 Кажется, Microsoft снова подкинула нам интересную фичу в новой версии фреймворка. Работая с превью . NET 10, я наткнулся на нативную поддержку Server-Sent Events (SSE) в ASP. NET Core Minimal APIs. Эта. . .

@volvo Супер-модератор 33149 / 21441 / 8223 Регистрация: 22.10.2011 Сообщений: 36,773 Записей в блоге: 9
	17.06.2017, 12:28
	Без них есть кратковременное мигание красным цветом всего графического окна, с ними - нет. 0

@Puporev Почетный модератор 64312 / 47609 / 32742 Регистрация: 18.05.2008 Сообщений: 115,181
	17.06.2017, 12:38
	Странно, у меня такого нет, правда 1 раз мигнуло голубым в сером поле... 0

Опции темы