home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
KMAGV2.ZIP
/
FADEEXAM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-10-23
|
6KB
|
166 lines
{FADEEXAM.PAS / EXAMPLE FOR FADE SCREEN}
{WRITING BY THE KING IN 10/22/95 }
Uses Crt;
Type
RGB = Record {A Record Of Red,Green,Blue}
R,G,B:Byte;
End;
PalType = Array[0..255] Of RGB; {256 Color Of Red Green Blue}
Var
Pal : PalType; {Palette For Start}
Pal1 : PalType; {Palette For The Picture}
{-------------------------------------------------------}
{Get Red Green And Blue From a Color }
{-------------------------------------------------------}
Procedure GetColor(Col:Byte;Var R,G,B:Byte);Assembler;
ASM
Mov Dx,3c7H {Set To GET COLOR}
Mov Al,Col
Out Dx,Al
Inc Dx {Dx = 3c8H}
Inc Dx {Dx = 3c9H}
Les Di,R {Es:Di = R}
In Al,Dx {Get Red Value}
Mov [Es:Di],Al {R = Red Value}
In Al,Dx {Get Green Value}
Les Di,G {Es:Di = G}
Mov [Es:Di],Al {G = Green Value}
In Al,Dx {Get Blue Value}
Les Di,B {Es:Di = B}
Mov [Es:Di],Al {B = Blue Value}
END;
{-------------------------------------------------------}
{Set Red Green And Blue To a Color }
{-------------------------------------------------------}
Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
Asm
Mov Dx,3c8h {SET TO SET COLOR}
Mov Al,Col
Out Dx,Al
Inc Dx {DX = 3c9h}
Mov Al,R {Senting Red Value}
Out Dx,Al
Mov Al,G {Senting Green Value}
Out Dx,Al
Mov Al,B {Senting Blue Value}
Out Dx,Al
End;
{------------------------------------------------}
{Set Mode To Mode 13H , 320x200x256 Colors.. }
{------------------------------------------------}
Procedure SetMode;Assembler;
Asm
Mov Ah,00h {Function 00,13 Interrupt 10h / SET MODE}
Mov Al,13h
Int 10h {SETING TO MODE 13H}
End;
{------------------------------------------------}
{Plot a single pixel on the screen . }
{------------------------------------------------}
Procedure PutPixel(X,Y:Integer;Col:Byte);Assembler;
Asm
Mov Ax,0a000h {Ax = SEGMENT OF THE SCREEN}
Mov Es,Ax {Es = SEGMENT OF THE SCREEN}
Mov Ax,320 {Ax = MAX VERTICAL LINE}
Mul Y {Ax = AX * Y = HORIZONTAL LINE}
Add Ax,X {Ax = VERTICAL LINE + HORIZONTAL LINE = OFFSET}
Mov Di,Ax {DI = OFFSET}
Mov Al,Col {AL = COLOR}
StoSb {[0A000h:OFFSET] = COLOR}
End;
{------------------------------------------------}
{Set Mode To Mode 3H , 80x25x16 Colors.. }
{------------------------------------------------}
Procedure SetTextMode;Assembler;
Asm
Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
Mov Al,3h
Int 10h {SET MODE TO MODE 3 / TEXT MODE}
End;
{---------------------------------------------------}
{ Make a BLACK Palette }
{---------------------------------------------------}
Procedure ZeroPal(Var Pal:PalType);
Begin
FillChar(Pal,SizeOf(Pal),0);
End;
{---------------------------------------------------}
{ Show The Palette }
{---------------------------------------------------}
Procedure ShowPal(Var Pal:PalType);
Var T:Byte;
Begin
For T:=0 To 255 Do
SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Get The Use Palette From The Screen }
{---------------------------------------------------}
Procedure GetPal(Var Pal:PalType);
Var T:Byte;
Begin
For T:=0 To 255 Do
GetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Fill The Screen With Random Dots. }
{---------------------------------------------------}
Procedure FillPoints;
Var
T:Word;
Begin
For T:=1 To 65535 Do
Begin
PutPixel(Random(319),Random(199),Random(255));
End;
End;
{---------------------------------------------------}
{ Fade To The Screen From Palette To Palette. }
{---------------------------------------------------}
Procedure FadeTo(Pal,ToPal:PalType);
Var
T,T1:Byte;
Begin
For T1:=1 To 63 Do
Begin
For T:=1 To 255 Do
Begin
If Pal[T].R > ToPal[T].R Then
Dec(Pal[T].R);
If Pal[T].R < ToPal[T].R Then
Inc(Pal[T].R);
If Pal[T].G > ToPal[T].G Then
Dec(Pal[T].G);
If Pal[T].G < ToPal[T].G Then
Inc(Pal[T].G);
If Pal[T].B > ToPal[T].B Then
Dec(Pal[T].B);
If Pal[T].B < ToPal[T].B Then
Inc(Pal[T].B);
End;
ShowPal(Pal);
Delay(20); {Can Be Change To What Speed You Want}
End;
End;
Begin
{MAIN PROGRAM}
SetMode; {Set To 320X200X256 Mode}
GetPal(Pal); {Get Palette To Pal}
ZeroPal(Pal1); {Make Pal1 Black Palette}
ShowPal(Pal1); {Show The Black Palette That On Pal1}
FillPoints; {Fill The Screen With Points}
FadeTo(Pal1,Pal); {Fade From Black Screen To Pal}
Repeat
Until(Keypressed); {Wait For KeyPressed}
FadeTo(Pal,Pal1); {Fade From Pal To Black Screen}
SetTextMode; {Set To Text Mode Screen}
Writeln('Thanks For Watching My Example.');
End. {End Program}