unit Xlib;
interface
        type
                ColorType = record
                        Red,Green,Blue:byte;
        end; {record}

TableType = array[0..45,0..300] of integer;

                SpeedRangeType = 0..10;

                SizeSubRange = 1..10;

                ImageType = record
                        deltaX,deltaY:longint;
                        vSegment,vOffset:word;
                        Image:pointer;
                end; {record}

                FontEnumeratedType = (Regular);

                FontType = record
                        Size:SizeSubRange;
                end; {record}

                SomePaletteType = array[0..255] of ColorType;

                PictureType = record
                        picture:ImageType;
                        Palette:^SomePaletteType;
                end; {record}

                ColorRecordType = record
                        Color:ColorType;
                        IsAPoint:Boolean;
                        Location:byte;
                end; {record}

                GradatedPalType = array[0..255] of ColorRecordType;

                GradatedPaletteType = ^GradatedPalType;


        procedure InitGraph;
        procedure CloseGraph;

        procedure SetColor(AColor:byte);
        function GetColor:byte;

        procedure PutPixel(x,y:word);
        function GetPixel(x,y:word):byte;

        procedure SetPalette(ColorNumber:byte;AColor:ColorType);
        procedure GetPalette(ColorNumber:byte;var TheColor:ColorType);
        procedure FadeScreen(Speed:SpeedRangeType);

        procedure ClearScreen;
        procedure Circle(x,y,Radius:word);
        procedure Line(x1,y1,x2,y2:word);
        procedure Bar(BeginX,BeginY,EndX,EndY:word);
        procedure Rectangle(BeginX,BeginY,EndX,EndY:word);
        procedure Fill(x,y:word;FillColor,Border:byte);

        procedure GetImage(var Image:ImageType;x1,y1,x2,y2:word);
        procedure PutImage(Image:ImageType;x1,y1:word);
        procedure KillImage(var Image:ImageType);

        procedure PutChar(Font:FontEnumeratedType;xc,yc:word;AChar:char);
        procedure WriteStringXY(Font:FontEnumeratedType;xc,yc:word;Thing:string);
        procedure WriteString(Font:FontEnumeratedType;Thing:string);

        procedure LoadTGA(var Image:PictureType;FileName:string);
        procedure DrawPicture(x1,y1:word;Image:PictureType;BeginPart,EndPart:byte);
        procedure KillPicture(var Image:PictureType);

        procedure InitGradatedPalette(var SomePalette:GradatedPaletteType);
        procedure AddKeyPoint(var SomePalette:GradatedPaletteType;Location:byte;Color:ColorType);
        procedure GeneratePalette(SomePalette:GradatedPaletteType);
        procedure KillGradatedPalette(var SomePalette:GradatedPaletteType);

implementation
        uses CRT;

        const
                PI = 3.1415926;
                VGA:Word = $a000;
                IOOk=0;
                Video=$10;
                Crtc_addr=$3d4;
                Sequ_addr=$3c4;
                TGASize:longint = 64000;

        type
                ByteBitType = array[1..8] of boolean;

                PCXFileType = file of char;

                EGAPalType = array[0..47] of byte;

                JunkType = array[0..57] of byte;

                PCXHeaderType = record
                        Manufacturer:char;                {for some reason, always 10}
                        Version:char;                        {who cares}
                        Encoding:char;                        {always 1 for RLE}
                        BitDepth:char;                        {should be eight - wierd things if not}
x,y:word;                                {upper left corner of the image}
width,height:word;                {Duh}
                        HRes,VRes:word;                        {Number of pixels in x & y direction}
                        EGAPalette:EGAPalType;        {who cares, we use MCGA+}
                        Reserved:char;                        {Nothing}
                        ColorPlanes:char;                {Number of color planes in the image}
                        BytesPerLine:word;                {Number of bytes per line}
PaletteType:word;                {Unimportant}
                        Padding:JunkType;                {Fat at the end of the file}
                end; {PCXHeaderType}

                PaletteFileType = file of ColorType;

                PortLookUpType = array[0..640] of word;
                yLookUpType = array[0..400] of word;

        var
                SinRadiusTable,CosRadiusTable:TableType;
                CurrentDrawingColor:byte;
                HasBeenInitialized:boolean;
                CurrentTextX,CurrentTextY:word;
                PortLookUp:PortLookUpType;
                yLookUp:yLookUpType;
                CurrentPort:word;

        function Abs(x:integer):word;
