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}
Published in: Pascal
Download

Related snippets