Программа


Program Kolobok;
{ Колобок идет от домика
  с зонтиком, навстречу
  тучка, при встрече идет
  дождь, нажатием на кнопку
  открываем зонт }
Uses
  Graph,Crt;
Const
  DriverPath=''; { Путь к графическому драйверу }
Var
  GraphDriver,GraphMode:integer; { Графический драйвер и режим }
  i:integer; { Служебный счетчик }

  XColob,dxLeftFoot,dxRightFoot:integer;
  { Координата  X и относительное смещение ножек колобка }
  umbrella,aFootColob:boolean;
  { umbrella   - флаг зонта открыт/закрыт
    aFootColob - служебный флаг для управления движения ногами колобка
                 true - если правая нога идет вперед }
  Ch:char;  { используется при обработке клавиатуры }

  XCloud:integer;  { Координата X тучи }
  Rain:boolean;    { Флаг дождя }

Procedure ColobDriwer;    { Прорисовка колобка по текущей координате X
                            в неактивной видео странице }
  Var
    Y,h,w:integer;  { Координата Y коловка, полувысота и полуширина колобка }
    yRightFoot,yLeftFoot:integer;
    { Относительные координаты высоты ножек колобка }
  Begin
    Y:=Round(0.8*GetMaxY); { Координата Y в долях высоты экрана }
    h:=Round(0.1*GetMaxY); { Полувысота колобка в долях высоты экрана }
    w:=Round(0.05*GetMaxX);{ Полуширина колобка в долях ширины экрана }
    SetViewPort(XColob-w,Y-h,XColob+Round(2*w),Y+h,false);
    { Открытие окна под колобка }
    SetColor(White); { Выбор белого цвета  под контур фигур }
    SetFillStyle(CloseDotFill,White);
    { Выбор орнамента заполнения - частые точки, белый цвет }
    Bar(0,0,Round(3*w),2*h);
    { Закрашивание области со старым колобком под цвет фона (частые точки) }
    SetFillStyle(SolidFill,White);
    { Выбор орнамента заполнения - однородное зополнение цветом, цвет белый }
    PieSlice(w,Round(1.3*h),0,360,20); { Прорисовка головы }
    SetColor(Black); { Выбор цвета под контур фигур - черный }
    if Rain and not umbrella then begin
    { Если идет дождь и закрыт }    SetLineStyle(SolidLn,0,NormWidth);
    { зонт, то колобок грустный }   { Выбор сплошной линии нормальной ширины }
                                    Arc(w,Round(1.65*h),35,145,10)
                                    { Прорисовка грустного рта }
                                  end
                             else begin
                                    SetLineStyle(SolidLn,0,ThickWidth);
                                    { Выбор сплошной толстой линии }
                                    Arc(w,Round(1.3*h),225,315,10)
                                    { Прорисовка веселого рта }
                                  end;
    SetLineStyle(SolidLn,0,NormWidth);
    { Выбор сплошной линии нормальной ширины }
    if dxLeftFoot=0 then  { Хлопанье глазами с интервалом в один шаг }
                      begin
                        SetColor(Black);
                        { Выбор цвета под контур фигур - черный }
                        Line(Round(0.63*w),Round(1.2*h),
                             Round(0.87*w),Round(1.2*h)); { Левый глаз }
                        Line(Round(1.13*w),Round(1.2*h),
                             Round(1.37*w),Round(1.2*h))  { Правый глаз }
                      end
                    else
                      begin
                        SetColor(Black);
                        { Выбор цвета под контур фигур - черный }
                        SetFillStyle(SolidFill,Black);
                        { Выбор орнамента заполнения -
                          - однородное зополнение цветом, цвет черный }
                        PieSlice(Round(0.75*w),Round(1.2*h),0,360,4);
                        { Левый глаз }
                        PieSlice(Round(1.25*w),Round(1.2*h),0,360,4)
                        { Правый глаз }
                      end;
    SetLineStyle(SolidLn,0,ThickWidth);{ Выбор сплошной толстой линии }
    if abs(dxRightFoot)>0.015*GetMaxY then aFootColob:=not aFootColob;
   { Смена флага движения ног при достижении правой ногой крайнего положения }
    if aFootColob then begin { Пересчет координат ног в заваисимости от
                               состояния флага }
                         dxRightFoot:=dxRightFoot+1; { Правая идет вперед }
                         dxLeftFoot:=dxLeftFoot-1;   { Левая - назад }
                         yRightFoot:=Round(1.59*h);  { Правая приподнята }
                         yLeftFoot:=Round(1.65*h)    { относительно левой }
                       end
                  else begin
                         dxRightFoot:=dxRightFoot-1; { Правая - назад }
                         dxLeftFoot:=dxLeftFoot+1;   { Левая - вперед }
                         yLeftFoot:=Round(1.59*h);   { Левая приподнята }
                         yRightFoot:=Round(1.65*h)   { относительно правой }
                       end;
    SetColor(White); { Выбор белого цвета  под контур фигур }
    Line(w+dxRightFoot,yRightFoot,w+dxRightFoot,yRightFoot+Round(0.23*h));
    { Правая нога }
    Line(w+dxRightFoot,yRightFoot+Round(0.23*h),
         Round(1.2*w)+dxRightFoot,yRightFoot+Round(0.23*h)); { Правая ступня }
    Line(w+dxLeftFoot,yLeftFoot,w+dxLeftFoot,yLeftFoot+Round(0.23*h));
    { Левая нога }
    Line(w+dxLeftFoot,yLeftFoot+Round(0.23*h),
    Round(1.2*w)+dxLeftFoot,yLeftFoot+Round(0.23*h)); { Левая ступня }
    Line(Round(1.5*w),Round(1.3*h),Round(1.7*w),Round(1.3*h)); { Рука }
    Line(Round(1.7*w),Round(1.3*h),Round(1.7*w),Round(0.05*h));
    { Палка от зонтика }
    if umbrella then begin
                       Line(Round(1.7*w),Round(0.05*h),
                            Round(3*w),Round(0.2*h));
                       { Правый скат открытого зонтика }
                       Line(Round(1.7*w),Round(0.05*h),
                            Round(0.4*w),Round(0.2*h))
                       { Левый скат открытого зонтика }
                     end
                else begin
                       Line(Round(1.7*w),Round(0.05*h),
                            Round(1.9*w),Round(0.9*h));
                       { Правый скат закрытого зонтика }
                       Line(Round(1.7*w),Round(0.05*h),
                            Round(1.5*w),Round(0.9*h));
                       { Левый скат закрытого зонтика }
                     end;
  End;