begin
                if x<0 then
                        Abs:=-x
else
                        Abs:=x;
end; {Abs}

procedure AnnoyingErrorMessage;
        begin
                if not HasBeenInitialized then begin
                        writeln('Error #666: The screen has not be initialized. Please call InitGraph;');
halt;
end; {if}
        end; {AnnoyingErrorMessage}

        procedure SetXtended;
        begin
                asm
                        mov ax, $4F02
                        mov bx, $100
                        int VIDEO
                end;

                { Turn the VGA screen off }
                Port[SEQU_ADDR] := 1;
                Port[SEQU_ADDR + 1] := Port[SEQU_ADDR + 1] or $20;

                { Turn off the Chain-4 bit (bit 3 at index 4, port 0x3c4) }
                PortW[SEQU_ADDR] := $0604;

                { Turn off word mode, by setting the Mode Control register
                 of the CRT Controller (index 0x17, port 0x3d4) }
                PortW[CRTC_ADDR] := $E317;

                { Turn off doubleword mode, by setting the Underline Location
                 register (index 0x14, port 0x3d4) }
                PortW[CRTC_ADDR] := $0014;

                { Clear entire video memory, by selecting all four planes, then writing
                color 0 to the entire segment. Stoopid FillChar fills 1 byte too short! }
                PortW[SEQU_ADDR] := $0F02;
                FillChar(Mem[$A000 : 0], $8000, 0);
                FillChar(Mem[$A000 : $8000], $8000, 0);

                { Give a small delay to let the screen sort itself out }
                Delay(100);

                { Turn the screen back on }
                Port[SEQU_ADDR] := 1;
                Port[SEQU_ADDR + 1] := Port[SEQU_ADDR + 1] and $DF;
        end; {SetXtended}

        procedure InitGraph;
        var
        x,Radius:integer;
                Constant:real;
ymov,tymov:word;
        begin
                HasBeenInitialized:=TRUE;
                Constant:=PI/180;
                writeln('Computing port lookup table...');
                for x:=0 to 640 do
                        PortLookUp[x]:=$100 shl (x and 3) + 2;
                writeln('Computing y lookup table...');
                for x:=0 to 400 do
                        yLookUp[x]:=x shl 7 + x shl 5;
                writeln('Computing sine and cosine lookup tables...');
for Radius:=0 to 300 do
                 for x:=0 to 45 do begin
                                 SinRadiusTable[x,Radius]:=trunc(sin(x*Constant)*Radius);
         CosRadiusTable[x,Radius]:=trunc(cos(x*Constant)*Radius);
                 end; {for}
                CurrentTextX:=0; CurrentTextY:=0;
                SetXtended;
                SetColor(15);
                CurrentPort:=PortLookUp[0];
        end; {InitGraph}

        procedure CloseGraph;
        begin
AnnoyingErrorMessage;
                asm
                mov ax,0003h
                int 10h
                end; {asm}
                writeln('This program uses Mark Rosen''s graphics library.');
writeln('Send E-Mail to mrosen@peganet.com for more information');
        end; {CloseGraph}

        procedure SetColor(AColor:byte);
        begin
                AnnoyingErrorMessage;
                CurrentDrawingColor:=AColor mod 256;
        end; {SetColor}

        function GetColor:byte;
        begin
