Unit Un_Graph;

interface

{$IFDEF DPMI}
 uses Crt, Mouse, M_Curs, WinAPI;
{$ELSE}
 uses Crt, Mouse, M_Curs;
{$ENDIF}

{$I-,S-}

type
    DWORD = record
             Hi, Lo : WORD;
            end;

const
    GrSeg           : WORD = $A000;

var
    GrMode          : WORD    ; { cislo modu}
    XLength         : WORD    ; { velikost X}
    YLength         : WORD    ; { velikost Y}
    BitsPix         : WORD    ; { bitu na pixel (nebo vlastne bytu)}
    GPage           : WORD    ; { aktualni graf. stranka}
    C_O_L           : WORD    ; { aktualni barva}
    ExCol           : WORD    ; { dalsich 16 bitu pro 32bit barvu}
    LineLen         : WORD    ; { delka scan radky}
    Granularity     : WORD    ; { granularita okna -v kB}
    InitMode        : boolean ; { je graf. mod?}
    {VESA Infos}
    VESA_Info       : record
                       VESA_ID             :DWORD ;
                       VESA_Version        :WORD  ;
                       VESA_ManufacturePtr :DWORD ;
                       VESA_NonDef         :DWORD ;
                       VESA_ModesPtr       :DWORD ;
                       VESA_Memory         :WORD  ;
                      end;
    {"CACHE"}
    XDATA0, XDATA1, XDATA2, XDATA3:BYTE;

var  OldX,OldY:word;
     Visible:boolean;
     Wait_Vis:boolean;
     InstallMouse:boolean;
     SysDirectory:string;

var Loaded:boolean;
    OverLine,UnderLine:integer;

const T_HalfSize     =  8;
      T_OriginalSize = 16;
      T_DoubleSize   = 32;
      LeftText       =  0;
      TopText        =  0;
      CenterText     =  1;
      RightText      =  2;
      BottomText     =  2;

      InPutFont      : string[13] = 'LITT.CHR';

      TextFont:array[1..10]of string[13]=
       ('BOLD.CHR','EURO.CHR','GOTH.CHR','LCOM.CHR','LITT.CHR',
        'SANS.CHR','SCRI.CHR','SIMP.CHR','TRIP.CHR','TSCR.CHR');


const Msg_Info     = 0 ;
      Msg_Vystraha = 1 ;
      Msg_Chyba    = 2 ;
      Msg_Otazka   = 3 ;

{Assembler}
{$IFDEF DPMI}
 procedure SetActOfs(Ofs:word); export;
 procedure GetVESAInfo; export;
 procedure SetMode(ModeNum,XLen,YLen,Bpp:word); export;
 function  GetMode:word; export;
 procedure SetLineLen(Len:word); export;
 function  GetLineLen:word; export;
 procedure SetDisplayStart(pixel,line:word); export;
 procedure GetDisplayStart(var pixel,line:word); export;
 procedure CloseGraph; export;
 procedure SetPal(I,R,G,B:byte); export;
 procedure GetPal(Col:word;var R,G,B:byte); export;
 procedure PutPixel8(X,Y,B:word); export;
 procedure PutPixel16(X,Y,B:word); export;
 procedure PutPixel(X,Y,B:word); export;
 function  GetPixel(X,Y:word):word; export;
 procedure ClearScreen; export;
 procedure FillScreen; export;
{ procedure Line(X1,Y1,X2,Y2:integer); export;}
{$ELSE}
 procedure SetActOfs(Ofs:word);
 procedure GetVESAInfo;
 procedure SetMode(ModeNum,XLen,YLen,Bpp:word);
 function  GetMode:word;
 procedure SetLineLen(Len:word);
 function  GetLineLen:word;
 procedure SetDisplayStart(pixel,line:word);
 procedure GetDisplayStart(var pixel,line:word);
 procedure CloseGraph;
 procedure SetPal(I,R,G,B:byte);
 procedure GetPal(Col:word;var R,G,B:byte);
 procedure PutPixel8(X,Y,B:word);
 procedure PutPixel16(X,Y,B:word);
 procedure PutPixel(X,Y,B:word);
 function  GetPixel(X,Y:word):word;
 procedure ClearScreen;
 procedure FillScreen;
{ procedure Line(X1,Y1,X2,Y2:integer);}
{$ENDIF}

{Pascal}
{$IFDEF DPMI}
 function  GetColor:word; export;
 procedure SetColor(Col:word); export;
 procedure Line(a,b,c,d:integer); export;
 procedure Rectangle(X1,Y1,X2,Y2:word); export;
 procedure Bar(X1,Y1,X2,Y2:word); export;
 procedure ShowPicture_PCX(F:string;DX,DY:word;var XLn,YLn:word); export;
 procedure ShowPicture_VGA(FileName:string;X,Y:word;var XL,YL:word); export;
 procedure ShowBackGround(FileName:string); export;
 procedure PutPixelRGB(X,Y:word;R,G,B:byte); export;
 procedure GetPixelRGB(X,Y:word;var R,G,B:byte); export;
 procedure GetScreenMax(var MaxX,MaxY:word); export;

 procedure SelSysDir(SysDir:string); export;
 procedure SetDisk(Disk:string);
 procedure SetSysDir; export;
 function  InputNum(X,Y,WinSize,MaxNum:word;var Num:word):boolean; export;
 function  InputStr(X,Y,WinSize:word;MaxLen:byte;var S:string):boolean; export;
 procedure WaitPressed; export;
 procedure G_ShowMouse; export;
 procedure G_HideMouse; export;
 procedure SelMouse(var X,Y,Select:word); export;
 function  IsMouseInstall:boolean; export;

 procedure LoadFont(FontFile:string); export;
 procedure FreeFont; export;
 procedure SetTextColor(ColorNum:word); export;
 procedure SetTextSize(SizeNum:word); export;
 procedure SetTextJustify(Xjust,YJust,Angle:integer); export;
 function  GetTextHight:word; export;
 function  IsLoaded:boolean; export;
 function  GetTextWidth(UserText:string):word; export;
 procedure OutTextXY(XAxis,YAxis:word;UserText:string); export;

 procedure ShowFrame(X1,Y1,X2,Y2:integer;FrameType:byte); export;
 function  ShowMessage(MsgType:byte;Message:string):char; export;
 function  ShowInBox(BoxType:byte;BoxName:string;var InText:string):char; export;
 function  ShowNumBox(BoxType:word;BoxName:string;var InNum:word):char; export;

 procedure InitMyGraph(G, X, Y, B:word); export;

{$ELSE}
 procedure InitVESAMode(S_MaxX, S_MaxY, S_Bpp:word);
 procedure InitVESA;
 function  HexWord2Str(w: Word):string;

 function  GetColor:word;
 procedure SetColor(Col:word);
 procedure Line(a,b,c,d:integer);
 procedure Rectangle(X1,Y1,X2,Y2:word);
 procedure Bar(X1,Y1,X2,Y2:word);
 procedure ShowPicture_PCX(F:string;DX,DY:word;var XLn,YLn:word);
 procedure ShowPicture_VGA(FileName:string;X,Y:word;var XL,YL:word);
 procedure ShowPicture_CPF(F:string;DX,DY:word);
 procedure PutPixelRGB(X,Y:word;R,G,B:byte);
 procedure GetPixelRGB(X,Y:word;var R,G,B:byte);
 procedure GetScreenMax(var MaxX,MaxY:word);

 procedure SelSysDir(SysDir:string);
 procedure SetDisk(Disk:string);
 procedure SetSysDir;
 function  InputNum(X,Y,WinSize,MaxNum:word;var Num:word):boolean;
 function  InputStr(X,Y,WinSize:word;MaxLen:byte;var S:string):boolean;
 procedure WaitPressed;
 procedure G_ShowMouse;
 procedure G_HideMouse;
 procedure SelMouse(var X,Y,Select:word);
 function  IsMouseInstall:boolean;

 procedure LoadFont(FontFile:string);
 procedure FreeFont;
 procedure SetTextColor(ColorNum:word);
 procedure SetTextSize(SizeNum:word);
 procedure SetTextJustify(Xjust,YJust,Angle:integer);
 function  GetTextHight:word;
 function  IsLoaded:boolean;
 function  GetTextWidth(UserText:string):word;
 procedure OutTextXY(XAxis,YAxis:word;UserText:string);

 procedure ShowFrame(X1,Y1,X2,Y2:integer;FrameType:byte);

 procedure InitMyGraph(G, X, Y, B:word);

{$ENDIF}

{Objekty}
{ $IFDEF DPMI}
 type PtrArrayT=array[0..4096]of pointer;
      RGBT=array[0..767]of byte;
      ScreenT=object
               S_Bp:word;
               X1,Y1,X2,Y2:word;
               PtrArray:pointer;
               Result:word;
               RGBPtr:pointer;
               constructor Init(iX1,iY1,iX2,iY2,iCB:word);
               destructor Done;
               procedure SetScrBegin(XBegin,YBegin:word); virtual;
               procedure SetRGB; virtual;
               procedure GetRGB; virtual;
               procedure PutTo(X,Y,Color:word); virtual;
               function  GetFrom(X,Y:word):word; virtual;
               procedure Show(Jak:boolean); virtual;
               procedure Hide; virtual;
               procedure CopyTo; virtual;
               procedure GetPtrArray(var GPA:pointer); virtual;
               procedure SetPtrArray(GPA:pointer); virtual;
               procedure Save(FileName:string); virtual;
               procedure Load(FileName:string); virtual;
               function  GetResult:word; virtual;
               function  GetMaxX:word; virtual;
               function  GetMaxY:word; virtual;
               function  GetBytes:word; virtual;
              end;
{ $ENDIF}

type  TMode = record
               Num, MaxX, MaxY, Bpp :word;
               Gran, Bpl, GrSeg :word;
              end;
      TModes = array [0..4679] of TMode;

const ModesPtr : pointer =   NIL ;
      ModesCnt : word    = $0000 ;
      Mode     : TMode   = (Num:$100; MaxX:640; MaxY:400; Bpp:8);
      VESA_Ver : word    = $0000 ;
      VESA_Gr  : string  =    '' ;

