Unit DemoVga;

Interface

Const

  Name = 'DEMOVGA : Базовый модуль для построения демок в 320x200x256!!!';
 
  Font8  = 3; 
  Font14 = 2; 
  Font16 = 6; 
 
Var 
 DBuffer,Origin : Pointer; 
 MemStor : Pointer; 
 
Procedure InitDemoPart; 
Procedure RestoreDemo; 
Procedure SetRGBColor( C, R, G, B : Byte); 
Procedure ClearDBuffer; 
Procedure DBuff2Video;
Function GetFontPtr( Size : Byte) : Pointer; 
 
Implementation 
 
Uses Crt;

Procedure InitDemoPart; 
Begin 
 Mark( MemStor); 
 GetMem( DBuffer, 65500); 
 Origin := DBuffer; 
 Inc( LongInt( DBuffer), $10000); 
 LongInt( DBuffer) := LongInt( DBuffer) And $FFFF0000; 
 SegA000 := Seg( DBuffer^); 
 ClearDBuffer; 
 Asm 
  Mov        AX,13h 
  Int        10h 
 End; 
End;
 
Procedure RestoreDemo; 
Begin 
 FreeMem( Origin, 65500); 
 Release( MemStor); 
 Asm
  Mov        AX,3h 
  Int        10h 
 End; 
End; 
 
Procedure SetRGBColor( C, R, G, B : Byte); 
Begin 
 Port[ $3C8] := C; 
 Port[ $3C9] := R; 
 Port[ $3C9] := G; 
 Port[ $3C9] := B; 
End; 
 
Procedure ClearDBuffer;Assembler;
Asm 
   Les         DI,DBuffer 
   Db         $66; Xor   AX,AX 
   Mov         CX,16200 
   Db         $66; Rep   Stosw 
End;
 
Procedure DBuff2Video;Assembler; 
Asm 
   Push  DS 
   Mov         DS,SEGA000 
   Xor         SI,SI 
   Mov         AX,0A000h 
   Mov         ES,AX 
   Xor         DI,DI 
   Mov         CX,16001 
   Db         $66; Rep   Movsw 
   Pop         DS 
End; 

Function GetFontPtr( Size : Byte) : Pointer; 
Var 
  Font : Pointer; 
Begin 
 Asm 
  Push         BP
  Mov         AX,1130h 
  Mov         BH,Size 
  Int         10h 
  Mov         AX,BP 
  Pop         BP 
  Mov         Word Ptr [Font],AX 
  Mov         Word Ptr [Font+2],ES 
 End; 
 GetFontPtr := Font; 
End; 
 
Procedure RunDemoVga; Far; 
Var 
  I : Integer;
Begin
 InitDemoPart;

 Repeat
  For I := 0 To 199 Do
   FillChar( Ptr( $A000, I * 320)^, 320 , I);
 Until KeyPressed;

 ReadKey;
 RestoreDemo;
End;

Begin

End.