AnnoyingErrorMessage;
                GetColor:=CurrentDrawingColor;
        end; {GetColor}

        procedure PutPixel(x,y:word);
        var
                t:word;
        begin
                if CurrentPort<>PortLookUp[x] then begin
                        PortW[SEQU_ADDR] := PortLookUp[x];
                        CurrentPort:=PortLookUp[x];
                end; {if}

                { Calculate address (y * 160 + x div 4) and write pixel }
                Mem[$A000 : yLookUp[y]+x shr 2] := CurrentDrawingColor;
        end; {PutPixel}

        function GetPixel(x,y:word):byte;
        var
                t:word;
        begin
                PortW[SEQU_ADDR] := PortLookUp[x];

                { Calculate address (y * 160 + x div 4) and write pixel }
                GetPixel:=Mem[$A000 : yLookUp[y]+x shr 2];
        end; {GetPixel}

        procedure SetPalette(ColorNumber:byte;AColor:ColorType);
        begin
                AnnoyingErrorMessage;
                asm
                        mov dx,3c8h
                        mov al,[ColorNumber]
                        out dx,al
                        inc dx
                        mov al,[AColor.Red]
                        out dx,al
                        mov al,[AColor.Green]
                        out dx,al
                        mov al,[AColor.Blue]
                        out dx,al
                end; {asm}
        end; {SetAPaletteEntry}

        procedure GetPalette(ColorNumber:byte;var TheColor:ColorType);
        var
                Rt,Gt,Bt:byte;
        begin
                AnnoyingErrorMessage;
                Rt:=TheColor.Red; Gt:=TheColor.Green; Bt:=TheColor.Blue;
                asm
                        mov dx, 3c7h
                        mov al, [ColorNumber]
                        out dx, al
                        inc dx
                        inc dx
                        in al, dx
                        mov [Rt],al
                        in al, dx
                        mov [Gt],al
                        in al, dx
                        mov [Bt],al
                end; {asm}
                TheColor.Red:=Rt; TheColor.Green:=Gt; TheColor.Blue:=Bt;
        end; {GetAPaletteEntry}

        procedure FadeScreen(Speed:SpeedRangeType);
        var
                HaveChangedSomething:boolean;
        CurrentColor:ColorType;
                x,Counter:integer;
        begin
AnnoyingErrorMessage;
                HaveChangedSomething:=TRUE;
                while HaveChangedSomething do begin
                        Delay(5*(10-Speed));
                        HaveChangedSomething:=FALSE;
                        for x:=0 to 255 do begin
        GetPalette(x,CurrentColor);
        if CurrentColor.Red<>0 then begin
        dec(CurrentColor.Red);
                                        HaveChangedSomething:=TRUE;
end; {if}
        if CurrentColor.Green<>0 then begin
                                        dec(CurrentColor.Green);
                                        HaveChangedSomething:=TRUE;
end; {if}
        if CurrentColor.Blue<>0 then begin
                                        dec(CurrentColor.Blue);
                                        HaveChangedSomething:=TRUE;
                                end; {if}
SetPalette(x,CurrentColor);
end; {for}
                end; {while}
        end; {FadeScreen}

        procedure Line(x1, y1, x2, y2 : word);
        var i,DeltaX,DeltaY,numpixels,
d,dinc1,dinc2,
x,xinc1,xinc2,
y,yinc1,yinc2:integer;
begin
        DeltaX:=abs(x2-x1);
                DeltaY:=abs(y2-y1);
                if DeltaX>=deltay then begin
                        numpixels:=DeltaX+1;
                        d:= (2*deltay)-DeltaX;
                        dinc1:=deltay shl 1;
                        dinc2:=(deltay-DeltaX) shl 1;
                        xinc1:=1;
                        xinc2:=1;
                        yinc1:=0;
                        yinc2:=1;
                end {if}
                else begin
                        numpixels:=deltay+1;
                        d:=(2*DeltaX)-deltay;
                        dinc1:=DeltaX shl 1;
                        dinc2:=(DeltaX-deltay) shl 1;
                        xinc1:= 0;
                        xinc2:= 1;
                        yinc1:=1;
                        yinc2:=1;
                end; {else}
                if x1 > x2 then begin
                        xinc1:=-xinc1;
                        xinc2:=-xinc2;
                end; {if}
                if y1>y2 then begin
                        yinc1:=-yinc1;
                        yinc2:=-yinc2;
                end; {if}
                x:=x1;
                y:=y1;
                for i := 1 to numpixels do begin
                        PutPixel(x,y);
                        if d < 0 then begin
                                d:= d+dinc1;
                                x:= x+xinc1;
                                y:= y+yinc1;
                        end {f}
                        else begin
                                d:= d+dinc2;
                                x:= x+xinc2;
                                y:= y+yinc2;
                        end; {else}
                end; {for}
        end; {Line}

        procedure Bar(BeginX,BeginY,EndX,EndY:word);
var
                y,x:word;
size:word;
begin
                AnnoyingErrorMessage;
                for x:=BeginX to EndX do
                        for y:=BeginY to EndY do
                                putpixel(x,y);
        end; {Box}

        procedure Rectangle(BeginX,BeginY,EndX,EndY:word);
begin
AnnoyingErrorMessage;
                Line(BeginX,EndX,BeginY,EndY);
                Line(BeginX,EndX,BeginY,EndY);
                Line(BeginX,EndX,BeginY,EndY);
                Line(BeginX,EndX,BeginY,EndY);
