home *** CD-ROM | disk | FTP | other *** search
- Unit FADEUNIT;
- {$D-,S-}
-
- Interface
-
- const
- Palette : array[0..767] of Byte = (
- 0,0,0,0,0,42,0,42,0,0,42,42,42,0,0,42,0,42,42,42,0,42,42,42,0,0,21,0,0,63,0,42,
- 21,0,42,63,42,0,21,42,0,63,42,42,21,42,42,63,0,21,0,0,21,42,0,63,0,0,63,42,42,
- 21,0,42,21,42,42,63,0,42,63,42,0,21,21,0,21,63,0,63,21,0,63,63,42,21,21,42,21,
- 63,42,63,21,42,63,63,21,0,0,21,0,42,21,42,0,21,42,42,63,0,0,63,0,42,63,42,0,63,
- 42,42,21,0,21,21,0,63,21,42,21,21,42,63,63,0,21,63,0,63,63,42,21,63,42,63,21,21,
- 0,21,21,42,21,63,0,21,63,42,63,21,0,63,21,42,63,63,0,63,63,42,21,21,21,21,21,63,
- 21,63,21,21,63,63,63,21,21,63,21,63,63,63,21,63,63,63,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0);
-
- Var Pal_Buf: Array[0..1535] of byte;
-
- {$L FADE}
- Procedure W_Palette;
- Procedure FadeIn;
- Procedure FadeOut;
- Procedure FI;
- Procedure FO;
-
- Implementation
-
- procedure FI; external {FADE};
- procedure FO;external {FADE};
-
- Procedure W_Palette;assembler;
- ASM
- lea si,[pal_buf]
- mov bh,0
- mov bl,2
-
- mov cx,128*3
- @s:
- mov dx, 03DAh
- @v1:
- in al, dx
- test al,08h
- jnz @v1
- @v2:
- in al, dx
- test al,08h
- jz @v2
-
-
- mov al,bh
- mov dx,3c8h
- push cx
- out dx,al
- inc dx
- rep outsb
- pop cx
- add bh,128
- dec bl
- jnz @s
- end;
-
- Procedure FadeIn;
- var
- ColorOn : Longint;
- bp : byte;
-
- Begin
- For bp := 0 to 31 do Begin
- asm
- mov ax,seg Pal_buf
- mov ds,ax
- mov si,offset pal_buf
-
- mov ax,seg Palette
- mov es,ax
- mov di,offset palette
-
- end;
- FI;
- W_Palette;
- end;
- end;
-
- Procedure FadeOut;
- var
- ColorOn : Longint;
- bp : byte;
-
- Begin
- For ColorOn := 0 to 767 do
- Begin
- Pal_Buf[ColorOn] := Palette[ColorOn];
- end;
- For bp := 0 to 31 do Begin
- Asm
- mov ax,seg Pal_buf
- mov ds,ax
- mov si,offset pal_buf
- end;
- FO;
- W_Palette;
- end;
- end;
- End.
-