< -->

Program GraphDetector;
{$G+,D-}
const
  HS: array [0..15] of Char = '0123456789ABCDEF';
type
   TSVGAMode = record
    Mode:Byte;
    NClearVM, Stdrt, NStdrt, AppFast, LFB, NCVM : Boolean;
    Res : Byte;
   end;
type
  TS = array [0..65500] of Char;
  TW = array [0..32765] of Word;
  TNM = array [1..1024] of Word;
type
   TGeneralSVGAInfoBuffer = record
     VESA_VBE2 : array [0..3] of Char;
     VBEversion : Word;{! BCD}
     ProdIdentStr : ^TS;
     FlagFirst : Byte;
     FlagReserv : array [0..2] of Byte;
     SVGAModeList : ^TW;
     VMSize : Word; {В блоках по 64 Kb}
     InteriorVersion : Word;
     ProdNameStr : ^TS;
     VAdaptNameStr : ^TS;
     VerAdaptStr : ^TS;
     VBE_AFversion : Word;{1 BCD}
     AppFastModesList : ^TW;
     VESAReserv : array [0..215] of Byte;
     VBEDataReserv : array [0..255] of Byte;
   end;
type
   TSVGAModeInfoBuffer = record
     AttribMode : Word;
     WinA_Attr : Byte;
     WinB_Attr : Byte;
     WinGranul : Word;{ Kb}
     WinSize : Word;{ Kb}
     WinA_Seg : Word;
     WinB_Seg : Word;
     TransLockProc : Pointer;
     LogStrSize : Word;{Целых байт}
     Width : Word;{В пикселах или символах}
     Height : Word;{В пикселах или символах}
     SimbolWidth : Byte;{Pix}
     SimbolHeight : Byte;{Pix}
     Planes : Byte;
     BitPerPix : Byte;
     Banks : Byte;
     MemoryModel : Byte;
     BankSize : Byte;
     VideoPages : Byte;
     Reserv1 : Byte;
     BitMaskRed : Byte;
     FirstBitRed : Byte;
     BitMaskGreen : Byte;
     FirstBitGreen : Byte;
     BitMaskBlue : Byte;
     FirstBitBlue : Byte;
     BitMaskReserv : Byte;
     FirstBitReserv : Byte;
     Addition : Byte;
     LFB_Physics : Pointer;
     LFB_Offset : LongInt;
     NoMapLFB : Word;{ Kb}
     Reserv2 : array [0..205] of Byte;
   end;
type
  TFlag = record
    ADC_8bit : Boolean; {Analog-Digital Converter, АЦП, Аналого-цифровой преобр-ль}
    VGAIncompatible : Boolean;
    ADC_RevRayTrace : Boolean;
    VBE_AF_Support : Boolean;
    EnableDirectAccessReq : Boolean;
    AppMouseInd : Boolean;
    AppClipping : Boolean;
    AppBitBlt : Boolean;
  end;
type
  TAttribMode = record
    ModePresent : Boolean;
    PaddInfoPresent : Boolean;{Padding - Дополнительная инф-ция}
    TxBIOSOutpSupport : Boolean;
    ColoredMode : Boolean;
    GraphicsMode : Boolean;
    VGAIncomp : Boolean;
    BankSwitchNotSupp : Boolean;
    LFBNotSupp : Boolean;
    Undef : Boolean;
    EnableDirectAccessRq : Boolean;
    Undef7Bit : Byte;
  end;
type
  TWinAttr = record
    WinPresent : Boolean;
    ReadPermit : Boolean;{Чтение разрешено}
    WritePermit : Boolean;{Запись разрешена}
    OddMent : Byte;{Осаток}
  end;
var
  i, j, k : Word;
  xt, yt : Byte;
  St : String;
  CurBank : Word;
var
  SVGAMode: TSVGAMode;
  GeneralSVGAInfo : TGeneralSVGAInfoBuffer;
  SVGAModeInfo : TSVGAModeInfoBuffer;
  Flag : TFlag;
  ModeAttr : TAttribMode;
  WinAttr : TWinAttr;
  NM : TNM;
Procedure SetGrMode(GrMode:Word);Assembler;
asm
   mov ax, word ptr GrMode
   int 10h
end;
{------------------}
Procedure SetSVGAMode(GrMode:Word);Assembler;
asm
   mov ax, 4F02h
   mov bx, word ptr GrMode
   int 10h
end;
{------------------}
Function GetSVGAMode:Word;Assembler;
asm
   mov ax, 4F03h
   int 10h
   cmp al, 4Fh
   je @1
   mov bx, 0FFFFh