const {===  8bit colors ===}
      G_320x200      : word = $13  ;
      G_320x240      : word = $50  ;
      G_400x300      : word = $51  ;
      G_512x384      : word = $52  ;
      G_640x400      : word = $100 ;
      G_640x480      : word = $101 ;
      G_800x600      : word = $103 ;
      G_1024x768     : word = $105 ;
      G_1280x1024    : word = $107 ;
      {=== 16bit colors ===}
      G_320x200x16   : word = $10E  ;
      G_320x240x16   : word = $56  ;
      G_400x300x16   : word = $57  ;
      G_512x384x16   : word = $58  ;
      G_640x480x16   : word = $111 ;
      G_800x600x16   : word = $114 ;
      G_1024x768x16  : word = $117 ;
      G_1280x1024x16 : word = $11A ;

type ColorsType=array[0..15]of word;

const {======= Cisla barev =======}
      Black        =  0;
      Blue         =  1;
      Green        =  2;
      Cyan         =  3;
      Red          =  4;
      Magenta      =  5;
      Brown        =  6;
      LightGray    =  7;
      DarkGray     =  8;
      LightBlue    =  9;
      LightGreen   = 10;
      LightCyan    = 11;
      LightRed     = 12;
      LightMagenta = 13;
      Yellow       = 14;
      White        = 15;
      {===== Zakladnich 16 barev pro 256ti barevne mody =====}
      Colors256:ColorsType=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
      {===== Zakladnich 16 barev v 16ti bitovych modech =====}
      Black_16     =     0;
      Blue_16      =    31;
      Green_16     =  1792;

      LightGray_16 = 44501;
      DarkGray_16  =   814;

      Yellow_16    = 65472;
      White_16     = 65535;
      Colors16:ColorsType=(0,31,1792,3,4,5,6,44501,16905,9,10,11,12,13,65472,65535);
      {===== Univarzalnich 16 barev =====}
      Colors:ColorsType=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);

type
     VGA_Header=record
                 VGAID:array[0..1]of byte;
                 Xlen,YLen:array[0..1]of byte;
                 C_Black,C_Gray,C_White:array[0..1]of byte;
                 Other:array[0..19]of byte; {dont know whats there}
                end;
     VGA_Palette=array[0..255]of record
                                  R,G,B:byte;
                                 end;

implementation

uses Dos;

type CHR_Header=record
                 FileID:array[0..3]of byte;               {vzdy "PK",8,8}
                 CompanyName:array[0..85]of byte;         {podpis firmy}
                 HeaderSize:word;                         {vzdy 128 Bajtu}
                 FontName:array[0..3]of byte;             {ctyrpismenny nazev fontu}
                 FontFileSize:word;                       {velikost souboru s fonty}
                 Version:word;                            {verze: 11=1.1}
                 MinVerNum:word;                          {min. cisla verzi (?)}
                 Fill:array[0..25]of byte;                {vypln do 128mi}
                 {nasleduje CHR_FileInfo}
                end;
     CHR_FileInfo=record
                   FontID:byte;                           {ozn. caroveho fontu (vzdy "+")}
                   CharsCnt:word;                         {pocet znaku v souboru}{X}
                   NonDef_1:byte;                         {nedefinovano}
                   ASCIIFirst:byte;                       {ASCII prvniho znaku v souboru}
                   FirstChrOfs:word;                      {pricist 134 = od zacatku souboru}
                   ScanFlag:byte;                         {scan priznak, norm. nula}
                   TopHight:byte;                         {vyska pismene EE: nejv. evr.}
                   BaseHight:byte;                        {vyska baze (?), vets. nula}
                   Qfrom:byte;                            {vz. mezi linkou a spodkem
                                                           pismene q (vets. <=0), max. +/- 64}
                   NonDef_2:array[0..4]of byte;           {nedefinovano}
                   {nasleduje CHR_CharsOfsArray(Xkrat)}
                  end;
     CHR_CharsOfsArray=array[0..255]of word;              {tabulka ofsetu k znakum (rel. k zac.
                                                           def. znaku (144+3.X))}
                   {nasleduje CHR_CharsWidthArray}
     CHR_CharsWidthArray=array[0..255]of byte;            {tab. sirek znaku}
     {zac. znaku vzhledem k zac. soub.: (144+3.X)+[144+2.(ASCII_Znaku-ASCIIFirst)]}

     CharsArray=array[0..65534]of byte;

var
    Header              : CHR_Header   ;
    FileInfo            : CHR_FileInfo ;
    CharsOfsPtr         : pointer      ;
    CharsWidthPtr       : pointer      ;
    TextPtr             : pointer      ;
    TextColor, TextSize : word         ;
    JustifyX, JustifyY  : integer      ;
    TextAngle           : word         ;
    FontSize            : longint      ;


procedure PutPixelRGB(X,Y:word;R,G,B:byte); assembler;
{var Col:word;
    VS,VO:word;
begin}
asm
{ Col:=((R div 8)*8*256)+((G div 4)*32)+(B div 8);
 PutPixel(X,Y,Col);}
 {RRRRR000}
 {GGGGGG00}
 {BBBBB000}
 {RRRRRGGG GGGBBBBB}
 XOR     AX, AX
 MOV     AL, B
 SHR     AL, 3
 XOR     BX, BX
 MOV     BL, G
 SHR     BL, 2
 SHL     BX, 5
 ADD     AX, BX
 XOR     BX, BX
 MOV     BL, R
 AND     BL, 11111000B
 ADD     AH, BL
 PUSH    X
 PUSH    Y
 PUSH    AX
 CALL    PutPixel
end;

procedure GetPixelRGB(X,Y:word;var R,G,B:byte);
var gR, gG, gB :byte;
begin
 asm
 { Col:=GetPixel(X,Y);
  B:=(Col mod 32)*8;
  Col:=Col-(Col mod 32);
  G:=((Col div 32) mod 64)*4;
  R:=Col-G;}
  {RRRRR000}
  {GGGGGG00}
  {BBBBB000}
  {RRRRRGGG GGGBBBBB}
  PUSH    X
  PUSH    Y
  CALL    GetPixel
 { XOR     AX, AX}
  MOV     BL, AH
  AND     BL, 11111000B
  MOV     gR, BL
  AND     AH, 00000111B
  MOV     BX, AX
  SHR     BX, 5
  SHL     BX, 2
  MOV     gG, BL
  AND     AL, 00011111B
  SHL     AL, 3
  MOV     gB, AL
 end;
 R := gR;
 G := gG;
 B := gB;
end;

{==============================Inicializace================================}
{$IFDEF DPMI}
{$ELSE}
procedure InitVESAMode;
var Cnt, GNum : word;
    ModeVar   : TMode;
procedure NoVGA;
begin
 WriteLn('No Compatible SVGA Mode Found ...');
 Halt;
end;
begin
 InitVESA;
 GNum := $FFFF;
 for Cnt := 0 to ModesCnt-1 do
 begin
  ModeVar := TModes(ModesPtr^)[Cnt];
  with ModeVar do
  begin
   if ((MaxX = S_MaxX) and (MaxY = S_MaxY) and (Bpp = S_Bpp)) then
   begin
    GNum := Cnt;
    Mode := ModeVar;
   end;
  end;
 end;
 if GNum = $FFFF then NoVGA;
 with Mode do
 begin
  Granularity := Gran;
  InitMyGraph(Num, MaxX, MaxY, Bpp);
 end;
end;

function HexWord2Str(w: Word):string;
const
  hexChars: array [0..$F] of Char =
    '0123456789ABCDEF';
var hwS:string;
begin
 hwS := hexChars[Hi(w) shr 4]+
        hexChars[Hi(w) and $F]+
        hexChars[Lo(w) shr 4]+
        hexChars[Lo(w) and $F];
 HexWord2Str := hwS;
end;

procedure InitVESA;
var VBuffer : array [0..127] of word ;
    Je      : byte                   ;
    VSeg,
    VOfs    : word                   ;
    MPtr    : pointer                ;
    Pocet   : word                   ;
    Offs,
    CntW,
    MATT    : word                   ;
    GrMod   : word                   ;
    Cnt     : byte                   ;
begin
 GetVESAInfo;
 with VESA_Info do
 begin
  {Nastaveni verze}
  VESA_Ver := VESA_Version;
  {Nastaveni VESA_Manufacture}
  Offs := 0;
  VESA_Gr := '';
  repeat
   Cnt := Mem[VESA_ManufacturePtr.Lo:VESA_ManufacturePtr.Hi+Offs];
   if Cnt >= 32 then VESA_Gr := VESA_Gr+Chr(Cnt);
   Offs := Offs+1;
  until Cnt = 0;
  {Nastaveni gr. modu}
  if ModesCnt > 0 then
  begin
   FreeMem(ModesPtr, SizeOf(TMode)*ModesCnt);
   ModesCnt := 0;
  end;
  Offs := 0;
  Pocet := 0;
  repeat
   GrMod := MemW[VESA_ModesPtr.Lo:VESA_ModesPtr.Hi+Offs];
   if GrMod <> $FFFF then
    Pocet := Pocet+1;
   Offs := Offs+2;
  until GrMod = $FFFF ;
  for CntW := 1 to Pocet do
  begin
   Offs := CntW*2;
   GrMod := MemW[VESA_ModesPtr.Lo:VESA_ModesPtr.Hi+Offs];
   Je := 0;
   VSeg := Seg(VBuffer);
   VOfs := Ofs(VBuffer);
   asm
    mov   AX, VSeg
    mov   ES, AX
    mov   DI, VOfs
    mov   AX, 4F01H
    mov   CX, GrMod
    int   10h
    cmp   AX, 004FH
    jne   @@1
    mov   Je, 0FFH
@@1:
   end;
   if Je <> 0 then
   begin
    {MATT}
    MATT := VBuffer[0];
        {podporuje}           {rozs. info}          {grafika}
    if ((MATT and 1 <> 0) and (MATT and 2 <> 0) and (MATT and 16 <> 0)) then
    begin
     GetMem(MPtr, SizeOf(TMode)*(ModesCnt+1));
     if ModesCnt > 0 then
     begin
      Move(Mem[Seg(ModesPtr^):Ofs(ModesPtr^)], Mem[Seg(MPtr^):Ofs(MPtr^)],
       SizeOf(TMode)*ModesCnt);
      FreeMem(ModesPtr, SizeOf(TMode)*ModesCnt);
     end;
     with TModes(MPtr^)[ModesCnt] do
     begin
      {Bit 2 -podpora BIOSem}
      {Bit 3 -color}
      Num := GrMod;
      Gran := VBuffer[2];
      GrSeg := VBuffer[4];
      Bpl := VBuffer[8];
      MaxX := VBuffer[9];
      MaxY := VBuffer[10];
      Bpp := Hi(VBuffer[12]);
     end;
     ModesCnt := ModesCnt+1;
     ModesPtr := MPtr;
    end;
   end;
  end;
 end;
