# Board index » delphi » Delphi4: Textured Polygons for Delphi Source needs a fixing

## Delphi4: Textured Polygons for Delphi Source needs a fixing

//
//  If anyone thinks they could fix this source so that is works and make a
small
//  demo, I would be very appreciative.  I've been messing with it for a
while.
//
//  I have been trying to convert some old DOS texture mappers into DELPHI
and
//  this is what I have done thus far.
//
//  rottweiler

unit TexturePoly;

interface

Uses
Windows, SysUtils, Graphics;

Type
TPoly4 = Record
case Integer of
0 : (x1,y1,x2,y2,x3,y3,x4,y4: Integer);
1 : (TopLeft, TopRight, BottomRight, BottomLeft: TPoint);
2 : (Points : Array[0..3] of TPoint);
end;

Procedure SwapIntegers(var A,B : Integer);
Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);

implementation

Function GetMaxInteger4(var A,B,C,D : Integer) : Integer;
var
T : Integer;
Begin
T := A;
If B > T then T := B;  If C > T then T := C;  If D > T then T := D;
Result := T;
End;

Function GetMinInteger4(var A,B,C,D : Integer) : Integer;
var
T : Integer;
Begin
T := A;
If B < T then T := B;  If C < T then T := C;  If D < T then T := D;
Result := T;
End;

Procedure SwapIntegers(var A,B : Integer);
var
T : Integer;
Begin
T := A;  A := B;  B := T;
End;

Type
TE = Record X : Integer; px, py : Byte; End;
Table = Array[0..512] of TE;
PTable = ^Table;

Var
Left, Right : Table;

Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);
//Procedure Texture4Poly(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim :
Byte);

Var
yMin, yMax, xStart, xEnd, yStart, yEnd, pxStart, pxEnd : Integer;
pyStart,pyEnd, pxVal, pxStep, pyVal, pyStep, Count : Integer;
XVal, XStep : Longint;
Side : PTable;

Procedure DoSide(X1,Y1,X2,Y2, PX1,PY1,PX2,PY2 : Integer);
var
Count : Integer;
Begin
If Y1 = Y2 then Exit;    // --> Nothing worth drawing.
If Y2 < Y1 then          // --> It is upside down.
Begin
SwapIntegers(Y1,Y2);
SwapIntegers(X1,X2);
SwapIntegers(PX1,PX2);
SwapIntegers(PY1,PY2);
Side := @Left
End else Side := @Right;

xStart := X1;  xEnd := X2;
yStart := Y1;  yEnd := Y2;

xStep  := (( X2- X1) shl 7) div (Y2-Y1);
pxStep := ((PX2-PX1) shl 7) div (Y2-Y1);

xVal   := X1 shl 7;      // all shl 7 is used to avoid using...
pxVal  := PX1;           // real number division for speed.

For Count := Y1 to Y2 do
Begin
Side^[Count].x  := xVal  shr 7;
Side^[Count].px := pxVal shr 7;
Side^[Count].py := pyVal shr 7;
pxVal := pxVal + pxStep;
End;
End; { DoSide }

Procedure HLine(X1,X2,PX1,PY1,PX2,PY2,Y : Integer);
var
Count : Word;
P     : PByteArray;
Begin
pxStep := ((px2-px1) Shl 8) Div (x2-x1+1);
// (px2-px1) is Source.bmWidth
pyStep := ((py2-py1) Shl 8) Div (x2-x1+1);
// (py2-py1) is Source.bmHeight
pxVal := px1 Shl 8;
pyVal := py1 Shl 8;
// reason for all shl 8 is for rounding purposes using hi()
P := Dest.Scanline[Y];
// scanline[] is quicker then pixels[]
for Count := X1 to X2 do
Begin
P[Count] := Source.Canvas.Pixels[hi(pxVal),hi(pyVal)];
// using hi() instead of round(real) for speed
pxVal := pxVal + pxStep;
pyVal := pyVal + pyStep;
End;
End; { HLine }

Begin

with Poly4 do yMin := GetMinInteger4(Y1,Y2,Y3,Y4);
with Poly4 do yMax := GetMaxInteger4(Y1,Y2,Y3,Y4);

If (yMin > Dest.Width) or (yMax < 0) then Exit;

With poly4 do DoSide(X1,Y1,X2,Y2, 0,0,Source.Width,0);
With poly4 do DoSide(X2,Y2,X3,Y3, Source.Width,0,
Source.Width,Source.Height);
With poly4 do DoSide(X3,Y3,X4,Y4,
Source.Width,Source.Height,0,Source.Height);
With poly4 do DoSide(X4,Y4,X1,Y1, 0,Source.Height,0,0);

For Count := yMin to yMax do If Left[Count].x < Right[Count].x Then
HLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
Right[Count].px, Right[Count].py, Count) Else
HLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
Left[Count].px, Left[Count].py, Count);

End;

end.

## Re:Delphi4: Textured Polygons for Delphi Source needs a fixing

##### Quote
>Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);

I kept getting errors about not being able to write to bitmaps that were not
initialized.  My short term goal is to have two images on the screen of any
size, then click on a button and have image2 being drawn into image1's box a
little crooked.  Image1 should conform to fit into the 4 points given by
Poly4 which doesn't have to be a rectangle.

## Re:Delphi4: Textured Polygons for Delphi Source needs a fixing

Hy Steven.

You have to add a 'var' to the procedure declaration
--> VAR dest:TBitmap!

patrick.

p.s.: if you can make it work properly, please send me a copy.

Steven J. Morales schrieb:

##### Quote

> >Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);

> I kept getting errors about not being able to write to bitmaps that were not
> initialized.  My short term goal is to have two images on the screen of any
> size, then click on a button and have image2 being drawn into image1's box a
> little crooked.  Image1 should conform to fit into the 4 points given by
> Poly4 which doesn't have to be a rectangle.

## Re:Delphi4: Textured Polygons for Delphi Source needs a fixing

Hy Steven.

You have to add a 'var' to the procedure declaration
--> VAR dest:TBitmap!

patrick.

p.s.: if you can make it work properly, please send me a copy.

Steven J. Morales schrieb:

##### Quote

> >Procedure TexturePoly4(Poly4 : TPoly4; Source, Dest : TBitmap);

> I kept getting errors about not being able to write to bitmaps that were not
> initialized.  My short term goal is to have two images on the screen of any
> size, then click on a button and have image2 being drawn into image1's box a
> little crooked.  Image1 should conform to fit into the 4 points given by
> Poly4 which doesn't have to be a rectangle.