@1:
   mov ax, bx
end;
{------------------}
Procedure DecodeSVGAMode(SVGA:Word);
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, word ptr SVGA
   push ax
   and ax, 01111111b
   mov byte ptr [bx], al
   pop ax
   push ax
   and ax, 10000000b
   shr ax, 7
   mov byte ptr [bx+1], al
   pop ax
   push ax
   and ax, 100000000b
   shr ax, 8
   mov byte ptr [bx+2], al
   pop ax
   push ax
   and ax, 1000000000b
   shr ax, 9
   mov byte ptr [bx+3], al
   pop ax
   push ax
   and ax, 10000000000000b
   shr ax, 13
   mov byte ptr [bx+4], al
   pop ax
   push ax
   and ax, 100000000000000b
   shr ax, 14
   mov byte ptr [bx+5], al
   pop ax
   push ax
   and ax, 1000000000000000b
   shr ax, 15
   mov byte ptr [bx+6], al
   pop ax
   push ax
   and ax, 1110000000000b
   shr ax, 10
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Function Conv2SVGAMode:Word;{Конвертация в номер видеорежима}
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, 0
   mov al, byte ptr [bx]
   mov dl, byte ptr [bx+1]
   and dl, 1
   shl dx, 7
   or  ax, dx
   mov dl, byte ptr [bx+2]
   and dl, 1
   shl dx, 8
   or  ax, dx
   mov dl, byte ptr [bx+3]
   and dl, 1
   shl dx, 9
   or  ax, dx
   mov dl, byte ptr [bx+4]
   and dl, 1
   shl dx, 13
   or  ax, dx
   mov dl, byte ptr [bx+5]
   and dl, 1
   shl dx, 14
   or  ax, dx
   mov dl, byte ptr [bx+6]
   and dl, 1
   shl dx, 15
   or  ax, dx
   pop ds
end
end;
{------------------}
Function GetGeneralSVGAInfo:Word;Assembler;
asm
   mov ax, 4F00h
   mov bx, seg GeneralSVGAInfo
   mov es, bx
   mov di, offset GeneralSVGAInfo
   int 10h
end;
{------------------}
Function GetSVGAInfo(Mode : Word):Word;Assembler;
asm
   mov ax, 4F01h
   mov bx, seg SVGAModeInfo
   mov es, bx
   mov di, offset SVGAModeInfo
   mov cx, word ptr Mode
   int 10h
end;
{------------------}
Procedure DecodeFlag(Flag_:Byte);
begin
asm
   push ds
   mov bx, seg Flag
   mov ds, bx
   mov bx, offset Flag
   mov al, byte ptr Flag_
   push ax
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr al, 4
   and al, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr al, 5
   and al, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr al, 6
   and al, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr al, 7
   and al, 1
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeAttribMode(Attr : Word);
begin
asm
   push ds
   mov bx, seg ModeAttr
   mov ds, bx
   mov bx, offset ModeAttr
   mov ax, word ptr Attr
   push ax
   and ax, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr ax, 1
   and ax, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr ax, 2
   and ax, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr ax, 3
   and ax, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr ax, 4
   and ax, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr ax, 5
   and ax, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr ax, 6
   and ax, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr ax, 7
   and ax, 1
   mov byte ptr [bx+7], al
   pop ax
   push ax
   shr ax, 8
   and ax, 1
   mov byte ptr [bx+8], al
   pop ax
   push ax
   shr ax, 9
   and ax, 1
   mov byte ptr [bx+9], al
   pop ax
   push ax
   shr ax, 10
   mov byte ptr [bx+10], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeWinAttrib(Attr : Byte);
begin
asm
   push ds
   mov bx, seg WinAttr
   mov ds, bx
   mov bx, offset WinAttr
   mov al, byte ptr Attr
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   pop dx
   and al, 1
   shr dl, 3
   or al, dl
   mov byte ptr [bx+3], al
   pop ds
end
end;
{------------------}
Function BankSwitch(Set_Get, A_B:Boolean; var WinAddr : Word):Word;Assembler;
asm
   mov bh, byte ptr Set_Get
   mov bl, byte ptr A_B
   mov dx, word ptr WinAddr
   mov ax, 4F05h
   int 10h
   mov word ptr WinAddr, dx
end;
{------------------}
Function SetBegImage(Set_Get : Boolean; var FirstPix, FirstLine : Word):Word;Assembler;
asm
   mov ax, 4F07h
   mov bh, 0
   mov bl, byte ptr Set_Get
   shl bl, 7
   mov cx, word ptr FirstPix
   mov dx, word ptr FirstLine
   int 10h
   mov word ptr FirstPix, cx
   mov word ptr FirstLine, dx