end;

{$ENDIF}

procedure SetPal(I,R,G,B:byte); assembler;
asm
        MOV     DX,3C8H
        MOV     AL,I
        OUT     DX,AL
        INC     DX
        MOV     AL,R
        OUT     DX,AL
        MOV     AL,G
        OUT     DX,AL
        MOV     AL,B
        OUT     DX,AL
end;

{===============================Assembler==================================}

{$L GRAPH}

procedure SetActOfs(Ofs:word); external;
procedure GetVESAInfo; external;
procedure SetMode(ModeNum,XLen,YLen,Bpp:word); external;
function  GetMode:word; external;
procedure SetLineLen(Len:word); external;
function  GetLineLen:word; external;
procedure SetDisplayStart(pixel,line:word); external;
procedure GetDisplayStart(var pixel,line:word); external;
procedure CloseGraph; external;
{procedure SetPal(I,R,G,B:byte); external;}
procedure GetPal(Col:word;var R,G,B:byte); external;
procedure PutPixel8(X,Y,B:word); external;
procedure PutPixel16(X,Y,B:word); external;
procedure PutPixel(X,Y,B:word); external;
function  GetPixel(X,Y:word):word; external;
procedure ClearScreen; external;
procedure FillScreen; external;
{procedure Line; external;}

{==========================================================================}

{=================================Pascal===================================}

procedure SetColor(Col:word);
begin
 C_O_L := Col;
end;

function GetColor:word;
begin
 GetColor := C_O_L;
end;

procedure InitMyGraph(G, X, Y, B:word);
begin
 SetMode(G, X, Y, B);
 SetMouseMinMaxX(0,X-1);
 SetMouseMinMaxY(0,Y-1);
 SetMouseSensitivity(64,64);
 SetMouseStep(1,1);
 case B of
  1:Colors:=Colors256;
  2:Colors:=Colors16;
 end;
end;


procedure GetScreenMax(var MaxX,MaxY:word);
begin
 MaxX:=XLength;
 MaxY:=YLength;
end;


Procedure Line(a,b,c,d:integer);
  function sgn(a:real):integer;
  begin
       if a>0 then sgn:=+1;
       if a<0 then sgn:=-1;
       if a=0 then sgn:=0;
  end;
var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
begin
 u:= c - a;
 v:= d - b;
 d1x:= SGN(u);
 d1y:= SGN(v);
 d2x:= d1x;
 d2y:= 0;
 m:= ABS(u);
 n := ABS(v);
 IF NOT (M>N) then
 BEGIN
  d2x := 0 ;
  d2y := d1y;
  m := n;
  n := ABS(u);
 END;
 s := m shr 1;
 FOR i := 0 TO m DO
 BEGIN
  putpixel(a,b,C_O_L);
  s := s + n;
  IF not (s<m) THEN
  BEGIN
   s := s - m;
   a:= a + d1x;
   b := b + d1y;
  END
  ELSE
  BEGIN
   a := a + d2x;
   b := b + d2y;
  END;
 end;
END;
(*
procedure Line( X1, Y1, X2, Y2: word); assembler;
const
     neg_dx     = 2;            { Znamenko od delta x }
     neg_dy     = 4;            { Znamenko od delta y }

asm
        push    BP              { Uchovani registru BP }
        push    DS              {                 a DS }

        mov     AX, X1          { Nacteni souradnic do registru procesoru }
        mov     BX, Y1
        mov     CX, X2
        mov     DX, Y2

        xor     BP, BP          { Smazani registru BP }
        mov     DI, CX          { Spocitani hodnoty deltax }
        sub     DI, AX
        jg      @p_dx           { Je deltax kladne ? }
        or      BP, neg_dx      { ne => uloz znamenko do BP }
        neg     DI              {       absolutni hodnota DI tj. deltax }

  @p_dx:
        mov     SI, DX          { Urceni hodnoty deltay }
        sub     SI, BX
        jg      @p_dy           { Je deltay kladne ? }
        or      BP, neg_dy      { ne => uloz znamenko do BP }
        neg     SI              {       absolutni hodnota delaty }

  @p_dy:
        cmp     DI, SI          { Porovnani deltax a deltay }
        jb      @vertical_dir   { deltax > deltay <=> absolutni hodnota smernice > 1
                                                          => vertikalni smer
                                  deltax <= deltay <=> absolutni hodnota smernice <= 1
                                                          => horizontalni smer          }

  @horizontal_dir:
        test    BP, neg_dx      { Porovnani X1 a X2 }
        jz      @hor_init       { Je smer zprava doleva ? }
        xchg    AX, CX          { ne => vymen souradnice pocatku a konce cary }
        xchg    BX, DX
        xor     BP, neg_dy      { uprav znamenko deltay }

  @hor_init:                    { Vypocet adresy prvniho bodu }
        mov     CX, AX          { Do CX X1 }
        xchg    AX, BX          { BX = X1, AX = X2 }
        mov     DX, BytesPerRow        { DX = Pocet byte na jedne radce (80) }
        mul     DX                     { AX:DX = Y1 * 80 }
        shr     BX, PixelsPerByte      { BX = BX div 8 }
        add     BX, AX                 { V BX je offset prvniho bodu cary }

        mov     AX, DS                 { Do ES presuneme DS }
        mov     ES, AX

        mov     AX, VRAMSegment        { Segment obrazove pameti do DS }
        mov     DS, AX
        mov     DX, GraphicsAR            { Port adresoveho registru grafickeho kontroleru }
        mov     AX, ModeRegister + $0200  { Nastavi zapisovaci mod 2 }
        out     DX, AX

        mov     AL, DataRotate            { Nastavi zpusob kombinace dat z CPU }
        mov     AH, ES: WriteMode         { s latch-registry }
        out     DX, AX

        and     CX, ModMask             { CX = X1 and 7 }
        mov     AH, BMask               { AH = 80h, tj. nastaven je levy pixel }
        shr     AH, CL                  { Rotace AH. Po rotaci je v AH bitova maska bodu }

        mov     DX, BP                  { Uchova znamenka deltax a deltay v DX }

        mov     CX, DI                  { CX = deltax }
        inc     CX                      { CX = deltax - 1, tj. pocet bodu na care }
                                        { Vypocet predikce do BP: }
        shl     SI, 1                   { SI = 2*deltay }
        mov     BP, SI                  { BP = 2*deltay }
        sub     BP, DI                  { BP = 2*deltax - deltay }
        shl     DI, 1                   { DI = 2*deltax }

        mov     ES: delta, DI           { Ulozeni hodnoty 2*deltax }

        mov     DI, BX                  { Do DI offset adresy 1. bodu }

        test    DX, neg_dy              { Urceni smeru }
        pushf                           { Uchovani flagu }
        mov     DX, GraphicsAR          { Nastavi index graf. kontroleru na Bit mask reg. }
        mov     AL, BitMask
        out     DX, AL
        inc     DX                      { DX = datovy port graf. kontroleru }
        popf                            { Obnovi flagy s vysledkem testu smeru }
        jnz     @hor_neg_dy_init        { Rozskok, podle znamenka smernice }

  @hor_pos_dy_init:                     { Kladna smernice, y souradnice je zvysovana }
        mov     BL, ES: ActColor        { BL = Barva cary }
        mov     BH, BL                  { BH = Barva cary }
        mov     AL, AH                  { AL = Bitova maska prvniho bodu }

  @hor_pos_dy:
        cmp      BP, 0                  { Test predikce }
        jng      @hor_pos_dy_L1
        out      DX, AL                 { predikce >= 0 }
        mov      BL, BH                 { BL = Barva bodu }
        xchg     [DI], BL               { Nakresli bod }
        xor      AL, AL                 { Vynuluje stradanou masku }
        sub      BP, ES: delta          { Upravi predikaci P = P - 2*deltax }
        add      DI, BytesPerRow        { Zvetseni y souradnice }
  @hor_pos_dy_L1:
        add      BP, SI                 { Uprava predikce P = P + 2*deltay }
        ror      AH, 1                  { Zvetseni x souradnice }
        jc       @hor_pos_dy_L2         { Presahli jsme jeden byte ? }
        or       AL, AH                 { Uprav masku byte }
        loop     @hor_pos_dy            { Dalsi bod }
        jmp      @hor_pos_dy_lastbyte   { Dosli jsme do koncoveho bodu }
  @hor_pos_dy_L2:
        out      DX, AL                 { Nastavi novou bitovou masku }
        mov      BL, BH
        xchg     [DI], BL               { Nakresli body jednoho byte }
        mov      AL, AH                 { Inicializuje bitovou masku }
        inc      DI                     { Zvetsi x souradnici }
        loop     @hor_pos_dy            { Byl to posledni bod ? }
        jmp      @l_done                {        => konec kresleni cary }
  @hor_pos_dy_lastbyte:
        xor      AL, AH                 { Posledni bit je neplatny, odstranit }
        out      DX, AL                 { Nastaveni bitove masky }
        mov      BL, BH                 { BL = Barva cary }
        xchg     [DI], BL               { Nakresleni bodu }
        jmp      @l_done                { Ukonceni kresleni cary }

  @hor_neg_dy_init:                     { Zaporna smernice, y souradnice je zmensovana }
        mov     BL, ES: ActColor        { BL = Barva cary }
        mov     BH, BL                  { BH = Barva cary }
        mov     AL, AH                  { AL = Bitova maska prvniho bodu }

  @hor_neg_dy:
        cmp      BP, 0                  { Test predikce }
        jng      @hor_neg_dy_L1
        out      DX, AL                 { predikce >= 0 }
        mov      BL, BH                 { BL = Barva bodu }
        xchg     [DI], BL               { Nakresli bod }
        xor      AL, AL                 { Vynuluje stradanou masku }
        sub      BP, ES: delta          { Upravi predikaci P = P - 2*deltax }
        sub      DI, BytesPerRow        { Zmenseni y souradnice }
  @hor_neg_dy_L1:
        add      BP, SI                 { Uprava predikce P = P + 2*deltay }
        ror      AH, 1                  { Zvetseni x souradnice }
        jc       @hor_neg_dy_L2         { Presahli jsme jeden byte ? }
        or       AL, AH                 { Uprav masku byte }
        loop     @hor_neg_dy            { Dalsi bod }
        jmp      @hor_neg_dy_lastbyte   { Dosli jsme do koncoveho bodu }
  @hor_neg_dy_L2:
        out      DX, AL                 { Nastavi novou bitovou masku }
        mov      BL, BH
        xchg     [DI], BL               { Nakresli body jednoho byte }
        mov      AL, AH                 { Inicializuje bitovou masku }
        inc      DI                     { Zvetsi x souradnici }
        loop     @hor_neg_dy            { Byl to posledni bod ? }
        jmp      @l_done                {        => konec kresleni cary }
  @hor_neg_dy_lastbyte:
        xor      AL, AH                 { Posledni bit je neplatny, odstranit }
        out      DX, AL                 { Nastaveni bitove masky }
        mov      BL, BH                 { BL = Barva cary }
        xchg     [DI], BL               { Nakresleni bodu }
        jmp      @l_done                { Ukonceni kresleni cary }


  @vertical_dir:                        { Vypocet adresy 1. bodu }
        test    BP, neg_dy              { Kreslime shora dolu ? }
        jz      @vert_init
        xchg    AX, CX                  { Prohozeni souradnic }
        xchg    BX, DX
        xor     BP, neg_dx              { Uprava znamenka }

  @vert_init:
        mov     CX, AX                  { CX = X1 }
        xchg    AX, BX                  { AX = Y1, BX = X1 }
        mov     DX, BytesPerRow         { DX = Pocet byte na radku (80) }
        mul     DX                      { AX:DX = Y1 * 80 }
        shr     BX, PixelsPerByte       { BX = X1 div 8 }
        add     BX, AX                  { BX = Offset adresy 1. bodu }

        mov     AX, DS                  { Ulozi datovy segment do ES }
        mov     ES, AX

        mov     AX, VRAMSegment         { DS = Segment obrazove pameti }
        mov     DS, AX
        mov     DX, GraphicsAR             { Port adresoveho registru graf. kontroleru }
        mov     AX, ModeRegister + $0200   { Nastavi zapisovaci mod 2 }
        out     DX, AX

        mov     AL, DataRotate          { Nastaveni zpusobu kombinovani dat z CPU }
        mov     AH, ES: WriteMode       { s latch-registry                        }
        out     DX, AX

        and     CX, ModMask             { CX = X1 and 7 }
        mov     AH, BMask               { Bitova maska pro levy bod (80h) }
        shr     AH, CL                  { Rotaci vytvori spravnou masku }

        mov     DX, BP                  { Ulozi znamenka do DX }

        mov     CX, SI                  { CX = Delka cary }
        inc     CX
                                        { Urceni predikace }
        shl     DI, 1                   { DI = 2*deltax }
        add     BP, DI                  { BP = 2*deltax }
        sub     BP, SI                  { BP = 2*deltax - deltay }
        shl     SI, 1                   { SI = 2*deltay }

        mov     ES: delta, SI           { ulozi 2*deltay }
        mov     SI, DI                  { SI = 2*deltax }

        mov     DI, BX                  { DI = Offset adresy 1. bodu }

        test    DX, neg_dx              { Zjisteni smeru }
        mov     DX, GraphicsAR          { DX = adresovy port graf. kontroleru }
        jnz     @vert_neg_dx_init       { Rozskok podle znamenka smernice }

  @vert_pos_dx_init:                    { Kladna smernice }
        mov     BL, ES: ActColor        { BL = Barva cary }
        mov     BH, BL                  { BH = Barva cary }
        mov     AL, BitMask             { Index Bit mask registru }
        out     DX, AX
        inc     DX                      { DX = datovy registr graf. kontroleru }
        mov     AL, AH                  { AL = Bitova maska }

  @vert_pos_dx:
        mov     BL, BH                  { BL = Barva cary }
        xchg    [DI], BL                { Nakresli bod }
        cmp     BP, 0                   { Test predikce }
        jng     @vert_pos_dx_L1
        sub     BP, ES: delta           { P >= 0, P = P - 2*deltay }
        ror     AL, 1                   { Zvys souradnici x }
        adc     DI, 0                   { Presun do dalsiho byte }
        out     DX, AL                  { Nastav novou bitovou masku }

  @vert_pos_dx_L1:
        add     BP, SI                  { P = P + 2*deltax }
        add     DI, BytesPerRow         { Zvys souradnici y }
        loop    @vert_pos_dx            { Dalsi bod }
        jmp     @l_done                 { Konec cary }

  @vert_neg_dx_init:                    { Zaporna smernice }
        mov     BL, ES: ActColor        { BL = Barva cary }
        mov     BH, BL                  { BH = Barva cary }
        mov     AL, BitMask             { Index Bit mask registru }
        out     DX, AX
        inc     DX                      { DX = datovy registr graf. kontroleru }
        mov     AL, AH                  { AL = Bitova maska }

  @vert_neg_dx:
        mov     BL, BH                  { BL = Barva cary }
        xchg    [DI], BL                { Nakresli bod }
        cmp     BP, 0                   { Test predikce }
        jng     @vert_neg_dx_L1
        sub     BP, ES: delta           { P >= 0, P = P - 2*deltay }
        rol     AL, 1                   { Zmensi souradnici x }
        sbb     DI, 0                   { Presun do dalsiho byte }
        out     DX, AL                  { Nastav novou bitovou masku }

  @vert_neg_dx_L1:
        add     BP, SI                  { P = P + 2*deltax }
        add     DI, BytesPerRow         { Zvys souradnici y }
        loop    @vert_neg_dx            { Dalsi bod }
        jmp     @l_done                 { Konec cary }

  @l_done:
        mov     DX, GraphicsAR          { Smazani bitove masky }
        mov     AX, BitMask
        out     DX, AX
        mov     AX, ModeRegister
        out     DX, AX                  { Nastavi zapisovaci mod 0 }
        mov     AX, DataRotate
        out     DX, AX                  { Vypne rotyci dat, standardni kombinovani dat }

  @exit:
        pop      DS                     { Obnovi obsah registru DS }
        pop      BP                     {                       BP }
end;
*)

procedure Rectangle(X1,Y1,X2,Y2:word);
begin
 Line(X1,Y1,X2,Y1);
 Line(X1,Y2,X2,Y2);
 Line(X1,Y1,X1,Y2);
 Line(X2,Y1,X2,Y2);
end;

procedure Bar(X1,Y1,X2,Y2:word);
var X,Y:word;
begin
 for Y:=Y1 to Y2 do
  for X:=X1 to X2 do PutPixel(X,Y,C_O_L);
end;

{== Pictures ==}

procedure ShowPicture_PCX(F:string;DX,DY:word;var XLn,YLn:word);
var q                    : file;
    b                    : array[0..2047] of byte;
    anz,pos,c,w,h,e,pack : word;
    x,y,n                : word;
    a                    : byte;
    palette: array [0..767] of byte;
LABEL end_background;
BEGIN
  x := 0; y := 0;
  ASSIGN(q, f); {$I-} RESET(q, 1); {$I+}
  IF IORESULT <> 0 THEN
    GOTO end_background;
  BLOCKREAD(q, b, 128, anz);
  IF (b[0] <> 10) OR (b[3] <> 8) THEN
  BEGIN
    CLOSE(q);
    EXIT;
  END;
  w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]);
  h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]);
  XLn:=w-1;
  pack := 0; c := 0; e := y + h;
  seek(q,filesize(q)-769);
  blockread(q,a,1);
  if a=12 then  {paleta}
  begin
   blockread(q,palette,768);
   seek(q,128);
   if BitsPix<=8 then
   begin
    for n:=0 to 767 do
     palette[n]:=palette[n] shr 2;
    for n:=0 to 255 do SetPal(n,palette[n*3],palette[n*3+1],palette[n*3+2]);
   end;
  end;
  REPEAT
    BLOCKREAD(q, b, 2048, anz);
    pos := 0;
    WHILE (pos < anz) AND (y < e) DO
    BEGIN
      IF pack <> 0 THEN
      BEGIN
        FOR c := c TO c + pack DO
          if BitsPix<=1 then putpixel(x + c+dx, y+dy, b[pos])
           else PutPixelRGB(X+C+DX,Y+DY,Palette[B[Pos]*3],Palette[B[Pos]*3+1],Palette[B[Pos]*3+2]);
        pack := 0;
      END
      ELSE
        IF (b[pos] AND $C0) = $C0 THEN
          pack := b[pos] AND $3F
        ELSE
        BEGIN
          if BitsPix<=1 then putpixel(x + c+dx, y+dy, b[pos])
           else PutPixelRGB(X+C+DX,Y+DY,Palette[B[Pos]*3],Palette[B[Pos]*3+1],Palette[B[Pos]*3+2]);
          INC(c);
        END;
      INC(pos);
      IF c = w THEN
      BEGIN
        c := 0;
        INC(y);
      END;
    END;
  UNTIL (anz = 0) OR (y = e);
  YLn:=e;
  XLn:=XLn+1;
  SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);
  BLOCKREAD(q, b, 3 SHL 8 + 1);
  IF b[0] = 12 THEN
    FOR x := 1 TO 3 SHL 8 + 1 DO
      b[x] := b[x] SHR 2;
  CLOSE(q);
  end_background:
END;

procedure ShowPicture_VGA(FileName:string;X,Y:word;var XL,YL:word);
var C1,C2  :word;
    C      :byte;
    FHead  :VGA_Header;
    FPal   :VGA_Palette;
    F      :file;
begin
 Assign(F,FileName);
 {$I-} Reset(F,1); {$I+}
 if IOResult<>0 then
 begin
  XL:=65535;
  YL:=1;
  Exit;
 end;
 BlockRead(F,FHead,SizeOf(VGA_Header));
 BlockRead(F,FPal,SizeOf(VGA_Palette));
 if BitsPix<=8 then
 begin
  C1:=Seg(FPal);
  C2:=Ofs(FPal);
  asm
   MOV AH,10H
   MOV AL,12H
   MOV ES,C1
   MOV DX,C2
   MOV BX,0
   MOV CX,256
   INT 10H
  end;
 end;
 with FHead do
 begin
  XL:=(XLen[0]+XLen[1]*256)-1;
  YL:=(YLen[0]+YLen[1]*256)-1;
  if BitsPix<=8 then
  begin
   for C2:=0 to (YLen[0]+YLen[1]*256)-1 do
    for C1:=0 to (XLen[0]+XLen[1]*256)-1 do
    begin
     BlockRead(F,C,1);
     PutPixel(C1+X,C2+Y,C);
    end;
  end
  else
  begin
   for C2:=0 to (YLen[0]+YLen[1]*256)-1 do
    for C1:=0 to (XLen[0]+XLen[1]*256)-1 do
    begin
     BlockRead(F,C,1);
     PutPixelRGB(C1+X,C2+Y,FPal[C].R shl 2,FPal[C].G shl 2,FPal[C].B shl 2);
    end;
  end;
 end;
 Close(F);