end; {Rectangle}

        procedure Circle(x,y,Radius:word);
        var
        Angle,RealX,RealY,
                XPlusRealX,XMinusRealX,XPlusRealY,XMinusRealY,
YPlusRealY,YMinusRealY,YPlusRealX,YMinusRealX:word;
begin
                for Angle:=0 to 45 do begin
        RealX:=CosRadiusTable[Angle,Radius];
RealY:=SinRadiusTable[Angle,Radius];

XPlusRealX:=x+RealX; XPlusRealY:=x+RealY;
XMinusRealX:=x-RealX; XMinusRealY:=x-RealY;

                        YPlusRealY:=y+RealY; YPlusRealX:=y+RealX;
YMinusRealY:=y-RealY; YMinusRealX:=y-RealX;

putpixel(XPlusRealX,YPlusRealY);
putpixel(XPlusRealX,YMinusRealY);
putpixel(XMinusRealX,YPlusRealY);
putpixel(XMinusRealX,YMinusRealY);

putpixel(XPlusRealY,YPlusRealX);
putpixel(XPlusRealY,YMinusRealX);
putpixel(XMinusRealY,YPlusRealX);
putpixel(XMinusRealY,YMinusRealX);
                end; {for}
        end; {Circle}

        procedure RecursiveFill(x,y:word;FillColor,Border:byte);
var
        Direction:byte;
begin
if (GetPixel(x,y)<>FillColor) and (GetPixel(x,y)<>Border) then begin
putpixel(x,y);
                 for Direction:=1 to 4 do begin
                                if (Direction=1) and (y>0) then
                 RecursiveFill(x,y-1,FillColor,Border)
else if (Direction=2) and (x<319) then
        RecursiveFill(x+1,y,FillColor,Border)
else if (Direction=3) and (y<199) then
        RecursiveFill(x,y+1,FillColor,Border)
else if (Direction=4) and (x>0) then
        RecursiveFill(x-1,y,FillColor,Border);
         end; {for}
        end; {if}
end; {RecursiveFill}

procedure Fill(x,y:word;FillColor,Border:byte);
begin
        setcolor(FillColor);
        RecursiveFill(x,y,FillColor,Border);
        end; {Fill}

        procedure GetImage(var Image:ImageType;x1,y1,x2,y2:word);
var
        yImg,yShl,x,y,size,vSeg,vOfs:word;
begin
        Image.DeltaX:=abs(x1-x2); Image.DeltaY:=abs(y1-y2);
GetMem(Image.Image,(Image.DeltaX+1)*(Image.DeltaY+1));
Image.vSegment:=seg(Image.Image^); vSeg:=Image.vSegment;
Image.vOffset:=ofs(Image.Image^); vOfs:=Image.vOffset;

                for x:=x1 to x2 do begin
                        for y:=y1 to y2 do begin
                                Mem[Image.vSegment:Image.vOffset+((y-y1)*(Image.DeltaX+1))+(x-x1)]:=GetPixel(x,y);
                        end; {for}
                end; {for}
end; {GetImage}

procedure PutImage(Image:ImageType;x1,y1:word);
var
        yImg,yShl:word;
                x,y:word;
        begin
                for x:=0 to Image.DeltaX do begin
                        for y:=0 to Image.DeltaY do begin
                                setcolor(Mem[Image.vSegment:Image.vOffset+(y*(Image.DeltaX+1))+x]);
                                putpixel(x+x1,y+y1);
                        end; {for}
                end; {for}
        end; {PutImage}

procedure KillImage(var Image:ImageType);
begin
AnnoyingErrorMessage;
                FreeMem(Image.Image,(Image.DeltaX+1)*(Image.DeltaY+1));
        end; {KillImage}

        function Exp(base,exponent:word):word;
        var
                Temp,x:word;
        begin
                Temp:=1;
                for x:=1 to exponent do
         Temp:=Temp*base;
Exp:=Temp;
end; {Exp}

procedure ConvertDecimalToBinary(Something:word;var Bin:ByteBitType);
var
         x:byte;
temp:word;
begin
         for x:=1 to 8 do
         Bin[x]:=FALSE;
         for x:=7 downto 0 do begin
         temp:=trunc(Something div Exp(2,x));
if temp>0 then Something:=Something-Exp(2,x);
                        if temp=1 then
                                Bin[x+1]:=TRUE;
                end; {for}
        end; {ConvertDecimalToBinary}

        procedure PutChar(Font:FontEnumeratedType;xc,yc:word;AChar:char);
var
        x,y:word;
Line:byte;
Temp:ByteBitType;
begin
AnnoyingErrorMessage;
for y:=0 to 7 do begin
         Line:=Mem[$F000:$FA6E+(ord(AChar)*8)+y];
ConvertDecimalToBinary(Line,Temp);
for x:=1 to 8 do
         if Temp[x] then putpixel((9-x)+xc,y+yc);
         end;
        end; {PutChar}

procedure WriteStringXY(Font:FontEnumeratedType;xc,yc:word;Thing:string);
var
        TempX,TempY:word;
x:byte;
begin
                AnnoyingErrorMessage;
        TempX:=xc; TempY:=yc;
for x:=1 to ord(Thing[0]) do begin
        PutChar(Font,TempX,TempY,Thing[x]);
TempX:=TempX+8;
if TempX>311 then begin
                                TempX:=1;
                                TempY:=TempY+8;
end; {if}
end; {for}
end; {WriteStringXY}

procedure WriteString(Font:FontEnumeratedType;Thing:string);
var
        TempX,TempY:word;
x:byte;
begin
AnnoyingErrorMessage;
        TempX:=CurrentTextX; TempY:=CurrentTextY;
                for x:=1 to ord(Thing[0]) do begin
                        PutChar(Font,TempX,TempY,Thing[x]);
                        TempX:=TempX+8;
                        if TempX>311 then begin
                                TempX:=1;
                                TempY:=TempY+8;
                        end; {if}
                end; {for}
                CurrentTextX:=CurrentTextX+TempX;
                CurrentTextY:=CurrentTextY+TempY;
        end; {WriteString}

        procedure FlipImage(var SomeImage:ImageType);
        var
                ey,by,HalfY,x,y:word;
                p1seg,p1ofs,p2seg,p2ofs:word;
                DeltaXPlus,DeltaYPlus:word;
                Temp:byte;
        begin
                DeltaXPlus:=SomeImage.DeltaX+1; DeltaYPlus:=SomeImage.DeltaY+1;
                HalfY:=((DeltaYPlus) div 2)-1;
                by:=SomeImage.vOffset; ey:=SomeImage.vOffset+(DeltaXPlus*DeltaYPlus);
                p1seg:=SomeImage.vSegment; p2seg:=SomeImage.vSegment;
                for y:=0 to HalfY do begin
                        ey:=ey-DeltaXPlus;
                        for x:=0 to SomeImage.DeltaX do begin
                                Temp:=Mem[p1seg:by];
                                Mem[p1seg:by]:=Mem[p2seg:ey];
                                Mem[p2seg:ey]:=Temp;
                                inc(ey);
                                inc(by);
                        end; {for}
                        ey:=ey-DeltaXPlus;
                end; {for}
        end; {FlipImage}

        procedure LoadTGA(var Image:PictureType;FileName:string);
        var
                fp:file;
                TempPalAndHeadPtr:pointer;
                TempImage:ImageType;
                vSeg,vOfs,x:word;
                TempColor:ColorType;
                Size,CurSize:longint;
                t,tOfs:longint;
        begin
                assign(fp,FileName);
                reset(fp,1);                                {no error checking as of yet}

                GetMem(TempPalAndHeadPtr,786);
                new(Image.Palette);

                BlockRead(fp,TempPalAndHeadPtr^,786);
                vSeg:=seg(TempPalAndHeadPtr^); vOfs:=ofs(TempPalAndHeadPtr^);
                Image.Picture.DeltaX:=(Mem[vSeg:vOfs+13] shl 8)+Mem[vSeg:vOfs+12]-1;
                Image.Picture.DeltaY:=(Mem[vSeg:vOfs+15] shl 8)+Mem[vSeg:vOfs+14]-1;
                vOfs:=vOfs+18;
                for x:=0 to 255 do begin
                        TempColor.Blue:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        TempColor.Green:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        TempColor.Red:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        Image.Palette^[x]:=TempColor;
                end; {for}

                T:=filesize(fp);
                Size:=(Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1);
                GetMem(Image.Picture.Image,(Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1));
                Image.Picture.vSegment:=seg(Image.Picture.Image^);
                Image.Picture.vOffset:=ofs(Image.Picture.Image^);
                seek(fp,786);
{                blockread(fp,Image.picture.image^,size);}
                if (Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1)<=TGASize then begin
                        BlockRead(fp,Image.picture.image^,size);
                end {if}
                else begin
                        tOfs:=Image.picture.vOffset;
                        CurSize:=0;
                        for x:=1 to size div (TGASize) do begin
                                blockread(fp,ptr(Image.Picture.vSegment,tOfs)^,TGASize-2);
                                tOfs:=tOfs+TGASize;
                                CurSize:=CurSize+TGASize;
                        end; {for}
                        blockread(fp,ptr(Image.Picture.vSegment,tOfs)^,Size-CurSize);
                end; {else}
                FreeMem(TempPalAndHeadPtr,786);

                FlipImage(Image.Picture);
                close(fp);
        end; {LoadTGA}

        procedure DrawPicture(x1,y1:word;Image:PictureType;BeginPart,EndPart:byte);
        var
                x,vSeg,vOfs:word;
                Color:byte;
        begin
                for x:=BeginPart to EndPart do
                        setpalette(x,Image.Palette^[x]);
                PutImage(Image.Picture,x1,y1);
        end; {DrawPicture}

        procedure KillPicture(var Image:PictureType);
begin
                KillImage(Image.Picture);
dispose(Image.Palette);
        end; {KillPicture}

        procedure ClearScreen;
        var
                x,y:word;
        begin
                setcolor(0);
                for x:=0 to 639 do
                        for y:=0 to 479 do
                                putpixel(x,y);
        end; {ClearScreen}

procedure InitGradatedPalette(var SomePalette:GradatedPaletteType);
var
        Black:ColorType;
x:byte;
begin
AnnoyingErrorMessage;
        new(SomePalette);
        Black.Red:=0; Black.Green:=0; Black.Blue:=0;
        for x:=0 to 255 do begin
                        SomePalette^[x].Color:=Black;
SomePalette^[x].IsAPoint:=FALSE;
end; {for}
end; {InitGradatedPalette}

procedure AddKeyPoint(var SomePalette:GradatedPaletteType;Location:byte;
                                                 Color:ColorType);
begin
AnnoyingErrorMessage;
SomePalette^[Location].Color:=Color;
SomePalette^[Location].IsAPoint:=TRUE;
SomePalette^[Location].Location:=Location;
end; {AddKeyPoint}

procedure GeneratePalette(SomePalette:GradatedPaletteType);
var
TempColor:ColorType;
        Temp1,Temp2:ColorRecordType;
Location1,Location2:byte;
x,y:byte;
                Number:byte;
Temp:array[0..255] of ColorRecordType;
RealRed,RealGreen,RealBlue,
IncRed,IncGreen,IncBlue:real;
DeltaLoc:word;
begin
AnnoyingErrorMessage;
        Number:=0;
{Condense the palette into only hot points}
        for x:=0 to 255 do begin
                        if SomePalette^[x].IsAPoint then begin
        Temp[Number]:=SomePalette^[x];
Number:=Number+1;
end; {if}
end; {for}
{actually gradate the palette}
for x:=0 to Number-1 do begin
Location1:=Temp[x].Location;
Location2:=Temp[x+1].Location;
DeltaLoc:=abs(Location2-Location1);
RealRed:=Temp[x].Color.Red; RealGreen:=Temp[x].Color.Green;
                        RealBlue:=Temp[x].Color.Blue;
                        IncRed:=(Temp[x+1].Color.Red-Temp[x].Color.Red)/DeltaLoc;
IncGreen:=(Temp[x+1].Color.Green-Temp[x].Color.Green)/DeltaLoc;
IncBlue:=(Temp[x+1].Color.Blue-Temp[x].Color.Blue)/DeltaLoc;
                        for y:=Location1 to Location2 do begin
        TempColor.Red:=trunc(RealRed); TempColor.Green:=trunc(RealGreen);
TempColor.Blue:=trunc(RealBlue);
                                setpalette(y,TempColor);
RealRed:=RealRed+IncRed;
RealGreen:=RealGreen+IncGreen;
RealBlue:=RealBlue+IncBlue;
                        end; {for}
end; {for}
end; {GeneratePalette}

procedure KillGradatedPalette(var SomePalette:GradatedPaletteType);
begin
AnnoyingErrorMessage;
dispose(SomePalette);
end; {KillGradatedPalette}


end. {Xlib}