Procedure CloudDriver;  { Прорисовка тучи и дождя в неактивной видеостранице }
  Var
    Y,h,w:integer; { Координата Y,полувысота и полуширина тучи }
  Begin
    Y:=Round(0.15*GetMaxY); { Координата Y в долях высоты экрана }
    h:=Round(0.1*GetMaxY);  { Полувысота тучи в долях высоты экрана }
    w:=Round(0.12*GetMaxX); { Полуширина тучи в долях ширины экрана }
    SetViewPort(XCloud-w-2,Y-h,XCloud+w,Round(0.69*GetMaxY),true);
    { Открытие окна под тучу и дождь }
    SetFillStyle(WideDotFill,White);
    { Выбор орнамента заполнения - редкие точки, белый цвет }
    Bar(0,0,2*w+2,Round(GetMaxY/2)-Y+h);
    SetFillStyle(CloseDotFill,White);
    { Выбор орнамента заполнения - частые точки, белый цвет }
    Bar(0,Round(GetMaxY/2)-Y+h,2*w+2,Round(0.7*GetMaxY));
    { Востановление фона неба }
    SetColor(White); { Выбор белого цвета  под контур фигур }
    SetLineStyle(SolidLn,0,NormWidth);
    { Выбор сплошной линии, нормальной толщины }
    Line(0,Round(GetMaxY/2)-Y+h,2*w+2,Round(GetMaxY/2)-Y+h);
    { Востановление горизонта }
    SetFillStyle(InterleaveFill,White);
    { Выбор орнамента заполнения - частая сетка, белый цвет }
    FillEllipse(w,h,w,h); { Облако }
    if Rain then  { Если идет дождь, то прорисовка дождя }
      begin
        SetFillStyle(LtSlashFill,White);
        { Выбор орнамента заполнения - ///, белый цвет }
        Bar(0,h,2*w,Round(0.7*GetMaxY)) { Дождь }
      end;
  End;
BEGIN
  GraphDriver:=Detect; { Автоматическое определение графического драйвера }
  InitGraph(GraphDriver,GraphMode,DriverPath); { Инициализация графики }
  if GetMaxMode>0 then SetGraphMode(1) { Режим VGAMed, EGAHi }
                  else SetGraphMode(0);{ Наименее емкий режим для любого
                                         адаптера }
  SetVisualPage(0); { Установка нулевой страницы отображаемой }
  for i:=0 to 1 do  { Прорисовка фона на двух страницах }
    Begin
      SetActivePage(i); { Установка активной страницы }
      SetFillStyle(XHatchFill,White);
      { Выбор орнамента заполнения - косая клетка, белый цвет }
      SetColor(White); { Выбор белого цвета  под контур фигур }
      Bar(Round(0.04*GetMaxX),Round(0.7*GetMaxY),
      Round(0.21*GetMaxX),Round(0.9*GetMaxY)); { Сруб дома }
      Rectangle(Round(0.04*GetMaxX),Round(0.7*GetMaxY),
      Round(0.21*GetMaxX),Round(0.9*GetMaxY)); { Контур сруба }
      SetFillStyle(SolidFill,Black);
      { Выбор орнамента заполнения - однородный цвет, черный }
      Bar(Round(0.09*GetMaxX),Round(0.77*GetMaxY),
      Round(0.16*GetMaxX),Round(0.83*GetMaxY)); { Окно }
      Rectangle(Round(0.09*GetMaxX),Round(0.77*GetMaxY),
      Round(0.16*GetMaxX),Round(0.83*GetMaxY)); { Контур окна }
      Line(Round(0.04*GetMaxX),Round(0.7*GetMaxY),
      Round(0.125*GetMaxX),Round(0.6*GetMaxY)); { Левый скат крыши }
      Line(Round(0.125*GetMaxX),Round(0.6*GetMaxY),
      Round(0.21*GetMaxX),Round(0.7*GetMaxY)); { Правый скат крыши }
      Line(0,Round(GetMaxY/2),GetMaxX,Round(GetMaxY/2)); { Линия горизонта }
      SetFillStyle(WideDotFill,White);
      { Выбор орнамента заполнения - редкие точки, белый цвет }
      FloodFill(0,0,White); { Заполнение верхней части экрана под небо }
      SetFillStyle(CloseDotFill,White);
      { Выбор орнамента заполнения - частые точки, белый цвет }
      FloodFill(0,Round(GetMaxY/2)+1,White)
      { Заполнение нижней части экрана под землю }
    End;
  XColob:=Round(0.3*GetMaxX);
  { Задание начальной координаты колобка в долях экрана }
  dxLeftFoot:=0; { Задание относительного смещения левой ноги }
  dxRightFoot:=0; { Задание относительного смещения правой ноги }
  umbrella:=false; { Зонт закрыт }
  aFootColob:=false; { Определение флага движения ногами }
  XCloud:=GetMaxX-Round(0.12*GetMaxX);
  { Определения начальной координаты тучи в долях экрана }
  Ch:=' ';  { Определение переменной для корректности обращения к ней
              если до начала цикла клавиша не будет нажата }
  while (XColob<0.85*GetMaxX)and(Ord(Ch)<>27) do
  { Работа, пока колобок не пройдет путь или не будет нажата клавиша Esc }
    Begin
      if KeyPressed then                         { Если нажата клавиша, то  }
                      begin
                        Ch:=ReadKey;             { чтение символа }
                        umbrella:=not umbrella;  { переустановка флага зонта }
                      end;
      Rain:=(XCloud-Round(0.12*GetMaxX)<XColob+Round(0.1*GetMaxX))
         and(XCloud+Round(0.12*GetMaxX)>XColob-Round(0.05*GetMaxX));
      { Включить дождь, если колобок находится под тучей }
      if Ord(Ch)<>27 then begin          { Если не нажата клавиша Esc, то }
                            ColobDriwer; { Прорисовать колобка }
                            CloudDriver; { Прорисовать тучу }
                            if i=1 then begin { Переключение видео страниц }
                                          SetVisualPage(1);
                                          SetAcTivePage(0);
                                          i:=0
                                        end
                                   else begin
                                          SetVisualPage(0);
                                          SetAcTivePage(1);
                                          i:=1
                                        end;
                          end;
      XColob:=XColob+1;{ Приращение координаты колобка }
      XCloud:=XCloud-1;{ Приращение координаты тучи }
    End;
  CloseGraph { Закрытие графического режима }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию