Ver. 1.0 Beta, Don't have a compiler? Now you can write simple scripts ONLINE! This is a basic version -does not include all the Pascal statements. Only to learn basics

Moduł do obsługi szybkiej grafiki VESA w Turbo Pascalu

Pascal

Back to previous articleprevious Wprowadzenie do VESA
Go to main menuup Zaawansowany kurs pascala
Next articlenext Muzyka i dźwięk w Turbo Pascalu

Moduł do obsługi szybkiej grafiki VESA w Turbo Pascalu
Grafika 10eh

Część praktyczna



Poniżej jest kod źródlowy modulu graficznego graph10Eh z objaśnieniami. Możesz troszkę pokopiować do siebie, żeby otrzymać szybką grafikę w trybie 320x200x16bitów.

- Dochodzi do 500 klatek na sekundę.
- Odtwarza pliki bmp.
- Symuluje przezroczystość
- Rysuje szybką linię
- Potrafi robić print screeny

Zapraszam do nauki

KOD ŹRÓDLOWY:


{$G+}
UNIT Graph10E;


INTERFACE
USES Types, Fonts, Errors, Standard, MMX;


CONST
 V_MaxEX=320;
 V_MaxEY=200;

 BrakZnaku:ARRAY[0..7] OF Byte=
 {(00, 66, 36, 24, 24, 36, 66, 00);}
 (0, 0, 0, 0, 0, 0, 0, 0);

 EkranRect:TRect=
 (X:0;Y:0;W:320;H:200);

 MMX_Enabled=FALSE;

 VerticalRetrace:Boolean=True;

 V_TextNormal:Boolean=True;
 VGA_Tryb:Boolean=FAlse;

TYPE
 TEkran10Eh=RECORD
   Ekr1 : Pointer;
   Ekr2 : Pointer;
 END;

 TObraz=RECORD
   W,
   H             : Word;
   TCol          : Word;
   Transparent   : Boolean;
   BMP           : Pointer;
   BPP           : Byte;
   Paleta        : Pointer;
 END;

 TPicture       =^TObraz;

 TBMPCaption    = RECORD
   BM           : Word;
   Size         : Longint;
   rezerw       : Longint;
   obraz_offset : Longint;
   info         : Longint;
   Width        : Longint;
   Height       : Longint;
   LPO          : Word;
   BPP          : Word;
   kompresja    : Longint;
   Size_Obr     : Longint;
   HDPI         : Longint;
   VDPI         : Longint;
   Colors       : Longint;
   UColors      : Longint;
 END;

 TRGB           = RECORD
   R, G, B      : Byte;
 END;

 TPaleta        = RECORD
   Color        : ARRAY[0..255] OF TRGB;
 END;

 PPaleta        =^TPaleta;



VAR
   DefaultRect  : TRect;
   V_Ekran      : TEkran10Eh;




FUNCTION V_RGB(r, g, b : Byte) : Word;
{FUNCTION  V_RGB(R, G, B:Byte):Word;}
FUNCTION  V_GetBuf(VAR Buf:TEkran10Eh):Byte;
FUNCTION  V_LoadBMP24(Buf:TPicture;CONST Fn:STRING):Boolean;

PROCEDURE V_PrintScreen(CONST Fn:STRING);
PROCEDURE V_ToRGB(c : Word; VAR r, g, b : Byte);
{PROCEDURE V_ToRGB(Col:Word;VAR R, G, B:Byte);}
PROCEDURE V_FreeBuf(VAR Buf:TEkran10Eh);
PROCEDURE ShowCaptionBMP(CONST Fn:STRING);
PROCEDURE V_VRet;
PROCEDURE V_FillChar32(Dest:Pointer;Count:word; Value:Word);
PROCEDURE V_FlipBuf(Buf : TEkran10Eh);
PROCEDURE V_Set10Eh;
PROCEDURE V_End10Eh;
PROCEDURE V_ClearScreen(Buf:TEkran10Eh; Col:Word);
PROCEDURE V_HLine(Buf:TEkran10Eh; X, Y, W:Integer;C:Word);
PROCEDURE V_VLine(Buf:TEkran10Eh; X, Y, H:Integer;C:Word);
PROCEDURE V_Pix(Buf:TEkran10Eh; X, Y:Integer;C:Word);
PROCEDURE V_Line(Buf:TEkran10Eh; X1, Y1, X2, Y2:Integer;C:Word);
PROCEDURE V_HLineAlpha1(Buf:TEkran10Eh; X, Y, W:Integer;C:Word;Alpha:Byte);
PROCEDURE V_RozmyjEkran(Buf:TEkran10Eh; Speed:Byte);
PROCEDURE V_KopiujObraz(Buf:TEkran10Eh; Obraz:TPicture; X, Y:Integer);
PROCEDURE V_NewImage(VAR Picture:TPicture);
PROCEDURE V_FreeImage(VAR Picture:TPicture);
PROCEDURE V_WriteXY(Buf:TEkran10Eh;Font:PFont;X, Y:Integer;CONST S:STRING;C:Word;StepX:Byte);
PROCEDURE V_CenterText(Buf:TEkran10Eh;Font:PFont;X, Y:Integer;CONST S:STRING;C:Word;StepX:Byte);
PROCEDURE V_CopyLine(Buf:TEkran10Eh; Dest:Pointer; X, Y, W:Integer);
PROCEDURE V_CopyFromLine(Buf:TEkran10Eh; Line:Pointer; X, Y, W:Integer);
PROCEDURE V_LineX(X1, Y1, X2, Y2 : Integer; C: Word);
PROCEDURE V_CreateMirroredBMP(VAR Source, Dest:TPicture);


IMPLEMENTATION



{FUNCTION V_RGB(r, g, b : Byte) : Word;ASSEMBLER;
ASM
 Mov  Al, [r]
 Shl  Ax, 5
 Mov  Al, [g]
 Shl  Ax, 3
 And  Al, 11100000b
 Shr  [b], 3
 Or   Al, [b]
END;

PROCEDURE V_ToRGB(c : Word; VAR r, g, b : Byte); ASSEMBLER;
ASM
 Mov  Cx, Ds
 Mov  Ax, [c]
 Lds  Bx, [b]
 Mov  [Bx], Al
 Shl  BYTE PTR [Bx], 3
 Shr  Ax, 5
 Lds  Bx, [g]
 Mov  [Bx], Al
 Shl  BYTE PTR [Bx], 2
 Shr  Ax, 6
 Lds  Bx, [r]
 Mov  [Bx], Al
 Shl  BYTE PTR [Bx], 3
 Mov  Ds, Cx
END;


FUNCTION V_RGB(R, G, B:Byte):Word;
BEGIN
 V_RGB:=(B SHR 3) OR ((G SHR 2) SHL 5) OR ((R SHR 3) SHL 11);
END;
{*************************************************************************
PROCEDURE V_ToRGB(Col:Word;VAR R, G, B:Byte);
BEGIN
 R:=(Col AND (31 SHL 11)) SHR 8;
 G:=(Col AND (63 SHL 5)) SHR 3;
 B:=BYTE(Col SHL 3);
END;


FUNCTION V_GetBuf(VAR Buf:TEkran10Eh):Byte;
BEGIN
 Buf.EKR1:=NIL;
 Buf.EKR2:=NIL;

 V_GetBuf:=E_OK;
 IF MemAvail<128000 THEN
 BEGIN
   V_GetBuf:=E_PAMIEC;
   Exit;
 END;

 GetMem(Buf.EKR1, 64000);
 GetMem(Buf.EKR2, 64000);

 V_Ekran.EKR1:=Buf.EKR1;
 V_Ekran.EKR2:=Buf.EKR2;
END;

PROCEDURE V_FreeBuf(VAR Buf:TEkran10Eh);
BEGIN
 FreeMem(Buf.EKR1, 64000);
 FreeMem(Buf.EKR2, 64000);
 Buf.EKR1:=NIL;
 Buf.EKR2:=NIL;

 V_Ekran.EKR1:=NIL;
 V_Ekran.EKR2:=NIL;
END;

PROCEDURE V_VRet;
BEGIN
IF VerticalRetrace THEN
  ASM

      Mov Dx, 3dah

      @Powrot:

        In   Al, Dx
        Test Al, 00001000b
        Jnz  @Powrot

      @Nie_Ma:

        In   Al, Dx
        Test Al, 00001000b
        Jz   @Nie_Ma

  END;
END;

PROCEDURE V_Move32(VAR Src;VAR Dest;Count, Offs: Word); ASSEMBLER;
ASM
 Mov  Cx, Count
 Mov  Dx, Cx
 And  Dx, 3
 Shr  Cx, 2

 Push Ds

 Lds  Si, Src
 Les  Di, Dest

 Add  Si, Offs

 Cld
 Db   $F3,$66,$A5

 Mov  Cx, Dx
 Rep  MovSb

 Pop  Ds
END;

PROCEDURE V_FillChar32(Dest:Pointer;Count:word; Value:Word);ASSEMBLER;
ASM
 Mov Ax, Value
 Mov Cx, Ax
 Db  $66
 Shl Ax, 16
 Mov Ax, Cx

 Les Di, Dest
 Mov Cx, Count
 Mov Bx, Cx
 And Bx, 3
 Shr Cx, 2
 Cld

 Db  $F3, $66, $AB

 Mov Cx, Bx
 Cld
 Rep Stosb
END;


PROCEDURE V_FlipBuf(Buf : TEkran10Eh);
BEGIN


 IF VGA_Tryb THEN
 BEGIN
   ASM
   Mov AX, 4F05H
   Mov BX, 0
   Mov DX, 0
   Int 10H
 END;

   {KOPIOWANIE EKRANU WRAZ Z KONWERSJA NA TRYB 8-BITOWY}
   ASM
     Les  Di, Buf.Ekr1
     Mov  Cx, 32000
     Push Ds
     Mov  Ax, $A000
     Mov  Ds, Ax
     Xor  Si, Si

     @Petla:

       Mov  Bx, Es:[Di]
       Inc  Di
       Inc  Di
       Mov  Ax, Bx
       And  Ax, 0000000000011100b
       Shr  Ax, 2

       Mov  Dx, Bx
       And  Dx, 0000011100000000b
       Shr  Dx, 5
       Or   Ax, Dx

       And  Bx, 1100000000000000b
       Shr  Bx, 8
       Or   Ax, Bx

       Mov  Bx, Si
       Inc  Si
       Mov  Byte Ptr Ds:[Bx], Al

     Loop @Petla

     Pop  Ds

     Les  Di, Buf.Ekr2
     Mov  Cx, 32000
     Mov  Si, 31999
     Push Ds
     Mov  Ax, $A000
     Mov  Ds, Ax

     @Petla2:

       Mov  Bx, Es:[Di]
       Inc  Di
       Inc  Di
       Mov  Ax, Bx
       And  Ax, 0000000000011100b
       Shr  Ax, 2

       Mov  Dx, Bx
       And  Dx, 0000011100000000b
       Shr  Dx, 5
       Or   Ax, Dx

       And  Bx, 1100000000000000b
       Shr  Bx, 8
       Or   Ax, Bx

       Mov  Bx, Si
       Inc  Si
       Mov  Byte Ptr Ds:[Si], Al

     Loop @Petla2

     Pop  Ds


   END;

 END
 ELSE
 BEGIN

 ASM
   Mov AX, 4F05H
   Mov BX, 0
   Mov DX, 0
   Int 10H
 END;

 IF MMX_Enabled THEN
 BEGIN
   MMX_Move(Ptr($A000, 0),     Buf.Ekr1, 64000);
   MMX_Move(Ptr($A000, 64000), Buf.Ekr2, 1536);
 END ELSE
 BEGIN
   V_Move32(Buf.Ekr1^, Ptr($A000, 0)^, 64000, 0);
   V_Move32(Buf.Ekr2^, Ptr($A000, 64000)^, 1536, 0);
 END;

 ASM
   Mov AX, 4F05H
   Mov BX, 0
   Mov DX, 1
   Int 10H
 END;
 {IF MMX_Enabled THEN
 MMX_Move(Ptr($A000, 0), Buf.Ekr2 , 62464 1536);
 ELSE}
 V_Move32(Buf.Ekr2^, Ptr($A000, 0)^, 62464, 1536);

 END;

END;

PROCEDURE UpString(VAR S:STRING);
VAR i:Byte;
BEGIN
 FOR i:=1 TO Byte(S[0]) DO
   S[i]:=UpCase(S[i]);
END;

PROCEDURE V_Set10Eh;
VAR R, G, B:Byte;
   S:STRING;

BEGIN

IF (ParamCount>0) THEN
 BEGIN
   {DUZY PARAMETR}
   S:=ParamStr(1);
   UpString(S);
 END;

IF (S='VGA') THEN
 BEGIN

 ASM
   Mov   Ax, 13h
   Mov   Bx, 0
   Int   10h
 END;
   VGA_Tryb:=TRUE;

   {USTAWIANIE PALETY}
   FOR R:=0 TO 3 DO
   FOR G:=0 TO 7 DO
   FOR B:=0 TO 7 DO
     BEGIN
       PORT[$3c8]:=B OR (G SHL 3) OR (R SHL 6);

       PORT[$3c9]:=R SHL 4;
       PORT[$3c9]:=G SHL 3;
       PORT[$3c9]:=B SHL 3;
     END;


 END ELSE
 ASM
   Mov   Ax, 4F02h
   Mov   Bx, 10Eh
   Int   10h
 END;
END;

PROCEDURE V_End10Eh; ASSEMBLER;
ASM
 Mov   Ax, 4F02h
 Xor   Bh, Bh
 Mov   Bl, 03h
 Int   10h
END;

FUNCTION V_LoadBMP24(Buf:TPicture;CONST Fn:STRING):Boolean;
VAR
 Capt : TBMPCaption;
 F    : FILE;
 Size : Word;
 Temp : Word;
 I    : Word;
 BTem : Pointer;
 Addx : Word;
 BMPx : Pointer;
 TC   : Word;

BEGIN
 {JESLI FUNKCJA SIE NIE ZAKONCZY POWODZENIEM ZWROCI False}
 V_LoadBMP24:=False;

 {JEZELI JESZCZE NIE MA UTWORZONEGO OBRAZKA TO WYCHODZI}
 IF Buf=NIL THEN Exit;

 {OTWIERA PODANY PLIK}
 Assign(F, Fn);
 {$I-}
 Reset(F, 1);
 {$I+}

 {JESLI NIE ZNALEZIONO PLIKU WYCHODZI}
 IF IOResult<>0 THEN Exit;

 {WCZYTUJE NAGLOWEK INFORMACYJNY}
 BlockRead(F, Capt, SizeOf(Capt));

 {USTAWIA ROZMIAR OBRAZKA}
 Buf^.W:=Capt.Width;
 Buf^.H:=Capt.Height;

 {OBLICZANIE POTRZEBNYCH PAMIECI DLA OBRAZKA}
 {ORAZ DO BUFORA ODCZYTU Z DYSKU}
 Size:=Capt.Width*Capt.Height SHL 1;
 Temp:=Capt.Width SHL 1+Capt.Width;

 {W RAZIE POTRZEBY PRZYDZIELA PAMIEC DLA RYSUNKU}
 IF (Buf^.BMP=NIL) THEN
 BEGIN
  IF (MaxAvail>=Size) THEN GetMem(Buf^.BMP, Size)
     ELSE Exit;
 END;

 {JEZELI TO NIE JEST BITMAPA 24 BITOWA}
 IF Capt.BPP<>24  THEN BEGIN Close(F); Exit; END;

 {PRZESTAWIA WSKAZNIK PLIKU NA POCZATEK BITMAPY}
 Seek(F, Capt.Obraz_Offset);

 {PAMIEC DO ODCZYTU JEDNEJ LINII}
 IF MaxAvail  Temp:=Temp+(Temp AND 3);
 GetMem(BTem, Temp);

 {USTAWIA WSKAZNIK BUFORU NA OSTATNIA LINIE}
 Addx:=(Capt.Height-1)*(Capt.Width SHL 1);

 {BUFOR POMOCNICZY DLA ASSEMBLERA}
 BMPx:=Buf^.BMP;

 {WCZYTUJE I PRZEKSZTALCA BITMAPE OD KONCA}
 FOR I:=Capt.Height-1 DOWNTO 0 DO
 BEGIN
   BlockRead(F, BTem^, Temp);
   ASM
     Push Ds

     Les  Di, BMPx
     Add  Di, Addx

     Lds  Si, BTem

     Mov  Cx, Word Ptr Capt.Width

     @Petla:

       Xor  Ax, Ax
       Mov  Al, [Si]
       Inc  Si

       Xor  Bx, Bx
       Mov  Bl, [Si]
       Inc  Si

       Xor  Dx, Dx
       Mov  Dl, [Si]
       Inc  Si

       Shr  Ax, 3
       Shr  Bx, 2
       Shr  Dx, 3

       Shl  Bx, 5
       Shl  Dx, 11

       Or   Ax, Bx
       Or   Ax, Dx

       Mov  Es:[Di], Ax

       Inc  Di
       Inc  Di

     Dec  Cx
     Jnz  @Petla

     Pop  Ds
   END;
   Dec(Addx, (Capt.Width shl 1));

 END;

 {OKRESLANIE KOLORU PRZEZROCZYSTEGO}
 {LEWY GORNY PIKSEL}
 ASM
   Les  Di, BMPx
   Mov  Ax, Es:[Di]
   Mov  Tc, Ax
 END;

 {DOMYSLNY KOLOR PRZEZROCZYSTOSCI}
 Buf^.TCol:=Tc;

 {ZWALNIA PAMIEC OD BUFORA}
 FreeMem(BTem, Temp);

 {ZAMYKA PLIK}
 Close(F);

 {ZAZNACZA ZE WSZYSTKO SIE UDALO}
 V_LoadBMP24:=True;
END;


PROCEDURE V_ClearScreen(Buf:TEkran10Eh; Col:Word);
BEGIN
 IF MMX_Enabled THEN
 BEGIN
   MMX_FillChar(Buf.Ekr1, 64000, Col);
   MMX_FillChar(Buf.Ekr2, 64000, Col);
 END ELSE
 BEGIN
   V_FillChar32(Buf.Ekr1, 64000, Col);
   V_FillChar32(Buf.Ekr2, 64000, Col);
 END;
END;


FUNCTION V_ObetnijHLine(VAR X1, Y1, W:Integer):Boolean;
BEGIN
 V_ObetnijHLine:=TRUE;

 IF (Y1=DefaultRect.Y+DefaultRect.H) OR
    (X1>=DefaultRect.X+DefaultRect.W) OR (W<=0) OR (X1+W<=DefaultRect.X) THEN Exit;

 IF X1  BEGIN
     IF X1+W>DefaultRect.X+DefaultRect.W THEN W:=DefaultRect.W
     ELSE
   W:=W+(X1-DefaultRect.X);

     X1:=DefaultRect.X;

END ELSE
   IF X1+W>DefaultRect.X+DefaultRect.W THEN
W:=DefaultRect.X+DefaultRect.W-X1;

 V_ObetnijHLine:=FALSE;
END;


FUNCTION V_ObetnijVLine(VAR X1, Y1, H:Integer):Boolean;
BEGIN
 V_ObetnijVLine:=TRUE;

 IF (X1=DefaultRect.Y+DefaultRect.H) OR
    (X1>=DefaultRect.X+DefaultRect.W) OR (H<=0) OR (Y1+H<=DefaultRect.Y) THEN Exit;

 IF Y1  BEGIN
     IF Y1+H>=DefaultRect.Y+DefaultRect.H THEN
     BEGIN
       H:=DefaultRect.Y+DefaultRect.H;
       Y1:=DefaultRect.Y;
     END ELSE
     BEGIN
   H:=H+Y1-DefaultRect.Y;
Y1:=DefaultRect.Y;
     END;
END ELSE

   IF Y1+H>DefaultRect.Y+DefaultRect.H THEN
H:=DefaultRect.Y+DefaultRect.H-Y1;

 V_ObetnijVLine:=FALSE;
END;



PROCEDURE V_HLine(Buf:TEkran10Eh; X, Y, W:Integer;C:Word);

VAR Ekr1, Ekr2:Pointer;
BEGIN

 IF V_ObetnijHLine(X, Y, W) THEN Exit;
 Ekr1:=Buf.Ekr1;
 Ekr2:=Buf.Ekr2;

 ASM
   Mov  Ax, Y
   Cmp  Ax, 100

   Ja   @Drugi

   Les  Di, Ekr1

   Jmp  @Dalej

   @Drugi:

     Les  Di, Ekr2
     Sub  Ax, 100

   @Dalej:

     Shl  Ax, 7
     Add  Di, Ax
     Shl  Ax, 2
     Add  Di, Ax
     Add  Di, X
     Add  Di, X

     Mov  Cx, W
     Mov  Bx, Cx
     And  Bx, 1
     Shr  Cx, 1

     Mov  Ax, C
     Db   $66
     Shl  Ax, 16
     Mov  Ax, C

     Cld

     Db   $F3, $66, $AB

     Mov  Cx, Bx
     Rep  StosW
  END;
END;

PROCEDURE V_Pix(Buf:TEkran10Eh; X, Y:Integer;C:Word);

VAR Ekr1, Ekr2:Pointer;
BEGIN

 IF (X=DefaultRect.X+DefaultRect.W) OR
    (Y=DefaultRect.Y+DefaultRect.H) THEN Exit;
 Ekr1:=Buf.Ekr1;
 Ekr2:=Buf.Ekr2;

 ASM
   Mov  Ax, Y
   Cmp  Ax, 100

   Ja   @Drugi

   Les  Bx, Ekr1

   Jmp  @Dalej

   @Drugi:

     Les  Bx, Ekr2
     Sub  Ax, 100

   @Dalej:

     Shl  Ax, 7
     Add  Bx, Ax
     Shl  Ax, 2
     Add  Bx, Ax
     Add  Bx, X
     Add  Bx, X
     Mov  Ax, C

     Mov  ES:[Bx], Ax
  END;
END;


PROCEDURE V_VLine(Buf:TEkran10Eh; X, Y, H:Integer;C:Word);

VAR Ekr1, Ekr2:Pointer;
BEGIN

 IF V_ObetnijVLine(X, Y, H) THEN Exit;
 Ekr1:=Buf.Ekr1;
 Ekr2:=Buf.Ekr2;

 ASM
   Mov  Ax, Y
   Cmp  Ax, 100

   Jnb  @ZaczynajOd2

   Les  Di, Ekr1
   Mov  Bx, Ax
   Shl  Bx, 7
   Add  Di, Bx
   Shl  Bx, 2
   Add  Di, Bx
   Add  Di, X
   Add  Di, X

   Jmp  @DrawLine

   @ZaczynajOd2:

   Les  Di, Ekr2
   Mov  Bx, Ax
   Sub  Bx, 100
   Shl  Bx, 7
   Add  Di, Bx
   Shl  Bx, 2
   Add  Di, Bx
   Add  Di, X
   Add  Di, X
   Xor  Ax, Ax

   @DrawLine:

   Mov  Cx, H
   Mov  Dx, C
   Cld

   @Petla:

     Cmp  Ax, 100
     Jb   @Dalej

     @Drugi:

       Les  Di, Ekr2
       Sub  Ax, 100
       Add  Di, X
       Add  Di, X

     @Dalej:

       Mov  ES:[DI], Dx
       Add  Di, 640
       Inc  Ax

   Loop @Petla

  END;
END;

{PROCEDURE V_Line(Buf:TEkran10Eh; X1, Y1, X2, Y2:Integer;C:Word);
FUNCTION Znak(X:Integer):Integer;
BEGIN
 IF X>0 THEN Znak:=1 ELSE
 IF X<0 THEN Znak:=-1 ELSE
   Znak:=0;
END;

PROCEDURE PrzytnijLinieX(VAR X1, Y1, X2, Y2:Integer; Rect:PRect);

VAR a, b:Real;
   Granica:Integer;

BEGIN

 Granica:=Rect^.X;
 {PRZECIECIE Z OSIA Z LEWEJ
 IF (X1=Granica) THEN
 BEGIN
   {$Q-
   Y1:=(Y1+Round((Y2-Y1)*(Granica-X1)/(X2-X1)));
   X1:=Granica;
   {$Q+
 END;

 Granica:=Rect^.X+Rect^.W;
 {PRZECIECIE Z OSIA Z PRAWE  IF (X1=Granica) THEN
 BEGIN
   {$Q-
   Y2:=(Y2+Round((Y2-Y1)*(X2-Granica)/(X2-X1)));
   X2:=Granica-1;
   {$
VAR l, s, d1x, d1y, d2x,
 d2y, rx, ry, m, n,
   MaxX, MaxY, MinX, MinY    : Integer;
   Rect:TRect;
   a, b:Single;
   NY1, NX1, NX2, NY2    :Integer;

BEGIN

 S_Move32(@DefaultRect, @Rect, SizeOf(TRect));

 IF ((X1     ((X1>=Rect.X+Rect.W) AND (X2>=Rect.X+Rect.W)) OR
    ((Y1     ((Y1>=Rect.Y+Rect.H) AND (Y2>=Rect.Y+Rect.H)) THEN Exit;


 IF (X1<>X2) AND (Y1<>Y2) THEN
 BEGIN
   {$Q-
   a:=(Y2-Y1)/(X2-X1);
   b:=((-X1)*(y2-y1)-(X2-X1)*(-X1))/(X2-X1);

   Y1:=-Round(a*Rect.X+b);
   Y2:=-Round(a*(Rect.X+Rect.W-1)+b);

   X1:=Round((b-Rect.Y)/a);
   X2:=Round((b-(Rect.Y+Rect.H-1))/a);
   {$Q+
 END;

   IF Y1    IF Y1>Rect.Y+Rect.H-1 THEN Y1:=Rect.Y+Rect.H-1;

   IF Y2    IF Y2>Rect.Y+Rect.H-1 THEN Y2:=Rect.Y+Rect.H-1;

   IF X1    IF X1>Rect.X+Rect.W-1 THEN X1:=Rect.X+Rect.W-1;

   IF X2    IF X2>Rect.X+Rect.W-1 THEN X2:=Rect.X+Rect.W-1;}


PROCEDURE V_LineX(X1, Y1, X2, Y2 : Integer; C: Word);

VAR
 P0, P1, tmp : Integer;
 EX1, EY1, EX2, EY2 : Integer;
 x, y : Integer;


 l, s, d1x, d1y, d2x,
 d2y, rx, ry, m, n,
 MaxX, MaxY, MinX, MinY    : Integer;
 Rect:TRect;
 a           : Single;
 Temp         : Integer;

 FUNCTION Znak(X:Integer):Integer;
 BEGIN
   IF X>0 THEN Znak:=1 ELSE
   IF X<0 THEN Znak:=-1 ELSE
     Znak:=0;
 END;


 PROCEDURE Zamien(VAR a, b : Integer);
 VAR
   c : Integer;
 BEGIN
   c := a;
   a := b;
   b := c;
 END;

 FUNCTION ObliczKod(x, y : Integer) : Byte;
 BEGIN
   ObliczKod := (Byte(x  < EX1 ) OR
                (Byte(EX2 < x  ) SHL 1) OR
                (Byte(y  < EY1 ) SHL 2) OR
                (Byte(EY2 < y  ) SHL 3));
 END;

BEGIN

 S_Move32(@DefaultRect, @Rect, SizeOf(TRect));

 EX1 := Rect.X;
 EY1 := Rect.Y;
 EX2 := Rect.X+Rect.W-1;
 EY2 := Rect.Y+Rect.H-1;

{ !!! ZROBIC !!!
 Wykrywanie przypadkow poziomych i pionowych linii.
}
 IF x1=x2 THEN
 BEGIN

 IF y1>y2 THEN V_VLine(V_Ekran, x1, y2, y1-y2+1, C)
          ELSE V_VLine(V_Ekran, x1, y1, y2-y1+1, C);
   Exit;
 END;

 IF y1=y2 THEN
 BEGIN

   IF x1>x2 THEN V_HLine(V_Ekran, x2, y1, x1-x2+1, C)
            ELSE V_HLine(V_Ekran, x1, y1, x2-x1+1, C);
   Exit;

 END;


 WHILE (TRUE)
 DO BEGIN
   P0 := ObliczKod(x1, y1);
   P1 := ObliczKod(x2, y2);
   IF (P0 = 0) AND (P1 = 0)
   THEN
     Break
   ELSE IF (P0 AND P1) <> 0
   THEN
     Exit
   ELSE BEGIN
     IF (P0 = 0)
     THEN BEGIN
       Zamien(x1, x2);
       Zamien(y1, y2);
       Zamien(P0, P1);
     END;
     IF (P0 AND 1 <> 0)
     THEN BEGIN
       Temp:=X2-X1;IF Temp=0 THEN Inc(Temp);
       y1 := y1+(LongInt((EX1-X1))*(Y2-Y1)) DIV Temp;
       x1 := EX1;
     END;
     IF (P0 AND 2 <> 0)
     THEN BEGIN
       Temp:=X2-X1;IF Temp=0 THEN Inc(Temp);
       y1  := y1+(LongInt((EX2-x1))*(y2-y1)) DIV Temp;
       x1 := EX2;
     END;
     IF (P0 AND 4 <> 0)
     THEN BEGIN
       Temp:=Y2-Y1;IF Temp=0 THEN Inc(Temp);
       x1 := X1+(LongInt((EY1-Y1))*(X2-X1)) DIV Temp;
       y1 := EY1;
     END;
     IF (P0 AND 8 <> 0)
     THEN BEGIN
       Temp:=Y2-Y1;IF Temp=0 THEN Inc(Temp);
       x1 := x1+((EY2-y1)*(x2-x1)) DIV Temp;
       y1 := EY2;
     END;
   END;
 END;

 rx:=X2-X1;
 ry:=Y2-Y1;

 d1x:=Znak(rx);
 d1y:=Znak(ry);

 d2x:=Znak(rx);
 d2y:=0;
 m:=ABS(rx);
 n:=ABS(ry);

 IF m<=n THEN
 BEGIN
   d2x:=0;
   d2y:=Znak(ry);
   m:=ABS(ry);
   n:=ABS(rx);
 END;

 s:=m SHR 1;

 FOR l:=0 TO m DO

 BEGIN
   ASM
     Mov  Ax, Y1
     Cmp  Ax, 99
     Ja   @DrugiBufor

     Les  Di, V_Ekran.Ekr1
     Jmp  @DrawPix

     @DrugiBufor:

     Les  Di, V_Ekran.Ekr2
     Sub  Ax, 100

     @DrawPix:

     Shl  Ax, 7
     Add  Di, Ax
     Shl  Ax, 2
     Add  Di, Ax
     Add  Di, X1
     Add  Di, X1
     Mov  Ax, C
     Mov  Es:[Di], Ax
   END;

   s:=s+n;
   IF s>=m THEN
   BEGIN
     s:=s-m;
     X1:=X1+d1x;
     Y1:=Y1+D1Y;
   END ELSE
   BEGIN
     X1:=X1+D2X;
     Y1:=Y1+d2y;
   END;

 END;


END;

PROCEDURE V_Line(Buf:TEkran10Eh; X1, Y1, X2, Y2:Integer;C:Word);
FUNCTION Znak(X:Integer):Integer;
BEGIN
 IF X>0 THEN Znak:=1 ELSE
 IF X<0 THEN Znak:=-1 ELSE
   Znak:=0;
END;

PROCEDURE PrzytnijLinieX(VAR X1, Y1, X2, Y2:Integer; Rect:PRect);

VAR a, b:Real;
   Granica:Integer;
   X12, X22, Y22, Y12:LongInt;

BEGIN
 X12:=X1;
 X22:=X2;

 Y12:=Y1;
 Y22:=21;


 Granica:=Rect^.X;
 {PRZECIECIE Z OSIA Z LEWEJ}
 IF (X1=Granica) THEN
 BEGIN
   Y12:=(Y1+Round((Y2-Y1)*(Granica-X1)/(X2-X1)));
   X12:=Granica;
 END;

 Granica:=Rect^.X+Rect^.W;
 {PRZECIECIE Z OSIA Z PRAWEJ}
 IF (X1=Granica) THEN
 BEGIN
   Y22:=(Y2+Round((Y2-Y1)*(X2-Granica)/(X2-X1)));
   X22:=Granica-1;
 END;

 X1:=X12;
 X2:=X22;
 Y1:=Y12;
 Y2:=Y12;
END;

PROCEDURE PrzytnijLinieY(VAR X1, Y1, X2, Y2:Integer; Rect:PRect);
VAR a, b:Real;
   Granica:Integer;
   X12, X22, Y22, Y12:LongInt;

BEGIN
 X12:=X1;
 X22:=X2;

 Y12:=Y1;
 Y22:=21;


 Granica:=Rect^.Y;
 {PRZECIECIE Z GORNA KRAWEDZIA}
 IF (Y1=Granica) THEN
 BEGIN
   X12:=(X1+Round((X2-X1)*(Granica-Y1)/(Y2-Y1)));
   Y12:=Granica;
 END;

 Granica:=Rect^.Y+Rect^.H;
 {PRZECIECIE Z DOLNA KRAWEDZIA}
 IF (Y1=Granica) THEN
 BEGIN
   X22:=(X2+Round((X2-X1)*(Y2-Granica)/(Y2-Y1)));
   Y22:=Granica-1;
 END;

 X1:=X12;
 X2:=X22;
 Y1:=Y12;
 Y2:=Y12;
END;

VAR l, s, d1x, d1y, d2x,
 d2y, rx, ry, m, n,
   MaxX, MaxY, MinX, MinY    : Integer;
   Rect:TRect;

BEGIN


 S_Move32(@DefaultRect, @Rect, SizeOf(TRect));

 {OBCINANIE LINI DLA Y}
 IF Y1>Y2 THEN BEGIN MaxY:=Y1;Y1:=Y2;Y2:=MaxY;MaxX:=X1;X1:=X2;X2:=MaxX END;
 IF (Y1>Rect.Y+Rect.H-1) OR (Y2  IF (Y1Rect.Y+Rect.H-1) THEN PrzytnijLinieY(X1, Y1, X2, Y2, @Rect);

 {OBCINANIE LINI DLA X}
 IF X1>X2 THEN BEGIN MaxY:=Y1;Y1:=Y2;Y2:=MaxY;MaxX:=X1;X1:=X2;X2:=MaxX END;
 IF (X1>Rect.X+Rect.W-1) OR (X2  IF (X1Rect.X+Rect.W-1) THEN PrzytnijLinieX(X1, Y1, X2, Y2, @Rect);

 rx:=X2-X1;
 ry:=Y2-Y1;

 d1x:=Znak(rx);
 d1y:=Znak(ry);

 d2x:=Znak(rx);
 d2y:=0;
 m:=ABS(rx);
 n:=ABS(ry);

 IF m<=n THEN
 BEGIN
   d2x:=0;
   d2y:=Znak(ry);
   m:=ABS(ry);
   n:=ABS(rx);
 END;

 s:=m SHR 1;

 FOR l:=0 TO m DO

 BEGIN
   IF (Y1>=Rect.Y) AND (Y2       (X1>=Rect.X) AND (X2    ASM
     Mov  Ax, Y1
     Cmp  Ax, 99
     Ja   @DrugiBufor

     Les  Di, Buf.Ekr1
     Jmp  @DrawPix

     @DrugiBufor:

     Les  Di, Buf.Ekr2
     Sub  Ax, 100

     @DrawPix:

     Shl  Ax, 7
     Add  Di, Ax
     Shl  Ax, 2
     Add  Di, Ax
     Add  Di, X1
     Add  Di, X1
     Mov  Ax, C
     Mov  Es:[Di], Ax
   END;

   s:=s+n;
   IF s>=m THEN
   BEGIN
     s:=s-m;
     X1:=X1+d1x;
     Y1:=Y1+D1Y;
   END ELSE
   BEGIN
     X1:=X1+D2X;
     Y1:=Y1+d2y;
   END;

 END;

END;


PROCEDURE V_HLineAlpha1(Buf:TEkran10Eh; X, Y, W:Integer;C:Word;Alpha:Byte);
BEGIN

 IF (W<1) OR V_ObetnijHLine(X, Y, W) THEN Exit;

 ASM
   Mov  Ax, Y
   Cmp  Ax, 100

   Ja   @Drugi

   Les  Di, Buf.Ekr1

   Jmp  @Dalej

   @Drugi:

     Les  Di, Buf.Ekr2
     Sub  Ax, 100

   @Dalej:

     Shl  Ax, 7
     Add  Di, Ax
     Shl  Ax, 2
     Add  Di, Ax
     Add  Di, X
     Add  Di, X

     Mov  Cx, W

     Cld

   @Petla:
     Push Cx

     Mov  Cl, Alpha

     Mov  Bx, Es:[Di]
     Mov  Ax, C

     Mov  Dx, Bx
     Shr  Dx, 11
     Shr  Ax, 11
     Add  Dx, Ax
     Shr  Dx, Cl
     Shl  Dx, 11
     Mov  Es:[Di], Dx
     And  Bx, 0000011111111111b

     Mov  Ax, C
     And  Ax, 0000011111111111b
     Mov  Dx, Bx
     Shr  Dx, 5
     Shr  Ax, 5
     Add  Dx, Ax
     Shr  Dx, Cl
     Shl  Dx, 5
     Or   Es:[Di], Dx
     And  Bx, 0000000000011111b

     Mov  Ax, C
     And  Ax, 0000000000011111b
     Mov  Dx, Bx
     Add  Dx, Ax
     Shr  Dx, Cl
     Or   Es:[Di], Dx

     Inc  Di
     Inc  Di

     Pop  Cx

   Loop @Petla

  END;
END;

PROCEDURE V_RozmyjEkran(Buf:TEkran10Eh; Speed:Byte);
BEGIN
 ASM

   Xor  Dx, Dx
   Mov  Dl, Speed

   Les  Di, Buf.Ekr1
   Mov  Cx, 32000
   Cld

   @Petla:

   Mov  Bx, Es:[Di]
   Mov  Ax, Bx
   Shr  Ax, 11
   Sub  Ax, Dx

   Jnb  @NieZerujAx
   Xor  Ax, Ax

 @NieZerujAx:

   Shl  Ax, 11
   Mov  Es:[Di], Ax
   And  Bx, 0000011111111111b

   Mov  Ax, Bx
   Shr  Ax, 6
   Sub  Ax, Dx

   Jnb  @NieZerujAx2
   Xor  Ax, Ax

 @NieZerujAx2:

   Shl  Ax, 6
   Or   Es:[Di], Ax
   And  Bx, 0000000000011111b

   Sub  Bx, Dx

   Jnb  @NieZerujBx
   Xor  Bx, Bx

 @NieZerujBx:

   Or   Es:[Di], Bx

   Inc  Di
   Inc  Di

 Loop @Petla


   Les  Di, Buf.Ekr2
   Mov  Cx, 32000
   Cld

 @Petla2:

   Mov  Bx, Es:[Di]
   Mov  Ax, Bx
   Shr  Ax, 11
   Sub  Ax, Dx

   Jnb  @NieZerujAx2x
   Xor  Ax, Ax

 @NieZerujAx2x:

   Shl  Ax, 11
   Mov  Es:[Di], Ax
   And  Bx, 0000011111111111b

   Mov  Ax, Bx
   Shr  Ax, 6
   Sub  Ax, Dx

   Jnb  @NieZerujAx22
   Xor  Ax, Ax

 @NieZerujAx22:

   Shl  Ax, 6
   Or   Es:[Di], Ax
   And  Bx, 0000000000011111b

   Sub  Bx, Dx

   Jnb  @NieZerujBx2
   Xor  Bx, Bx

 @NieZerujBx2:

   Or   Es:[Di], Bx

   Inc  Di
   Inc  Di

 Loop @Petla2



 END;
END;

PROCEDURE V_KopiujObraz(Buf:TEkran10Eh; Obraz:TPicture; X, Y:Integer);

CONST    EW:Word=320;
        EH:Word=200;

VAR Lx,  Rx,  Gy  :Integer;
   LxE, RxE      :Integer;
   DyE, GyE      :Integer;
   Width, Height :Integer;
   CountY        :Integer;
   OffX          :Word;
 SiGy, DiGyE   :Word;
   GyE2          :Word;
   Add2, TC      :Word;
   BMPx          :Pointer;

BEGIN
 IF NOT Assigned(Obraz) OR NOT Assigned(Obraz^.BMP) THEN Exit;

 WITH Obraz^ DO
 BEGIN

 IF X<0 THEN BEGIN LxE:=0;Lx:=-X;END
        ELSE BEGIN LxE:=X;Lx:= 0;END;

 IF Y<0 THEN BEGIN GyE:=0;Gy:=-Y;END
        ELSE BEGIN GyE:=Y;Gy:= 0;END;

 BMPx:=Obraz^.BMP;

 IF BMPx=NIL THEN Exit;

 IF (Lx>=W) OR (Gy>=H) THEN EXIT;


 IF LxE+W>EW THEN BEGIN RxE:=0;Rx:=Lx+LxE+W-(EW+Lx);END
       ELSE BEGIN RxE:=EW+Lx-(W+LxE);Rx:=0;END;

 IF GyE+H-Gy>EH THEN DyE:=0
          ELSE DyE:=EH+Gy-(GyE+H);

 OffX:=(LxE+RxE) SHL 1;

 IF EW-LxE-RxE>0 THEN Width :=EW-LxE-RxE ELSE Exit;
 IF EH-GyE-DyE>0 THEN Height:=EH-GyE-DyE ELSE Exit;

 CountY:=101-GyE;

 IF GyE>100 THEN GyE2:=GyE-100 ELSE GyE2:=GyE;
 IF CountY<=0 THEN BEGIN CountY:=0;Add2:=GyE2*(EW SHL 1);END ELSE Add2:=0;

 SiGy :=(Gy   *  W) SHL 1;
 DiGyE:=(GyE2 * EW) SHL 1;

 Lx:=Lx SHL 1;
 Rx:=Rx SHL 1;

 LxE:=LxE SHL 1;
 RxE:=RxE SHL 1;
 TC:=TCol;

 END; {Do With}

 IF Obraz^.Transparent THEN
 ASM
   Push Ds

   {DLA OBRAZU, JESLI WYCHODZI}
   {POZA EKRAN}
   Lds  Si, BMPx
   Add  Si, SiGy

   {DLA EKRANU, JESLI OBRAZ}
 {ZACZYNA SIE W PEWNYM MOMENCIE}
   Les  Di, Buf.Ekr1
   Add  Di, LxE
   Add  Di, DiGyE

   Cmp  CountY, 0
   Jnz  @NoChangePointer

   Les  Di, Buf.Ekr2
   Mov  CountY, 100
   Add  Di, LxE
   Add  Di, Add2

   @NoChangePointer:

   {ORAZ ILE DODATKOWO  Rep MovSW}
   Mov  Ax, Width

   {ILE LINI MA RYSOWAC}
   Cld
   Mov  Cx, Height
   Inc  Cx

   {PETLA GLOWNA PROCEDURY}
   {KOPIUJACEJ LINIE}
 @KopiujCalosc:

   Dec  CountY
   Jz   @ChangePointer
   Loop @KopiujWiersz
   Jmp  @Koniec

 @ChangePointer:

   Les  Di, Buf.Ekr2
   Mov  CountY, 100
   Add  Di, LxE
   Add  Di, Add2

   Loop @KopiujWiersz
   Jmp  @Koniec

 @KopiujWiersz:

     Push Cx
     Mov  Cx, Ax
     Add  Si, Lx

     @XXX:

     Mov  Dx, [SI]
     Cmp  Dx, TC

     Je   @NieKopiujTego

     Mov  Es:[Di], Dx


     @NieKopiujTego:

     {ZMIANA ADRESOW Di i Si}
     Inc  Di
     Inc  Di
     Inc  Si
     Inc  Si

     Loop @XXX

   @NieKopiujReszty:

     Add  Di, OffX
     Add  Si, Rx
     Pop  Cx
     Jmp  @KopiujCalosc

 @Koniec:

   Pop Ds

 END
 ELSE
 ASM
   Push Ds

   {DLA OBRAZU, JESLI WYCHODZI}
   {POZA EKRAN}
   Lds  Si, BMPx
   Add  Si, SiGy

   {DLA EKRANU, JESLI OBRAZ}
 {ZACZYNA SIE W PEWNYM MOMENCIE}
   Les  Di, Buf.Ekr1
   Add  Di, LxE
   Add  Di, DiGyE

   Cmp  CountY, 0
   Jnz  @NoChangePointer

   Les  Di, Buf.Ekr2
   Mov  CountY, 100
   Add  Di, LxE
   Add  Di, Add2

   @NoChangePointer:

   {ORAZ ILE DODATKOWO  Rep MovSW}
   Mov  Ax, Width

   {ILE LINI MA RYSOWAC}
   Cld
   Mov  Cx, Height
   Inc  Cx

   {PETLA GLOWNA PROCEDURY}
   {KOPIUJACEJ LINIE}
 @KopiujCalosc:

   Dec  CountY
   Jz   @ChangePointer
   Loop @KopiujWiersz
   Jmp  @Koniec

 @ChangePointer:

   Les  Di, Buf.Ekr2
   Mov  CountY, 100
   Add  Di, LxE
   Add  Di, Add2

   Loop @KopiujWiersz
   Jmp  @Koniec

 @KopiujWiersz:

     Push Cx
     Mov  Cx, Ax
     Mov  Bx, Ax
     And  Bx, 1
     Shr  Cx, 1
     Add  Si, Lx

     {KOPIOWANIE METODA 32 BITOWA}

     Cld
     Db   $F3,$66,$A5

     Mov  Cx, Bx
     Cld
     Rep  MovSW

     Add  Di, OffX
     Add  Si, Rx
     Pop  Cx
     Jmp  @KopiujCalosc

 @Koniec:

   Pop Ds

 END;
END;



PROCEDURE V_NewImage(VAR Picture:TPicture);
BEGIN

 Picture:=NIL;
 IF MaxAvail
 New(Picture);

 Picture^.W:=0;
 Picture^.H:=0;
 Picture^.TCol:=0;
 Picture^.Transparent:=False;
 Picture^.BMP:=NIL;
 Picture^.BPP:=16;
 Picture^.Paleta:=NIL;
END;



PROCEDURE V_FreeImage(VAR Picture:TPicture);
BEGIN
 IF Picture=NIL THEN Exit;

 IF Picture^.BMP<>NIL THEN
    FreeMem(Picture^.BMP, Picture^.W*Picture^.H*2);

 Dispose(Picture);
 Picture:=NIL;
END;



PROCEDURE V_WriteXY(Buf:TEkran10Eh;Font:PFont;X, Y:Integer;CONST S:STRING;C:Word;StepX:Byte);

VAR A, B, Count:Byte;
   Ex:Integer;
   Line:Pointer;
   DX0, DY:Integer;
   Change:Integer;
   Nr, SP, Temp:Byte;
   RectX:TRect;

BEGIN
 S_Move32(@DefaultRect, @RectX, SizeOf(TRect));

 IF (Font=NIL) OR (Font^.Wzor=NIL) OR (Font^.TabKon=NIL) OR (Font^.TabAscii=NIL) THEN Exit;

 {Ustalanie liczby wyswietlanych znakow}
 IF (RectX.W+RectX.X-1-X)
 Count:=(RectX.W+RectX.X-1-X) DIV StepX;
 IF Byte(S[0])
 {Kiedy nic nie trzeba rysowac}
 IF (Y=RectX.Y+RectX.H) OR
    (Count*StepX=RectX.W+RectX.X) THEN EXIT;



 DX0:=X;
 SP:=1;

 IF X     BEGIN
      SP:=((RectX.X-X) DIV StepX);
      IF ((RectX.X-X) MOD StepX<>0) THEN INC(SP);
      DX0:=RectX.X+StepX*SP-(RectX.X-X);
      INC(SP);
    END;

 FOR A:=SP TO Count DO
 BEGIN
   Change:=101-Y;IF Change<0 THEN Change:=0;
   IF Change>0 THEN Line:=Buf.Ekr1 ELSE Line:=Buf.Ekr2;
   Temp:=Font^.TabAscii^[BYTE(S[A])];

   FOR B:=0 TO 7 DO
   BEGIN
     IF (B+Y>=RectX.Y+RectX.H) OR (B+Y
     IF Change>0 THEN
     BEGIN
       Dec(Change);
       IF Change=0 THEN Line:=Buf.Ekr2;
     END;


     IF (Temp>0) AND (Temp<=Font^.MaxL)
        THEN Nr:=Font^.Wzor^[Temp, B]
        ELSE Nr:=BrakZnaku[B];

     IF NOT V_TextNormal THEN Nr:=NOT Nr;
     Ex:=B+Y;
     IF Ex>99 THEN DEC(Ex, 100);

     IF Ex>=100 THEN Break;
     IF Ex>=0 THEN
        ASM
          Les  Di, Line
          Mov  Ax, Ex
          Shl  Ax, 7
          Add  Di, Ax
          Shl  Ax, 2
          Add  Di, Ax
          Mov  Ax, DX0
          Shl  Ax, 1
          Add  Di, Ax

          Mov  Dl, Nr
          Mov  Cx, 8
          Mov  Bl, 10000000b
          Mov  Ax, C

          Cld


          @Rysowanie:

            Test Bl, Dl
            Jz   @NoDraw

            Mov  Es:[Di], Ax

          @NoDraw:

            Shr  Bl, 1
            Inc  Di
            Inc  Di

          Loop @Rysowanie

        END;

   END;

   Inc(DX0, StepX);
 END;

END;


PROCEDURE V_CenterText(Buf:TEkran10Eh;Font:PFont;X, Y:Integer;CONST S:STRING;C:Word;StepX:Byte);
BEGIN
 V_WriteXY(Buf, Font, X-((BYTE(S[0])*StepX) SHR 1), Y, S, C, StepX);
END;

PROCEDURE V_CenterTextRect(Buf:TEkran10Eh;Font:PFont;Rect:TRect;X, Y:Integer;CONST S:STRING;C:Word;StepX:Byte);
BEGIN
 V_WriteXY(Buf, Font, X-((BYTE(S[0])*StepX) SHR 1), Y, S, C, StepX);
END;

PROCEDURE V_CopyLine(Buf:TEkran10Eh; Dest:Pointer; X, Y, W:Integer);
VAR Temp:Pointer;
BEGIN

 IF Y<100 THEN Temp:=Buf.Ekr1 ELSE BEGIN Temp:=Buf.Ekr2;Y:=Y-100;END;

 ASM
   Mov  Cx, W
   Shl  Cx, 1
   Mov  Dx, Cx
   And  Dx, 3
   Shr  Cx, 2

   Push Ds

   Les  Di, Dest
   Lds  Si, Temp

   Mov  Ax, Y
   Shl  Ax, 7
   Add  Si, Ax
   Shl  Ax, 2
   Add  Si, Ax

   Add  Si, X
   Add  Si, X

   Cld
   Db   $F3,$66,$A5

   Mov  Cx, Dx
   Rep  MovSb

   Pop  Ds
 END;
END;

PROCEDURE V_CopyFromLine(Buf:TEkran10Eh; Line:Pointer; X, Y, W:Integer);
VAR Temp:Pointer;
BEGIN

 IF Y<100 THEN Temp:=Buf.Ekr1 ELSE BEGIN Temp:=Buf.Ekr2;Y:=Y-100;END;
 IF X+W>=320 THEN W:=320-X;

 ASM
   Mov  Cx, W
   Shl  Cx, 1
   Mov  Dx, Cx
   And  Dx, 3
   Shr  Cx, 2

   Push Ds

   Les  Di, Temp
   Lds  Si, Line

   Mov  Ax, Y
   Shl  Ax, 7
   Add  Di, Ax
   Shl  Ax, 2
   Add  Di, Ax

   Add  Di, X
   Add  Di, X

   Cld
   Db   $F3,$66,$A5

   Mov  Cx, Dx
   Rep  MovSb

   Pop  Ds
 END;
END;

PROCEDURE V_CreateMirroredBMP(VAR Source, Dest:TPicture);
VAR Temp   : Pointer;
   Tmp    : Pointer;
   Needed : Word;
   W, H   : Integer;
BEGIN
 IF NOT Assigned(Source) OR NOT Assigned(Source^.BMP) THEN Exit;

 IF NOT Assigned(Dest) THEN
    V_NewImage(Dest);

 W:=Source^.W;
 H:=Source^.H;
 Needed:=2*W*H;

 Dest^:=Source^;
 Tmp:=Source^.BMP;

 IF MaxAvail>=Needed THEN
 BEGIN
   GetMem(Temp, Needed);
   Dest^.BMP:=Temp;
 END ELSE Exit;

 ASM
   Push Ds
   Les  Di, Temp
   Lds  Si, Tmp

   Mov  Cx, H

   @kopiujpion:
     Push Cx
     Mov  Cx, W

     Add  Di, Cx
     Add  Di, Cx



       @kopiujpoziom:
         Dec Di
         Dec Di

         Mov Ax,Ds:[Si]
         Mov Es:[Di], Ax

         Inc Si
         Inc Si
       Loop @kopiujpoziom

     Mov  Cx, W

     Add  Di, Cx
     Add  Di, Cx

     Pop Cx
   Loop @kopiujpion

   Pop  Ds
 END;

END;

PROCEDURE V_PrintScreen(CONST Fn:STRING);
TYPE
  TByteArr= ARRAY [ 0..0] OF Byte;
  TWordArr= ARRAY [ 0..0] OF Word;

VAR BMPCapt : TBMPCaption;
   F:FILE;
   Line:Pointer;
   Temp:Pointer;
   i, j:Integer;
   R, G, B:Byte;

BEGIN
 WITH BMPCapt DO
 BEGIN
   BM:=Byte('M') SHL 8 OR Byte('B');
   Size:=SizeOf(TBMPCaption)+V_MaxEX*V_MaxEy*3;
   rezerw:=0;
   obraz_offset:=SizeOf(TBMPCaption);
   info:=40;
   Width:=V_MaxEX;
   Height:=V_MaxEY;
   LPO:=1;
   BPP:=24;
   kompresja:=0;
   Size_Obr:=V_MaxEX*V_MaxEy*3;
   HDPI:=96;
   VDPI:=96;
   Colors:=0;
   UColors:=0;
 END;

 GetMem(Line, V_MaxEX*2);
 GetMem(Temp, V_MaxEX*3);

 Assign(F, Fn);
 Rewrite(F, 1);
 BlockWrite(F, BMPCapt, SizeOf(TBMPCaption));

 FOR i:= V_MaxEY-1 DOWNTO 0 DO
 BEGIN
   V_CopyLine(V_Ekran, Line, 0, i, V_MaxEX*2);
   FOR j:=0 TO V_MaxEX-1 DO
   BEGIN
     V_ToRGB(TWordArr(Line^)[j], R, G, B);
     TByteArr(Temp^)[j*3]:=B;
     TByteArr(Temp^)[j*3+1]:=G;
     TByteArr(Temp^)[j*3+2]:=R;
   END;

   BlockWrite(F, Temp^, V_MaxEX*3);
 END;


 FreeMem(Line, V_MaxEX*2);
 FreeMem(Temp, V_MaxEX*3);

 Close(F);
END;

PROCEDURE ShowCaptionBMP(CONST Fn:STRING);
VAR BMPCapt : TBMPCaption;
   F:FILE;

BEGIN
 Assign(F, Fn);
 Reset(F, 1);
 BlockRead(F, BMPCapt, SizeOf(TBMPCaption));
 Close(F);
 WITH BMPCapt DO
 BEGIN
   WriteLn(Size);
   WriteLn(info);
   WriteLn(rezerw);
   WriteLn(obraz_offset, ' ', SizeOf(TBMPCaption));
   WriteLn(LPO);
   WriteLn(kompresja);
   WriteLn(Colors);
   WriteLn(UColors);
 END;
END;

BEGIN
 DefaultRect:=EkranRect;
END.

ON-LINE scripts!

This website uses cookie files in order to provide Google services (advertisements, analitycs) and Facebook. If you want to block using cookies, turn them off in your browser settings. Need a help? Click me