end;

{$IFDEF DPMI}
procedure ShowBackGround(FileName:string);
var PPtr   :array[0..768]of pointer;
    C,C1,C2:word;
    FHead  :VGA_Header;
    FPal   :VGA_Palette;
    F      :file;
    XL,YL  :word;
    TH     :THandle;
    X,Y    :word;
    RS     :word;
    XZ,YZ  :word;
    NX,NY  :word;
    MaxX,MaxY:word;
begin
 Assign(F,FileName);
 {$I-} Reset(F,1); {$I+}
 if IOResult<>0 then
  Exit;
 BlockRead(F,FHead,SizeOf(VGA_Header));
 BlockRead(F,FPal,SizeOf(VGA_Palette));
 if BitsPix<=8 then
 begin
  C1:=Seg(FPal);
  C2:=Ofs(FPal);
  asm
   MOV AH,10H
   MOV AL,12H
   MOV ES,C1
   MOV DX,C2
   MOV BX,0
   MOV CX,256
   INT 10H
  end;
 end;
 with FHead do
 begin
  XL:=(XLen[0]+XLen[1]*256);
  YL:=(YLen[0]+YLen[1]*256);
 end;
 for C:=0 to YL-1 do
 begin
  PPtr[C]:=GlobalAllocPtr(0,XL);
  BlockRead(F,PPtr[C]^,XL);
 end;
 Close(F);
 if BitsPix<=8 then
 begin
  for Y:=0 to YLength-1 do
  begin
   RS:=Seg(PPtr[Y mod YL]^);
   for X:=0 to XLength-1 do
   begin
    PutPixel(X,Y,Mem[RS:X mod XL]);
   end;
  end;
 end
 else
 begin
  for Y:=0 to YLength-1 do
  begin
   RS:=Seg(PPtr[Y mod YL]^);
   for X:=0 to XLength-1 do
   begin
    C:=Mem[RS:X mod XL];
    PutPixelRGB(X,Y,FPal[C].R shl 2,FPal[C].G shl 2,FPal[C].B shl 2);
   end;
  end;
 end;
 for C:=0 to YL-1 do TH:=GlobalFreePtr(PPtr[C]);
end;
{$ENDIF}

procedure SelSysDir(SysDir:string);
begin
 SysDirectory:=SysDir;
end;

procedure SetDisk(Disk:string);
var Reg:registers;
begin
 with Reg do
 begin
  AH:=$0E;
  DL:=Ord(UpCase(Disk[1]))-65;;
 end;
 Intr($21,Reg);
end;

procedure SetSysDir;
var SD:string;
begin
 SD:=Copy(SysDirectory,3,Length(SysDirectory)-2);
 SetDisk(SysDirectory);
 {$I-} ChDir(SD); {$I+}
end;

function  InputNum(X,Y,WinSize,MaxNum:word;var Num:word):boolean;
var N1:word;
    Key:char;
    Str1:string;
    MX,MY:word;
    IORes:integer;
function CharToNum(Char1:char):byte;
var N:byte;
begin
 N:=Ord(Char1)-48;
 CharToNum:=N;
end;
procedure ClearArea;
begin
 SetColor(0);
 Bar(X-1,Y-1,X+WinSize+1,Y+GetTextHight+1);
end;
procedure WSWC;
begin
 ClearArea;
 OutTextXY(X,Y,Str1);
end;
procedure HideC;
begin
 SetColor(0);
 Line(X+GetTextWidth(Str1),Y,X+GetTextWidth(Str1),Y+GetTextHight);
 WSWC;
end;
procedure ShowC;
begin
 case BitsPix of
     1:SetColor(1);
     2:SetColor(3);
  4, 8:SetColor(15);
    16:SetColor(65535);
 end;
 Line(X+GetTextWidth(Str1),Y,X+GetTextWidth(Str1),Y+GetTextHight);
end;
procedure WS;
begin
 ClearArea;
 OutTextXY(X,Y,Str1);
 ShowC;
end;
begin
(* {$I-} Chdir('SYS'); {$I+}*)
 SetSysDir;
 IORes:=IOResult;
 LoadFont(InPutFont);
