Модуль VGA_MCGA
Unit VGA_MCGA;
Interface
Type
    Palette=Array[0..768] Of Byte;
        {Палитра на 256 цветов (256*3)=768}
Var
    VideoMode:Byte;
        {Процедуры и функции модуля}
    Procedure InitGraf13;
        {Инициализация видеорежима 13h}
    Procedure CloseGraph13;
       {Восстановление прежнего видеорежима}
    Procedure PutPixel13 (x,y:Word; Col:Byte);
       {Рисует точку цветом Col с координатами x,y}
    Function GetPixe113(x,y:Word):Byte;
       {Возвращает цвет точки с координатами x,y}
    Procedure WaitVSync;
       {При динамическом изменении палитры
        происходит мерцание экрана. Процедура
        WaitSync устраняет этот эффект.
        Ее необходимо запускать перед
        изменением палитры}
    Procedure SetVGAPalette(First,
                             NumToset:Word;Pal:Palette);
       {Устанавливает палитру. First - номер 1-го цвета 
        изменяемой палитры, NumToSet - кол-во цветов,
        которые нужно установить. Pal - устанавливаемая 
          палитра}
    Procedure RotatePalette (Last: Word; Var Pal: Palette);
       {Осуществляет сдвиг палитры. Позволяет
        добиться интересных визуальных эффектов
        Last - последний цвет изменяемой
        палитры. Pal - изменяемая палитра}
    ProcedureHideScreen (LastColor:Word; Pal:Palette);
        {Плавное гашение экрана. LastColor - 
         количество цветов палитры, которые
         необходимо погасить, Pal - палитра}

Implementation
Procedure IntGraph13;
Begin
   Asm
      mov ah, 0Fh
      int 10h
      mov VideoMode, Al
      mov ah,00
      mov al,13h
      int 10h
   End;
End; {End of InitGraph13}
Procedure CloseGraph13;
Begin
   Asm
      mov ah,00
      mov al,VideoMode
      int 10h
   End;
End; {end of CloseGraph13}
Procedure PutPixel13 (x,y:Word; Col:Byte);
Begin
   Asm
      mov ah,0ch
      mov al,Col
      mov bh,0h
      mov cx,x
      mov dx,y
      int 10h
   End;
End; {end of PutPixel13}
Function GetPixel13 (x,y:Word): Byte;
Var
   Reslt:Byte;
Begin
   Asm
      mov ah,0Dh
      mov bh,0h
      mov cx,x
      mov dx,y
      int 10h
      mov Reslt,al
   End;
   GetPixel13:=Reslt;
End; {end of GetPixel13}
Procedure WaitVsync;
Begin
   Repeat {3-й бит порта 3dah указывает на положение луча}
   Until (Port [$3DA] and 8)=8;
End; {end of WaitVSync}
Procedure SetVGAPalette (First, NumToSet:Word; Pal:Palette);
Var
  Segm,Offs:Word;
Begin
    Segm:=Seg(Pal);
    Offs:=Ofs(Pal);
    WaitVSync;
    Asm
       mov bx,First
       mov cx,NumToSet
       mov dx,OFFS
       mov es,SEGM
       mov ax,1012h
       int 10h
    End;
End; {End of SetVGAPalette}
Procedure RotatePalette (Last:Word; Var Pal:Palette);
Var
   hold1,hold2,hold3:Byte;
   N:Word;
Begin
   	hold1:=Pal [3];
   	hold2:=Pal [4];
   	hold3:=Pal [5];
   	For N:=3 to Last*3 Do
   	Pal [N]:=Pal [N+3];
  	Pal[(Last+1)*3-1]:=hold3;
  	Pal[(Last+1)*3-2]:=hold2;
  	Pal[(Last+1)*3-3]:=hold1;
  	SetVGAPalett(0,193,Pal);
End; {end of RotatePalette}
Procedure
HideScreen(LastColor:Word;Pal:Palette);
Var
   NC,MC,MaxC:Word;
Begin
   MaxC:=0;
   For MC:=0 to (LastColor+1)*3 Do
     If MaxC<Pal[MC] then MaxC:=Pal[Mc];
   For MC:=0 to MaxC Do
   Begin
      For NC:=0 to (LastColor+1)* Do
         IF Pal[nc]>=1 Then
            Pal[NC]:=Pal[NC]-1;
      SetVgaPalette(0,193,Pal);
End;
End; {end of HideScreen}
End. {End of VGA_MCFA}