Программа


Program BiBiKa;
{ Из гаража выезжает грузовик
  и едет до конца экрана
  нажатие на кнопку дает сигнал }
Uses
  Graph,Crt;
Const
  DriverPath=''; { Путь к графическому драйверу }
  Step=1;  { Шаг прорисовки (скорость движения автомобиля) }
  LnCoef=2; { Коэффициент учитывающий толщину линий обводки гаража }
Var
  GraphDriver,GraphMode:integer; { Графический драйвер и режим }
  xCar,yCar:integer; { Координаты автомобиля }
  LengthCar,HeightCar:integer; { Габариты автомобиля }
  xGarage,yGarage:integer; { Координаты гаража }
  LengthGarage,HeightGarage:integer; { Габариты гаража }
  Symbol:char; { Переменная под буфер клавиатуры }
  i:integer; { Cчетчик страниц }
  Page:boolean; { Служебная переменная для переключения видеостраниц }
Procedure CarDriver; { Прорисовка автомобиля }
  var
    dx:integer; { Перекрытие автомобиля гаражом }
    dx2:integer;
{ Дополнительная часть окна автомобиля для затирания предыдущего изображения }
  Begin
    dx:=xGarage+LengthGarage+LnCoef-xCar;
    { Определение перекрытия автомобиля гаражом }
    if dx<0 then dx:=0;  { Обнуление перекрытия, если автомобиль
                           полностью выехал из гаража }
    if dx=0 then dx2:=xCar-(xGarage+LengthGarage+LnCoef)
                 { Определение дополнительной части окна }
            else dx2:=0;
    if dx2>2*Step        { Если доп. часть окна превышает два шага, }
      then dx2:=2*Step;  { то переопределение ее размера }
    SetViewPort(xCar+dx-dx2,yCar,xCar+LengthCar,yCar+HeightCar,true);
    { Задание окна для автомобиля }
    SetFillStyle(InterleaveFill,White);
    { Задание заполнения частой сеткой, белый цвет }
    Bar(0,0,LengthCar,HeightCar); { Востановление фона земли }
    SetColor(Black); { Установка черного цвета линий }
    SetLineStyle(SolidLn,0,NormWidth);
    { Установка сплошной линии нормальной толщины }
    SetFillStyle(SolidFill,Black); { Задание заполнения черным цветом }
    PieSlice(Round(0.25*LengthCar)+dx2-dx,Round(0.82*HeightCar),0,360,8);
    { Заднее колесо }
    PieSlice(Round(0.75*LengthCar)+dx2-dx,Round(0.82*HeightCar),0,360,8);
    { Переднее колесо }
    SetColor(White); { Установка белого цвета линий }
    SetFillStyle(HatchFill,White);{ Задание заполнения клеткой, белый цвет }
    Bar(dx2-dx,Round(0.35*HeightCar),
        Round(0.6*LengthCar)+dx2-dx,Round(0.7*HeightCar)); { Кузов }
    Rectangle(dx2-dx,Round(0.35*HeightCar),
          Round(0.6*LengthCar)+dx2-dx,Round(0.7*HeightCar)); { Контур кузова }
    SetFillStyle(XHatchFill,White);
    { Задание заполнения косой клеткой, белый цвет }
    Bar(Round(0.6*LengthCar)+dx2-dx,Round(0.1*HeightCar),
        Round(0.85*LengthCar)+dx2-dx,Round(0.7*HeightCar)); { Кабина }
    Rectangle(Round(0.6*LengthCar)+dx2-dx,Round(0.1*HeightCar),
          Round(0.85*LengthCar)+dx2-dx,Round(0.7*HeightCar));{ Контур кабины }
    SetFillStyle(LtSlashFill,White);{ Задание заполнения ///, белый цвет }
    Bar(Round(0.85*LengthCar)+dx2-dx,Round(0.4*HeightCar),
        LengthCar+dx2-dx,Round(0.7*HeightCar)); { Капот }
    Rectangle(Round(0.85*LengthCar)+dx2-dx,Round(0.4*HeightCar),
              LengthCar+dx2-dx,Round(0.7*HeightCar)); { Контур капота }
  End;
BEGIN
  GraphDriver:=Detect; { Автоматическое определение графического драйвера }
  InitGraph(GraphDriver,GraphMode,DriverPath); { Инициализация графики }
  if GetMaxMode>0 then SetGraphMode(1) { Режим VGAMed или EGAHi
                                         для VGA и EGA адаптеров }
                  else SetGraphMode(0);{ Наименее емкий режим для любого
                                         адаптера }
  SetVisualPage(0); { Установка нулевой страницы отображаемой }
  xGarage:=Round(0.04*GetMaxX); { Определение координат гаража }
  yGarage:=Round(0.7*GetMaxY);
  LengthGarage:=Round(0.17*GetMaxX); { Определение габаритов гаража }
  HeightGarage:=Round(0.17*GetMaxY);
  for i:=0 to 1 do  { Прорисовка фона и гаража на обеих страницах }
    Begin
      SetActivePage(i); { Установка активной страницы }
      SetColor(White);  { Задание белого цвета линий }
      SetFillStyle(WideDotFill,White);
      { Задание заполнения редкими точками, белый цвет }
      Bar(0,0,GetMaxX,Round(0.5*GetMaxY)); { Небо }
      SetFillStyle(InterleaveFill,White);
      { Задание заполнения частой сеткой, белый цвет }
      Bar(0,Round(0.5*GetMaxY),GetMaxX,GetMaxY); { Земля }
      SetLineStyle(SolidLn,0,ThickWidth); { Задание сплошной толстой линии }
      SetFillStyle(SlashFill,White);{ Задание заполнения ///, белый цвет }
      Bar(xGarage,yGarage,xGarage+LengthGarage,yGarage+HeightGarage);
      { Гараж }
      Rectangle(xGarage,yGarage,xGarage+LengthGarage,yGarage+HeightGarage);
      { Контур гаража }
      Line(xGarage+LengthGarage,
           yGarage,
           xGarage+LengthGarage+Round(GetMaxX/GetMaxY*0.76*HeightGarage),
           yGarage); { Дверь гаража }
    End;
    Symbol:='0';
    { Определение символа клавиатуры до непосредственного обращения к ней }
    xCar:=xGarage+Round(0.1*LengthGarage);{ Определение координат автомобиля }
    yCar:=yGarage+Round(0.2*HeightGarage);{ относительно гаража }
    LengthCar:=Round(0.8*LengthGarage); { Определение габаритов автомобиля }
    HeightCar:=Round(0.8*HeightGarage); { относительно гаража }
    Page:=true; { Определение переключателя страниц }
    while (xCar<GetMaxX-LengthCar)and(Ord(Symbol)<>27) do
    { Работа программы, пока автомобиль не достигнет конца экрана
      или не будет нажата клавиша Esc }
      Begin
        if KeyPressed        { Если нажата клавиша }
          then                 { то }
            begin
              Symbol:=ReadKey; { чтение буфера клавиатуры }
              if Ord(Symbol)<>27                 { и если это не Esc }
                then Sound(260)                     { то включение звука }
                else NoSound                        { иначе выключение }
            end
          else NoSound;      { Выключение звука, если клавиша не была нажата
                               (буфер клавивтуры пуст) }
        if xCar+LengthCar>xGarage+LengthGarage+LnCoef then CarDriver;
        { Если передняя часть автомобиля находится вне гаража,
          то прорисовка автомобиля }
        if (xGarage+LengthGarage+LengthCar<=xCar)
           and
           (xCar<xGarage+LengthGarage+LengthCar+2*Step)
           or
           (xGarage+LengthGarage+LengthCar+Step<=xCar)
           and
           (xCar<xGarage+LengthGarage+LengthCar+3*Step)
           { Если автомобиль отъехал на расстояние корпуса, то закрыть гараж }
           then
             begin
               SetViewPort(0,0,GetMaxX,GetMaxY,true);
               { Востановление полного экрана }
               SetFillStyle(InterleaveFill,White);
               { Задание заполнения частой сеткой, белый цвет }
               Bar(xGarage+LengthGarage+LnCoef,
                yGarage+LnCoef,
                xGarage+LengthGarage+Round(GetMaxX/GetMaxY*0.76*HeightGarage),
                yGarage-LnCoef) { Закрашивание створки гаража под землю }
             end;
        if Page then begin              { Последовательное переключение }
                      SetVisualPage(0); { - отображаемой страницы }
                      SetActivePage(1); { - активной страницы }
                    end
               else begin
                      SetVisualPage(1);
                      SetActivePage(0);
                    end;
        Page:=not Page;  { Изменение положения переключателя страниц }
        xCar:=xCar+Step;
      End;
    NoSound; { Дублирование выключения звука при окончании программы
              по условию достижения автомобилем конца экрана при нажатой
              клавише }
  CloseGraph { Выключение графического режима }
END.


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