(* if IORes=0 then {$I-} ChDir('..'); {$I+}*)
 SetTextJustify(LeftText,TopText,0);
 SetTextSize(T_OriginalSize);
 case BitsPix of
     1:SetTextColor(1);
     2:SetTextColor(3);
  4, 8:SetTextColor(15);
    16:SetTextColor(65535);
 end;
 if MaxNum=0 then MaxNum:=65535;
 N1:=Num;
 ClearArea;
 Str(N1,Str1);
 WS;
 repeat
  Key:=ReadKey;
  if Key in ['0'..'9'] then
  begin
   if N1*10+CharToNum(Key)<=MaxNum then
    N1:=N1*10+CharToNum(Key);
   Str(N1,Str1);
   WS;
  end;
  if Key=#8 then
  begin
   if N1>9 then
    N1:=N1 div 10
   else N1:=0;
   Str(N1,Str1);
   WS;
  end;
 until Key in [#13,#27];
 if Key=#13 then
 begin
  InputNum:=true;
  Num:=N1;
 end
 else InputNum:=false;
 HideC;
end;

function  InputStr(X,Y,WinSize:word;MaxLen:byte;var S:string):boolean;
var Znak,Znak1:char;   {Zmacknute klavesy}
    MyStr:string;      {Stary text}
    PosIn:word;        {Pozice kurzoru v retezci}
    FirstInW:word;     {Prvni znak v okne}
    IsFirst:boolean;
    IORes:integer;
function InWindowL(IS:string;IB:byte):string;
var IWB:byte;
begin
 IWB:=0;
 while (GetTextWidth(Copy(IS,IB,IWB+1))<WinSize) and (IWB<Length(IS)) do IWB:=IWB+1;
 InWindowL:=Copy(IS,IB,IWB);
end;
function InWindowR(IS:string;IE:byte):string;
var IWB:byte;
begin
 IWB:=IE;
 while (GetTextWidth(Copy(IS,IWB-1,IE-IWB+2))<WinSize) and (IWB>1) do IWB:=IWB-1;
 InWindowR:=Copy(IS,IWB,IE-IWB+1);
end;
procedure ClearArea;
begin
 SetColor(0);
 Bar(X-1,Y-1,X+WinSize+1,Y+GetTextHight+1);
end;
procedure WSWC;
var
    WS:string;
begin
 WS:=InWindowL(S,FirstInW);
 ClearArea;
 if IsFirst then
 begin
  SetColor(0);
  Bar(X-1,Y,X+GetTextWidth(WS),Y+GetTextHight);
 end;
 OutTextXY(X,Y,WS);
end;
procedure HideC;
var
    WS:string;
begin
 WS:=Copy(S,FirstInW,PosIn-FirstInW);
 SetColor(0);
 Line(X+GetTextWidth(WS),Y,X+GetTextWidth(WS),Y+GetTextHight);
 WSWC;
end;
procedure ShowC;
var
    WS:string;
begin
 WS:=Copy(S,FirstInW,PosIn-FirstInW);
 case BitsPix of
     1:SetColor(1);
     2:SetColor(3);
  4, 8:SetColor(15);
    16:SetColor(65535);
 end;
 Line(X+GetTextWidth(WS),Y,X+GetTextWidth(WS),Y+GetTextHight);
end;
procedure WriteStr;
var
    WS:string;
begin
 WS:=InWindowL(S,FirstInW);
 ClearArea;
 if IsFirst then
 begin
  case BitsPix of
      1:SetColor(128);
      2:SetColor(2);
   4, 8:SetColor(1);
     16:SetColor(15);
  end;
  Bar(X-1,Y,X+GetTextWidth(WS),Y+GetTextHight);
 end;
 OutTextXY(X,Y,WS);
 ShowC;
end;
procedure KDoleva;
begin
 if PosIn=1 then Exit;
 if PosIn>FirstInW then
 begin
  HideC;
  PosIn:=PosIn-1;
  ShowC;
 end
 else
 begin
  FirstInW:=FirstInW-1;
  PosIn:=PosIn-1;
  WriteStr;
 end;
end;
procedure KDoprava;
begin
 if (PosIn=Length(S)+1) then Exit;
 if Length(InWindowL(S,FirstInW))>PosIn-FirstInW then
 begin
  HideC;
  PosIn:=PosIn+1;
  ShowC;
 end
 else
 begin
  FirstInW:=FirstInW+1;
  PosIn:=PosIn+1;
  WriteStr;
 end;
end;
procedure NaZacatek;
begin
 if (PosIn=1) and (FirstInW=1) then Exit;
 if FirstInW=1 then
 begin
  HideC;
  PosIn:=1;
  ShowC;
 end
 else
 begin
  FirstInW:=1;
  PosIn:=1;
  WriteStr;
 end;
end;
procedure NaKonec;
begin
 if (PosIn=Length(S)+1) then Exit;
 PosIn:=Length(S)+1;
 FirstInW:=Length(S)-Length(InWindowR(S,PosIn-1))+1;
 WriteStr;
end;
procedure MazVpravo;
begin
 if (PosIn=Length(S)+1) then Exit;
 Delete(S,PosIn,1);
 WriteStr;
end;
procedure MazVlevo;
begin
 if (PosIn=1) then Exit;
 Delete(S,PosIn-1,1);
 if FirstInW=PosIn then
 begin
  FirstInW:=FirstInW-1;
 end;
 PosIn:=PosIn-1;
 WriteStr;
end;
procedure ObnovStary;
begin
 S:=MyStr;
 NaKonec;
end;
procedure Smaz;
begin
 S:='';
 NaKonec;
end;
procedure VlozZnak;
begin
 if Length(S)=MaxLen then Exit;
 S:=Copy(S,1,PosIn-1)+Znak+Copy(S,PosIn,Length(S)-PosIn+1);
 if Length(InWindowL(S,FirstInW))>PosIn-FirstInW then
 begin
  PosIn:=PosIn+1;
 end
 else
 begin
  FirstInW:=FirstInW+1;
  PosIn:=PosIn+1;
 end;
 WriteStr;
end;
begin
 {Nastaveni fontu}
 IORes:=IOResult;
(* {$I-} Chdir('SYS'); {$I+}*)
 SetSysDir;
 LoadFont(InPutFont);
(* if IORes=0 then {$I-} ChDir('..'); {$I+}*)
 SetTextSize(T_OriginalSize);
 SetTextJustify(LeftText,TopText,0);
 case BitsPix of
     1:SetTextColor(1);
     2:SetTextColor(3);
  4, 8:SetTextColor(15);
    16:SetTextColor(65535);
 end;
 {Inicializace}
 PosIn := 0;
 IsFirst:=true;
 X:=X+1;
 Y:=Y+1;
 WinSize:=WinSize-2;
 MyStr:=S;
 NaKonec;
 Znak:=ReadKey;
 if Znak=#0 then Znak1:=ReadKey else Znak1:=#0;
 if Znak>#0 then
 begin
  if Znak in [#8,#32..#255] then Smaz;
 end
 else
 begin
  if Znak1 in [#83] then Smaz;
 end;
 IsFirst:=false;
 while (Znak<>#13) and (Znak<>#27) do
 begin
  if Znak=#0 then
  case Znak1 of
   #75:KDoleva;
   #77:KDoprava;
   #71:NaZacatek;
   #79:NaKonec;
   #83:MazVpravo;
  end
  else
  case Znak of
   #8:MazVlevo;
{   #18:ObnovStary;}
   else
    if (Znak in [#32..#255]) then VlozZnak;
  end;
  Znak:=ReadKey;
  if Znak=#0 then Znak1:=ReadKey else Znak1:=#0;
 end;
 if Znak=#13 then
 begin
  InputStr:=true;
 end
 else
 begin
  InputStr:=false;
  S:=MyStr;
 end;
 HideC;
end;

procedure WaitPressed;
var MouseX,MouseY,Sel:word;
    Key:char;
begin
 repeat
 if Wait_Vis then  G_ShowMouse;
  SelMouse(MouseX,MouseY,Sel);
 until ((Sel<>0) or (KeyPressed));
 if KeyPressed then
 begin
  Key:=ReadKey;
  if Key=#0 then Key:=ReadKey;
 end;
 if Wait_Vis then G_HideMouse;
end;

procedure G_ShowMouse;
var X,Y:word;
    NewX,NewY:word;
begin
 NewX:=GetMouseX;
 NewY:=GetMouseY;
 if ((NewX=OldX) and (NewY=OldY) and (Visible)) then Exit;
 if Visible then G_HideMouse;
 for X:=0 to 15 do
  for Y:=0 to 15 do
  begin
   MousePos[Y,X]:=GetPixel(X+NewX-MouseX,Y+NewY-MouseY);
   if MouseCursor[Y,X] <> MouseBack then
    PutPixel(NewX+X-MouseX,NewY+Y-MouseY, MouseCursor[Y,X]);
  end;
 OldX:=NewX;
 OldY:=NewY;
 Visible:=true;
end;

procedure G_HideMouse;
var X,Y:word;
begin
 if NOT Visible then Exit;
 for X:=0 to 15 do
  for Y:=0 to 15 do
   PutPixel(OldX+X-MouseX,OldY+Y-MouseY,MousePos[Y,X]);
 Visible:=false;
end;

procedure SelMouse(var X,Y,Select:word);
var OS:word;
begin
 X:=GetMouseX;
 Y:=GetMouseY;
 Select:=ReturnPressedButton;
 if Select<>0 then
 begin
  OS:=Select;
  repeat
   X:=GetMouseX;
   Y:=GetMouseY;
   Select:=ReturnPressedButton;
  until Select=0;
  Select:=OS;
 end;
end;

function  IsMouseInstall:boolean;
begin
 IsMouseInstall:=InstallMouse;
end;


procedure SetOverUnder;
var C:integer;
begin
 OverLine:=Round(FileInfo.TopHight*TextSize/16);
 C:=FileInfo.QFrom;
 if C and 128<>0 then
 begin
  C:=-128+(C-128);
 end;
 UnderLine:=Round(C*TextSize/16);
end;

procedure LoadFont(FontFile:string);
var F:file;
begin
 if Loaded then
 begin
  FreeMem(TextPtr,FontSize);
  FreeMem(CharsOfsPtr,FileInfo.CharsCnt*2);
  FreeMem(CharsWidthPtr,FileInfo.CharsCnt);
  Loaded:=false;
 end;
 Assign(F,FontFile);
 {$I-} Reset(F,1); {$I+}
 if IOResult<>0 then Exit;
 BlockRead(F,Header,SizeOf(CHR_Header));
 BlockRead(F,FileInfo,SizeOf(CHR_FileInfo));
 FontSize:=FileSize(F)-(144+3*FileInfo.CharsCnt);
 GetMem(TextPtr,FontSize);
 GetMem(CharsOfsPtr,FileInfo.CharsCnt*2);
 GetMem(CharsWidthPtr,FileInfo.CharsCnt);
 BlockRead(F,CharsOfsPtr^,FileInfo.CharsCnt*2);
 BlockRead(F,CharsWidthPtr^,FileInfo.CharsCnt);
 BlockRead(F,TextPtr^,FontSize);
 Close(F);
 Loaded:=true;
 SetOverUnder;
end;

procedure FreeFont;
begin
 if Loaded then
 begin
  FreeMem(TextPtr,FontSize);
  FreeMem(CharsOfsPtr,FileInfo.CharsCnt*2);
  FreeMem(CharsWidthPtr,FileInfo.CharsCnt);
  Loaded:=false;
 end;
end;

procedure SetTextColor(ColorNum:word);
begin
 TextColor:=ColorNum;
end;

procedure SetTextSize(SizeNum:word);
begin
 TextSize:=SizeNum;
 SetOverUnder;
end;

procedure SetTextJustify(Xjust,YJust,Angle:integer);
begin
 JustifyX:=XJust;
 JustifyY:=YJust;
 Angle := Angle mod 360;
 if Angle < 0 then Angle := Angle+360;
 TextAngle := Angle;
end;

function GetTextHight:word;
var C:integer;
begin
 C:=FileInfo.QFrom;
 if C and 128<>0 then
 begin
  C:=-128+(C-128);
 end;
 GetTextHight:=Round((FileInfo.TopHight-C)*TextSize/16);
end;

function IsLoaded:boolean;
begin
 IsLoaded:=Loaded;
end;

function  GetTextWidth(UserText:string):word;
var X:word;
    Cnt:byte;
    Enlarget:real;
begin
 X:=0;
 Enlarget:=TextSize/16;
 for Cnt:=1 to Length(UserText) do
  X:=X+Round((CHR_CharsWidthArray(CharsWidthPtr^)[Ord(UserText[Cnt])-FileInfo.ASCIIFirst])*Enlarget);
 GetTextWidth:=X;
end;

procedure OutTextXY(XAxis,YAxis:word;UserText:string);
var ActX,ActY:word;
    Cnt,Cnt2:byte;
    R1,R2:byte;
    Enlarget:real;
    AddX, AddY:real;
function DoIt(B1,B2:byte):boolean; {je-li FALSE, konec znaku}
var O1,O2:byte;
    DIX,DIY:integer;
    MX,MY:word;
begin
 DoIt:=true;
 O1:=B1 and 128;
 B1:=B1-O1;
 if O1=128 then O1:=1;
 O2:=B2 and 128;
 B2:=B2-O2;
 if O2=128 then O2:=1;
 DIX:=B1;
 if B1 and 64<>0 then
 begin
  DIX:=-64+(DIX-64);
 end;
 DIX:=Round(DIX*Enlarget);
 DIY:=B2;
 if B2 and 64<>0 then
 begin
  DIY:=-64+(DIY-64);
 end;
 DIY:=Round(DIY*Enlarget);
 MX:=ActX;
 MY:=ActY;
 case O1 of
  0:DoIt:=false;
  1:begin
     if O2=1 then
     begin
      SetColor(TextColor);
      Line(ActX,ActY,XAxis+DIX,YAxis-DIY);
     end;
     ActX:=Word(XAxis+DIX);
     ActY:=Word(YAxis-DIY);
    end;
 end;
end;
begin
{ /aaa/
 AddX := Cos(Angle*180/Pi);
 AddY := Sin(Angle*180/Pi);}
 Enlarget:=TextSize/16;
 case JustifyX of
  1:XAxis:=XAxis-(GetTextWidth(UserText) div 2);
  2:XAxis:=XAxis-GetTextWidth(UserText);
 end;
 case JustifyY of
  0:YAxis:=YAxis+OverLine;
  1:YAxis:=YAxis+(OverLine div 2);
 end;
 for Cnt:=1 to Length(UserText) do
 begin
  Cnt2:=0;
  ActX:=XAxis;
  ActY:=YAxis;
  repeat
   R1:=CharsArray(TextPtr^)
    [CHR_CharsOfsArray(CharsOfsPtr^)[Ord(UserText[Cnt])-FileInfo.ASCIIFirst]+Cnt2];
   R2:=CharsArray(TextPtr^)
    [CHR_CharsOfsArray(CharsOfsPtr^)[Ord(UserText[Cnt])-FileInfo.ASCIIFirst]+Cnt2+1];
   Cnt2:=Cnt2+2;
  until DoIt(R1,R2)=false;
  XAxis:=XAxis+Round(
   (CHR_CharsWidthArray(CharsWidthPtr^)[Ord(UserText[Cnt])-FileInfo.ASCIIFirst])*Enlarget);
 end;
end;

{=== Jen pro 16-bit mody ===}
procedure Frame01(X1,Y1,X2,Y2:integer);
var C,Oc:word;
    IsMouse:boolean;
    X,Y:word;
    R,G,B:byte;
begin
 IsMouse:=IsMouseInstall;
 if IsMouse then G_HideMouse;
 Oc:=GetColor;
 SetColor(65535);
 Rectangle(X1,Y1,X2,Y2);
 for Y:=Y1+1 to Y2-1 do
  for X:=X1+1 to X2-1 do
  begin
   if ((X+Y) mod 2=1) then
   begin
    PutPixel(X,Y,0)
   end
   else
   begin
    GetPixelRGB(X,Y,R,G,B);
    R:=R div 2;
    G:=G div 2;
    B:=B div 2;
    PutPixelRGB(X,Y,R,G,B);
   end;
  end;
 SetColor(Oc);
end;

procedure ShowFrame(X1,Y1,X2,Y2:integer;FrameType:byte);
begin
 case FrameType of
  01:Frame01(X1,Y1,X2,Y2);
 end;
end;

{$IFDEF DPMI}
{=== Pozor: Pouze pro 16bit mody ===}
function ShowMessage(MsgType:byte;Message:string):char;
var X1,Y1,X2,Y2,X,Y:word;
    C,Color:word;
    BackWnd:ScreenT;
    MsgWnd:array[0..2]of ScreenT;
    Selected:char;
    IsMouse:boolean;
    MouseX,MouseY,PressedButton:word;
    MX1,MY1,MX2,MY2:word;
    MS:string;
    MsgStr:array[0..7]of string;
    MsgStrCnt:byte;
    R,G,B:byte;
begin
 IsMouse:=IsMouseInstall;
 if IsMouse then G_HideMouse;
 Color:=0;
 GetScreenMax(X,Y);
 X:=X div 2;
 Y:=Y div 2;
 X1:=X-100;
 X2:=X+100;
 Y1:=Y-50;
 Y2:=Y+50;
 BackWnd.Init(X1-50,Y1-49,X2+50,Y2+49,2);
 BackWnd.CopyTo;
 for Y:=Y1+1 to Y2-1 do
  for X:=X1+1 to X2-1 do
  begin
   if ((X+Y) mod 2=1) then
   begin
    PutPixel(X,Y,Color)
   end
   else
   begin
    GetPixelRGB(X,Y,R,G,B);
    R:=R div 2;
    G:=G div 2;
    B:=B div 2;
    PutPixelRGB(X,Y,R,G,B);
   end;
  end;
{ SetColor(Color);
 Bar(X1+1,Y1+1,X2-1,Y2-1);}
{ SetColor(44501);}
 SetColor(65535);
 Rectangle(X1,Y1,X2,Y2);
 for C:=0 to 2 do MsgWnd[C].Init(0,0,7,7,2);
 SetSysDir;
 LoadFont(InPutFont);
 SetTextSize(T_OriginalSize);
 SetTextJustify(CenterText,BottomText);
 SetTextColor(65535);
 case MsgType of
  Msg_Info:MsgWnd[0].Load('SM_00.CPF');
  Msg_Vystraha:MsgWnd[0].Load('SM_01.CPF');
  Msg_Chyba:MsgWnd[0].Load('SM_02.CPF');
  Msg_Otazka:MsgWnd[0].Load('SM_03.CPF');
 end;
 MsgWnd[1].Load('SM_B1.CPF');
 if MsgType in [Msg_Vystraha,Msg_Otazka] then MsgWnd[2].Load('SM_B2.CPF');
 X:=MsgWnd[0].GetMaxX;
 Y:=MsgWnd[0].GetMaxY;
 MsgWnd[0].SetScrBegin(X1+1-X div 2,Y1+1-Y div 2);
 MsgWnd[0].Show(false);
 MX1:=MsgWnd[1].GetMaxX;
 MY1:=MsgWnd[1].GetMaxY;
 MsgWnd[1].SetScrBegin(X1+1-MX1 div 2,Y2+1-MY1 div 2);
 MsgWnd[1].Show(false);
 if MsgType in [Msg_Vystraha,Msg_Otazka] then
 begin
  MX2:=MsgWnd[2].GetMaxX;
  MY2:=MsgWnd[2].GetMaxY;
  MsgWnd[2].SetScrBegin(X2+1-MX2 div 2,Y2+1-MY2 div 2);
  MsgWnd[2].Show(false);
 end;
 for C:=0 to 2 do MsgWnd[C].Done;
 {vypocet polohy textu}
 MsgStrCnt:=0;
 while Length(Message)>0 do
 begin
  MsgStrCnt:=MsgStrCnt+1;
  MsgStr[MsgStrCnt-1]:='';
  repeat
   if Pos(' ',Message)>0 then
   begin
    MsgStr[MsgStrCnt-1]:=MsgStr[MsgStrCnt-1]+Copy(Message,1,Pos(' ',Message));
    Delete(Message,1,Pos(' ',Message));
   end
   else
   begin
    MsgStr[MsgStrCnt-1]:=MsgStr[MsgStrCnt-1]+Message;
    Message:='';
   end;
  until (GetTextWidth(MsgStr[MsgStrCnt-1]+Copy(Message,1,Pos(' ',Message)))>=(X2-X1-1)) or (Length(Message)=0);
 end;
 for C:=0 to MsgStrCnt-1 do
  OutTextXY(((X2-X1+1) div 2+X1),
            ((Y2-Y1+1) div 2+Y1)-((MsgStrCnt)*GetTextHight div 2)+(C+1)*GetTextHight,MsgStr[C]);
 Selected:=#3;
 repeat
  if KeyPressed then
  begin
   Selected:=ReadKey;
   if Selected=#0 then ReadKey;
  end;
  if IsMouse then
  begin
   G_ShowMouse;
   MouseX:=GetMouseX;
   MouseY:=GetMouseY;
   PressedButton:=ReturnPressedButton;
   if PressedButton=1 then
   begin
    if ((MouseX>=(X1+1-MX1 div 2)) and (MouseX<=(X1+MX1 div 2))) and
    ((MouseY>=(Y2+1-MY1 div 2)) and (MouseY<=(Y2+MY1 div 2))) then Selected:=#13;
    if MsgType in [Msg_Vystraha,Msg_Otazka] then
     if ((MouseX>=(X2+1-MX2 div 2)) and (MouseX<=(X2+MX2 div 2))) and
     ((MouseY>=(Y2+1-MY2 div 2)) and (MouseY<=(Y2+MY2 div 2))) then Selected:=#27;
    repeat
     PressedButton:=ReturnPressedButton;
    until PressedButton=0;
   end;
  end;
 until Selected in [#13,#27];
 if IsMouse then G_HideMouse;
 BackWnd.Show(true);
 BackWnd.Done;
 ShowMessage:=Selected;
end;

function ShowInBox(BoxType:byte;BoxName:string;var InText:string):char;
var X1,Y1,X2,Y2,X,Y:word;
    C,Color:word;
    BackWnd:ScreenT;
    MsgWnd:array[0..2]of ScreenT;
    IsMouse:boolean;
    MX1,MY1,MX2,MY2:word;
    R,G,B:byte;
begin
 IsMouse:=IsMouseInstall;
 if IsMouse then G_HideMouse;
 Color:=0;
 GetScreenMax(X,Y);
 X:=X div 2;
 Y:=Y div 2;
 X1:=X-100;
 X2:=X+100;
 Y1:=Y-50;
 Y2:=Y+50;
 BackWnd.Init(X1-50,Y1-49,X2+50,Y2+49,2);
 BackWnd.CopyTo;
 for Y:=Y1+1 to Y2-1 do
  for X:=X1+1 to X2-1 do
  begin
   if ((X+Y) mod 2=1) then
   begin
    PutPixel(X,Y,Color)
   end
   else
   begin
    GetPixelRGB(X,Y,R,G,B);
    R:=R div 2;
    G:=G div 2;
    B:=B div 2;
    PutPixelRGB(X,Y,R,G,B);
   end;
  end;
 SetColor(65535);
 Rectangle(X1,Y1,X2,Y2);
 for C:=0 to 2 do MsgWnd[C].Init(0,0,7,7,2);
 SetSysDir;
 LoadFont(InPutFont);
 SetTextSize(T_OriginalSize);
 SetTextJustify(CenterText,CenterText);
 SetTextColor(65535);
 MsgWnd[0].Load('SM_03.CPF');
 MsgWnd[1].Load('SM_B1.CPF');
 MsgWnd[2].Load('SM_B2.CPF');
 X:=MsgWnd[0].GetMaxX;
 Y:=MsgWnd[0].GetMaxY;
 MsgWnd[0].SetScrBegin(X1+1-X div 2,Y1+1-Y div 2);
 MsgWnd[0].Show(false);
 MX1:=MsgWnd[1].GetMaxX;
 MY1:=MsgWnd[1].GetMaxY;
 MsgWnd[1].SetScrBegin(X1+1-MX1 div 2,Y2+1-MY1 div 2);
 MsgWnd[1].Show(false);
 MX2:=MsgWnd[2].GetMaxX;
 MY2:=MsgWnd[2].GetMaxY;
 MsgWnd[2].SetScrBegin(X2+1-MX2 div 2,Y2+1-MY2 div 2);
 MsgWnd[2].Show(false);
 for C:=0 to 2 do MsgWnd[C].Done;
 OutTextXY(X1+(X2-X1) div 2,Y1+10+GetTextHight,BoxName);
 if InputStr(X1+8,Y1+(Y2-Y1) div 2-8,X2-X1-15,BoxType,InText) then
  ShowInBox:=#13 else ShowInBox:=#27;
 BackWnd.Show(true);
 BackWnd.Done;
end;

function ShowNumBox(BoxType:word;BoxName:string;var InNum:word):char;
var X1,Y1,X2,Y2,X,Y:word;
    C,Color:word;
    BackWnd:ScreenT;
    MsgWnd:array[0..2]of ScreenT;
    IsMouse:boolean;
    MX1,MY1,MX2,MY2:word;
    R,G,B:byte;
begin
 IsMouse:=IsMouseInstall;
 if IsMouse then G_HideMouse;
 Color:=0;
 GetScreenMax(X,Y);
 X:=X div 2;
 Y:=Y div 2;
 X1:=X-100;
 X2:=X+100;
 Y1:=Y-50;
 Y2:=Y+50;
 BackWnd.Init(X1-50,Y1-49,X2+50,Y2+49,2);
 BackWnd.CopyTo;
 for Y:=Y1+1 to Y2-1 do
  for X:=X1+1 to X2-1 do
  begin
   if ((X+Y) mod 2=1) then
   begin
    PutPixel(X,Y,Color)
   end
   else
   begin
    GetPixelRGB(X,Y,R,G,B);
    R:=R div 2;
    G:=G div 2;
    B:=B div 2;
    PutPixelRGB(X,Y,R,G,B);
   end;
  end;
 SetColor(65535);
 Rectangle(X1,Y1,X2,Y2);
 for C:=0 to 2 do MsgWnd[C].Init(0,0,7,7,2);
 SetSysDir;
 LoadFont(InPutFont);
 SetTextSize(T_OriginalSize);
 SetTextJustify(CenterText,CenterText);
 SetTextColor(65535);
 MsgWnd[0].Load('SM_03.CPF');
 MsgWnd[1].Load('SM_B1.CPF');
 MsgWnd[2].Load('SM_B2.CPF');
 X:=MsgWnd[0].GetMaxX;
 Y:=MsgWnd[0].GetMaxY;
 MsgWnd[0].SetScrBegin(X1+1-X div 2,Y1+1-Y div 2);
 MsgWnd[0].Show(false);
 MX1:=MsgWnd[1].GetMaxX;
 MY1:=MsgWnd[1].GetMaxY;
 MsgWnd[1].SetScrBegin(X1+1-MX1 div 2,Y2+1-MY1 div 2);
 MsgWnd[1].Show(false);
 MX2:=MsgWnd[2].GetMaxX;
 MY2:=MsgWnd[2].GetMaxY;
 MsgWnd[2].SetScrBegin(X2+1-MX2 div 2,Y2+1-MY2 div 2);
 MsgWnd[2].Show(false);
 for C:=0 to 2 do MsgWnd[C].Done;
 OutTextXY(X1+(X2-X1) div 2,Y1+10+GetTextHight,BoxName);
 if InputNum(X1+8,Y1+(Y2-Y1) div 2-8,X2-X1-15,BoxType,InNum) then
  ShowNumBox:=#13 else ShowNumBox:=#27;
 BackWnd.Show(true);
 BackWnd.Done;
end;
{$ENDIF}

procedure ShowPicture_CPF(F:string;DX,DY:word);
const CPFHeader:array[0..1]of byte=(Ord('C'),Ord('P'));
var sF:file;
    C,N,CX,CY:word;
    P:pointer;
    X, Y:word;
    sBpp:byte;
begin
 Assign(sF, F);
 {$I-} Reset(sF,1); {$I+}
 if IOResult=0 then
 begin
  BlockRead(sF,CX,1,N);
  BlockRead(sF,CY,1,N);
  BlockRead(sF,X,2,N);
  BlockRead(sF,Y,2,N);
  BlockRead(sF,C,2,N);
  sBpp := C*8;
  GetMem(P, (X+1)*(sBpp div 8));
  for C:=0 to Y do
  begin
   BlockRead(sF, P^, (X+1)*(sBpp div 8), N);
   case sBpp of
     8:for CX := 0 to X-1 do PutPixel(CX, Y, Mem[Seg(P^):Ofs(P^)+CX]);
    16:for CX := 0 to X do PutPixel(CX, C, MemW[Seg(P^):Ofs(P^)+CX*2]);
   end;
  end;
  FreeMem(P, (X+1)*(sBpp div 8));
  Close(sF);
 end;
end;

{==========================================================================}

{================================Objekty===================================}

{ $IFDEF DPMI}
constructor ScreenT.Init(iX1,iY1,iX2,iY2,iCB:word);
var C:word;
    P:pointer;
begin
 X1:=iX1;
 Y1:=iY1;
 X2:=iX2;
 Y2:=iY2;
 S_Bp:=iCB;
 GetMem(PtrArray, (Y2-Y1+1)*4);
 for C:=0 to Y2-Y1 do
  GetMem(PtrArrayT(PtrArray^)[C], (X2-X1+1)*(S_Bp div 8));
 if S_Bp<16 then GetMem(RGBPtr, 768);
end;

destructor ScreenT.Done;
var C:word;
    P:pointer;
begin
 for C:=0 to Y2-Y1 do
  FreeMem(PtrArrayT(PtrArray^)[C], (X2-X1+1)*(S_Bp div 8));
 FreeMem(PtrArray, (Y2-Y1+1)*4);
 if S_Bp<16 then FreeMem(RGBPtr, 768);
end;

procedure ScreenT.SetScrBegin(XBegin,YBegin:word);
begin
 X2:=X2-X1;
 Y2:=Y2-Y1;
 X1:=XBegin;
 Y1:=YBegin;
 X2:=X1+X2;
 Y2:=Y1+Y2;
end;

procedure ScreenT.SetRGB;
var C:byte;
    RGBS:word;
begin
 if S_Bp>8 then Exit;
 RGBS:=Seg(RGBPtr^);
 asm
  MOV AH,10H
  MOV AL,12H
  MOV ES,RGBS
  MOV DX,00H
  MOV BX,0
  MOV CX,256
  INT 10H
 end;
end;

procedure ScreenT.GetRGB;
var C:byte;
    RGBS:word;
begin
 if S_Bp>8 then Exit;
 RGBS:=Seg(RGBPtr^);
 asm
  MOV AH,10H
  MOV AL,17H
  MOV ES,RGBS
  MOV DX,00H
  MOV BX,0
  MOV CX,256
  INT 10H
 end;
end;

procedure ScreenT.PutTo(X,Y,Color:word);
var P:pointer;
begin
 if S_Bp=8 then Mem[Seg(PtrArrayT(PtrArray^)[Y]^):X]:=Color
 else MemW[Seg(PtrArrayT(PtrArray^)[Y]^):X*(S_Bp div 8)]:=Color;
end;

function ScreenT.GetFrom(X,Y:word):word;
var P:pointer;
begin
 if S_Bp=8 then GetFrom:=Mem[Seg(PtrArrayT(PtrArray^)[Y]^):X]
 else GetFrom:=MemW[Seg(PtrArrayT(PtrArray^)[Y]^):X*(S_Bp div 8)];
end;

procedure ScreenT.Show(Jak:boolean);
var X,Y,C:word;
begin
 if S_Bp<16 then SetRGB;
 for Y:=0 to Y2-Y1 do
  for X:=0 to X2-X1 do
  begin
   if S_Bp=8 then C:=Mem[Seg(PtrArrayT(PtrArray^)[Y]^):X]
   else C:=MemW[Seg(PtrArrayT(PtrArray^)[Y]^):X*(S_Bp div 8)];
   if (C<>0) or Jak then PutPixel(X+X1,Y+Y1,C);
  end;
end;

procedure ScreenT.Hide;
var X,Y:word;
begin
 for Y:=0 to Y2-Y1 do
  for X:=0 to X2-X1 do
   PutPixel(X+X1,Y+Y1,0);
end;

procedure ScreenT.CopyTo;
var X,Y:word;
begin
 if S_Bp<16 then GetRGB;
 for Y:=0 to Y2-Y1 do
  for X:=0 to X2-X1 do
   PutTo(X,Y,GetPixel(X+X1,Y+Y1));
end;

procedure ScreenT.GetPtrArray(var GPA:pointer);
begin
 GPA:=PtrArray;
end;

procedure ScreenT.SetPtrArray(GPA:pointer);
begin
 PtrArray:=GPA;
end;

procedure ScreenT.Save(FileName:string);
const CPFHeader:array[0..1]of byte=(Ord('C'),Ord('P'));
var F:file;
    C,N:word;
    P:pointer;
begin
 Result:=0;
 Assign(F,FileName);
 {$I-} ReWrite(F,1); {$I+}
 if IOResult<>0 then Result:=1
 else
 begin
  for C:=0 to 1 do BlockWrite(F,CPFHeader[C],1);
  C:=X2-X1;
  BlockWrite(F,C,2);
  C:=Y2-Y1;
  BlockWrite(F,C,2);
  C:=S_Bp;
  BlockWrite(F,C,2);
  for C:=0 to Y2-Y1 do
  begin
   P:=PtrArrayT(PtrArray^)[C];
   BlockWrite(F,P^,(X2-X1+1)*(S_Bp div 8));
  end;
  if S_Bp<16 then BlockWrite(F,RGBPtr^,768);
  Close(F);
 end;
end;

procedure ScreenT.Load(FileName:string);
const CPFHeader:array[0..1]of byte=(Ord('C'),Ord('P'));
var F:file;
    C,N,CX,CY:word;
    P:pointer;
begin
 Result:=0;
 Assign(F,FileName);
 {$I-} Reset(F,1); {$I+}
 if IOResult<>0 then Result:=1
 else
 begin
  for C:=0 to Y2-Y1 do
  begin
   P:=PtrArrayT(PtrArray^)[C];
   FreeMem(PtrArrayT(PtrArray^)[C], (X2-X1+1)*(S_Bp div 8));
  end;
  FreeMem(PtrArray, (Y2-Y1+1)*4);
  X1:=0;
  Y1:=0;
  BlockRead(F,CX,1,N);
  BlockRead(F,CY,1,N);
  BlockRead(F,X2,2,N);
  BlockRead(F,Y2,2,N);
  BlockRead(F,C,2,N);
  if C<>S_Bp then
  begin
   if C<16 then GetMem(RGBPtr, 768)
    else FreeMem(RGBPtr, 768);
  end;
  S_Bp := C;
  GetMem(PtrArray, (Y2-Y1+1)*4);
  for C:=0 to Y2 do
  begin
   GetMem(PtrArrayT(PtrArray^)[C], (X2-X1+1)*(S_Bp div 8));
   PtrArrayT(PtrArray^)[C]:=P;
   BlockRead(F,P^,(X2+1)*(S_Bp div 8),N);
  end;
  if S_Bp<16 then BlockRead(F,RGBPtr^,768,N);
  Close(F);
 end;
end;

function  ScreenT.GetResult:word;
begin
 GetResult:=Result;
end;

function  ScreenT.GetMaxX:word;
begin
 GetMaxX:=X2-X1+1;
end;

function  ScreenT.GetMaxY:word;
begin
 GetMaxY:=Y2-Y1+1;
end;

function  ScreenT.GetBytes:word;
begin
 GetBytes:=S_Bp;
end;
{ $ENDIF}

{==========================================================================}


begin
 InstallMouse:=InitMouse;
 Visible:=false;
 Wait_Vis:=false;
 OldX:=0;
 OldY:=0;
 SetMouseMinMaxX(0,799);
 SetMouseMinMaxY(0,599);
 SetMouseSensitivity(64,64);
 SetMouseStep(1,1);

 Loaded:=false;
 TextColor:=15;
 TextSize:=16;
 OverLine:=0;
 UnderLine:=0;

 Granularity := 64;

 GrSeg := SegA000;
end.