end;
{------------------}
Procedure PutPixel(Page:Byte; X, Y:Word; Color:Byte);Assembler;
asm
   mov ah, 0Ch
   mov bh, byte ptr Page
   mov dx, word ptr Y
   mov cx, word ptr X
   mov al, byte ptr Color
   int 10h
end;
{------------------}
Procedure Nops;
begin
inline
($90/$90/$90/$90/$90);
end;
{-------------------}
Procedure PutPixel16b(X, Y, Color:Word);Assembler;
asm
   pop ax
   pop di
   pop cx
   pop dx
   pop bx
   push di
   xor di, di
   db  0Fh, 0ACh, 0D7h, 06h { shrd di, dx, 6}
   shr dx, 5
   inc dx
   cmp dx, word ptr CurBank
   jne @bank_switch
@switched:
   add di, bx
   mov ax, cx
   shl di, 1
   stosw
   ret
@bank_switch:
   push bx
   xor bx, bx
   mov word ptr CurBank, dx
   call dword ptr SVGAModeInfo[0Ch]
   pop bx
   jmp @switched
end;
{-------------------}
Function GetPixel(Page:Byte; X, Y:Word):Byte;Assembler;
asm
   mov ah, 0Dh
   mov bh, byte ptr Page
   mov dx, word ptr Y
   mov cx, word ptr X
   int 10h
end;
{------------------}
Function ReadKey : Char;Assembler;
asm
   mov ah, 10h
   int $16
end;
{----------------}
Procedure ResetTimer;Assembler;
asm
    mov      cx, 0
    mov      dx, 1
    mov      ah, $86
    int      $15
    jnc       @1
    mov ah, 83h
    mov al, 1
    int 15h
@1:
end;
{=+=+=+=+=+=+=+=+=+=++=+=+=+=+=+=+}
Procedure Delay(V, W : Word);Assembler;
asm
  @1:
    mov      cx, Word Ptr V
    mov      dx, Word Ptr W
    mov      ah, $86
    int      $15
    jc       @1
end;
{------------------------}
Function KeyPressed : Boolean;Assembler;
asm
 mov ah, $0B
 int $21
end;
Function InitMouse:Boolean;Assembler;
asm
        mov ax, 0
        int 33h
end;
Procedure ShowMouse;Assembler;
asm
        mov ax, 1
        int 33h
end;
Procedure HideMouse;Assembler;
asm
        mov ax, 2
        int 33h
end;
Function MouseButt:Word;Assembler;
asm
        mov ax, 3
        int 33h
        mov ax, bx
end;
{----------------}
begin
 GetGENERALSVGAInfo;
 GetSVGAInfo($117);
 WriteLn(SVGAModeInfo.BitPerPix, ' бит на пиксел');
 WriteLn(SVGAModeInfo.FirstBitRed, '  - первый красный');
 WriteLn(SVGAModeInfo.FirstBitGreen, ' - первый зелёный');
 WriteLn(SVGAModeInfo.FirstBitBlue, ' - первый синий');
{ReadKey;}
{
++++++++++++++++ Список доступных режимов ++++++++++++++++
100h
101h
102h
103h
104h
105h
106h
107h
110h
111h
112h
113h
114h
115h
116h
117h
7Ch
7Dh
Всего доступно режимов: 18
}
{ SetSVGAMode($117);}
 SetSVGAMode($117);
 asm
   mov dx, word ptr SVGAModeInfo[8]
   mov es, dx
 end;
k := $FF0;
Randomize;
While not KeyPressed do
begin
 for j := 1000 to 1750 do
   for i := 1450 to 1678 do
    begin
     PutPixel16b(i, j, $3123+k*(3*j+5*i)+Random($100)){ $811}
    end;
     k:=k+$1;
     if k=$FFFF then k := 0;
end;
InitMouse;
ShowMouse;
if MouseButt=1 then HideMouse;
if MouseButt=2 then ShowMouse;
{Readkey;}
{ While not KeyPressed do
 PutPixel16b(Random(1100)+1, Random(3000)+1, Random($FFFF)+1);}
{for k := $F000 to $FFFF do
 for j := 500 to 1000 do
   for i := 300 to 600 do
    begin
     PutPixel16b(i+j*j div $F0+k div j, j+k div i, Random(k*$700+i*$90+j*$20)+1);
    end;}
 ReadKey;
 SetGrMode(3);
end.

Назад