Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.
Experts Exchange Solution brought to you by
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats  Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." Todd S.
DFM
object Form1: TForm1
Left = 138
Top = 110
Caption = 'Form1'
ClientHeight = 873
ClientWidth = 744
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = 14
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 14
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 744
Height = 23
ButtonWidth = 49
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 0
object btnTrapA: TToolButton
Left = 0
Top = 0
Action = defTrapA
end
object btnTrapB: TToolButton
Left = 49
Top = 0
Action = defTrapB
end
end
object Panel1: TPanel
Left = 0
Top = 23
Width = 744
Height = 850
Align = alClient
TabOrder = 1
object PaintBox1: TPaintBox
Left = 1
Top = 1
Width = 742
Height = 848
Align = alClient
OnMouseDown = PaintBox1MouseDown
OnMouseMove = PaintBox1MouseMove
OnPaint = PaintBox1Paint
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 105
ExplicitHeight = 105
end
object Image: TImage
Left = 0
Top = 0
Width = 635
Height = 800
AutoSize = True
Stretch = True
Visible = False
end
end
object ActionList1: TActionList
OnUpdate = ActionList1Update
Left = 664
Top = 24
object defTrapA: TAction
Caption = 'Trap A'
OnExecute = defTrapAExecute
end
object defTrapB: TAction
Caption = 'Trap B'
OnExecute = defTrapBExecute
end
end
end
PAS
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls,math, shellapi,ToolWin, StdCtrls,Shrink,
FastRender, ActnList;
type
TTrapezoid = class
private
fPoints : array [0..3] of TPoint;
fPointsDefined : integer;
function GetPoint(Index: integer): TPoint;
protected
public
procedure AddPoint(Point : TPoint);
procedure Draw(Canvas : TCanvas);
procedure Clear;
property PointsDefined : integer read fPointsDefined;
property Points[Index : integer] : TPoint read GetPoint;
end;
TForm1 = class(TForm)
ToolBar1: TToolBar;
Panel1: TPanel;
Image: TImage;
btnTrapA: TToolButton;
btnTrapB: TToolButton;
ActionList1: TActionList;
defTrapA: TAction;
defTrapB: TAction;
PaintBox1: TPaintBox;
procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure defTrapAExecute(Sender: TObject);
procedure defTrapBExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
fDefiningTrapA, fDefiningTrapB : boolean;
fUpdateTrapButtons : boolean;
fBack : TBitmap;
R : TRect;
TrapA, TrapB : TTrapezoid;
LastMouseMove : TPoint;
NeedToErase : boolean;
function GetDefiningTrap: boolean;
procedure SetDefiningTrapA(const Value: boolean);
procedure SetDefiningTrapB(const Value: boolean);
function GetCurrentTrap: TTrapezoid;
property DefiningTrap : boolean read GetDefiningTrap;
property DefiningTrapA : boolean read fDefiningTrapA write SetDefiningTrapA;
property DefiningTrapB : boolean read fDefiningTrapB write SetDefiningTrapB;
property CurrentTrap : TTrapezoid read GetCurrentTrap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
fUpdateTrapButtons := true;
TrapA := TTrapezoid.Create;
TrapB := TTrapezoid.Create;
R := Rect(0, 0, Image.Width, Image.Height);
fBack := TBitmap.Create;
fBack.Width := Image.Width;
fBack.Height := Image.Height;
fBack.Canvas.CopyRect(R, Image.Canvas, R);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
fBack.Free;
FreeAndNil(TrapB);
FreeAndNil(TrapA);
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = char(VK_ESCAPE) then
begin
if DefiningTrap then
begin
CurrentTrap.Clear;
if DefiningTrapA then
fDefiningTrapA := false
else
fDefiningTrapB := false;
PaintBox1.Invalidate;
Key := #0;
fUpdateTrapButtons := true;
end;
end;
end;
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
if fUpdateTrapButtons then
if DefiningTrap then
begin
defTrapA.Enabled := false;
defTrapB.Enabled := false;
end
else
begin
defTrapA.Enabled := true;
defTrapB.Enabled := true;
end;
fUpdateTrapButtons := false;
end;
procedure TForm1.defTrapAExecute(Sender: TObject);
begin
fDefiningTrapA := true;
fUpdateTrapButtons := true;
TrapA.Clear;
PaintBox1.Invalidate;
NeedToErase := false;
end;
procedure TForm1.defTrapBExecute(Sender: TObject);
begin
fDefiningTrapB := true;
fUpdateTrapButtons := true;
TrapB.Clear;
PaintBox1.Invalidate;
NeedToErase := false;
end;
function TForm1.GetCurrentTrap: TTrapezoid;
begin
Result := nil;
if not DefiningTrap then
exit;
if DefiningTrapA then
Result := TrapA
else
Result := TrapB;
end;
function TForm1.GetDefiningTrap: boolean;
begin
Result := fDefiningTrapA or fDefiningTrapB;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Trap : TTrapezoid;
begin
if DefiningTrap then
begin
Trap := CurrentTrap;
Trap.AddPoint(Point(X, Y));
if Trap.PointsDefined = 4 then
begin
if DefiningTrapA then
fDefiningTrapA := false
else
fDefiningTrapB := false;
fUpdateTrapButtons := true;
end;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Trap : TTrapezoid;
LastPoint : TPoint;
begin
if DefiningTrap then
begin
Trap := CurrentTrap;
if Trap.PointsDefined > 0 then
begin
LastPoint := Trap.Points[Trap.PointsDefined  1];
with PaintBox1, Canvas do
begin
Pen.Mode := pmXor;
//erase last line
if NeedToErase then
begin
MoveTo(LastPoint.X, LastPoint.Y);
LineTo(LastMouseMove.X, LastMouseMove.Y);
end;
//draw new line
MoveTo(LastPoint.X, LastPoint.Y);
LineTo(X, Y);
LastMouseMove.X := X;
LastMouseMove.Y := Y;
NeedToErase := true;
end;
end;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
I : integer;
P : TPoint;
begin
with PaintBox1, Canvas do
begin
//set the base image
CopyRect(R, fBack.Canvas, R);
if TrapA.PointsDefined <> 0 then
begin
for I := 0 to TrapA.PointsDefined  1 do
begin
P := TrapA.Points[I];
Pen.Color := clRed;
Pen.Mode := pmCopy;
Rectangle(P.X  2, P.Y  2, P.X + 2, P.Y + 2);
if I = 0 then
MoveTo(P.X, P.Y)
else
LineTo(P.X, P.Y);
end;
if TrapA.PointsDefined = 4 then
LineTo(TrapA.Points[0].X, TrapA.Points[0].Y);
end;
if TrapB.PointsDefined <> 0 then
begin
for I := 0 to TrapB.PointsDefined  1 do
begin
P := TrapB.Points[I];
Pen.Color := clBlue;
Pen.Mode := pmCopy;
Rectangle(P.X  2, P.Y  2, P.X + 2, P.Y + 2);
if I = 0 then
MoveTo(P.X, P.Y)
else
LineTo(P.X, P.Y);
end;
if TrapB.PointsDefined = 4 then
LineTo(TrapB.Points[0].X, TrapB.Points[0].Y);
end;
end;
end;
procedure TForm1.SetDefiningTrapA(const Value: boolean);
begin
fDefiningTrapA := Value;
end;
procedure TForm1.SetDefiningTrapB(const Value: boolean);
begin
fDefiningTrapB := Value;
end;
{ TTrapezoid }
procedure TTrapezoid.AddPoint(Point: TPoint);
begin
Assert(fPointsDefined < 4, 'Attempting to add more than 4 points to ' +
'TTrapezoid.AddPoint');
fPoints[fPointsDefined] := Point;
inc(fPointsDefined);
end;
procedure TTrapezoid.Clear;
begin
fPointsDefined := 0;
end;
procedure TTrapezoid.Draw(Canvas: TCanvas);
begin
end;
function TTrapezoid.GetPoint(Index: integer): TPoint;
begin
Assert(Index < PointsDefined, 'Invalid index for TTrapezoid.GetPoint');
Result := fPoints[Index];
end;
end.
DFM
object Form1: TForm1
Left = 138
Top = 110
Caption = 'Form1'
ClientHeight = 873
ClientWidth = 744
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = 14
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 14
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 744
Height = 23
ButtonWidth = 49
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 0
object btnTrapA: TToolButton
Left = 0
Top = 0
Action = defTrapA
end
object btnTrapB: TToolButton
Left = 49
Top = 0
Action = defTrapB
end
object btnAToB: TToolButton
Left = 98
Top = 0
Action = AToB
end
end
object Panel1: TPanel
Left = 0
Top = 23
Width = 744
Height = 850
Align = alClient
TabOrder = 1
object PaintBox1: TPaintBox
Left = 1
Top = 1
Width = 742
Height = 848
Align = alClient
OnMouseDown = PaintBox1MouseDown
OnMouseMove = PaintBox1MouseMove
OnPaint = PaintBox1Paint
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 105
ExplicitHeight = 105
end
object Image: TImage
Left = 0
Top = 0
Width = 635
Height = 800
AutoSize = True
Stretch = True
Visible = False
end
end
object ActionList1: TActionList
OnUpdate = ActionList1Update
Left = 664
Top = 24
object defTrapA: TAction
Caption = 'Trap A'
OnExecute = defTrapAExecute
end
object defTrapB: TAction
Caption = 'Trap B'
OnExecute = defTrapBExecute
end
object AToB: TAction
Caption = 'A > B'
OnExecute = AToBExecute
end
end
end
PAS
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls,math, shellapi,ToolWin, StdCtrls,Shrink,
FastRender, ActnList;
type
TTrapezoid = class
private
fPoints : array [0..3] of TPoint;
fPointsDefined : integer;
fLengthX, fLengthY : single;
fLineP1, fLineP2 : TPoint; //setup by CalcLine, used while parsing image
frDistanceX, frDistanceY : single;
function GetPoints(Index: integer): TPoint;
function GetPoint(Index: char): TPoint;
function GetLengthX: single;
function GetLengthY: single;
protected
public
procedure AddPoint(Point : TPoint);
procedure Draw(Canvas : TCanvas);
procedure Clear;
procedure CalcLine(Y, MaxY : single);
function PointOnCurrentLine(Percent : single) : TPoint;
property PointsDefined : integer read fPointsDefined;
property Points[Index : integer] : TPoint read GetPoints;
property Point[Index : char] : TPoint read GetPoint;
property LengthX : single read GetLengthX;
property LengthY : single read GetLengthY;
end;
TForm1 = class(TForm)
ToolBar1: TToolBar;
Panel1: TPanel;
Image: TImage;
btnTrapA: TToolButton;
btnTrapB: TToolButton;
ActionList1: TActionList;
defTrapA: TAction;
defTrapB: TAction;
PaintBox1: TPaintBox;
btnAToB: TToolButton;
AToB: TAction;
procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure defTrapAExecute(Sender: TObject);
procedure defTrapBExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure AToBExecute(Sender: TObject);
private
{ Private declarations }
fDefiningTrapA, fDefiningTrapB : boolean;
fUpdateTrapButtons : boolean;
fBack : TBitmap;
R : TRect;
TrapA, TrapB : TTrapezoid;
LastMouseMove : TPoint;
NeedToErase : boolean;
function GetDefiningTrap: boolean;
procedure SetDefiningTrapA(const Value: boolean);
procedure SetDefiningTrapB(const Value: boolean);
function GetCurrentTrap: TTrapezoid;
property DefiningTrap : boolean read GetDefiningTrap;
property DefiningTrapA : boolean read fDefiningTrapA write SetDefiningTrapA;
property DefiningTrapB : boolean read fDefiningTrapB write SetDefiningTrapB;
property CurrentTrap : TTrapezoid read GetCurrentTrap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
fUpdateTrapButtons := true;
TrapA := TTrapezoid.Create;
TrapB := TTrapezoid.Create;
R := Rect(0, 0, Image.Width, Image.Height);
fBack := TBitmap.Create;
fBack.Width := Image.Width;
fBack.Height := Image.Height;
fBack.Canvas.CopyRect(R, Image.Canvas, R);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
fBack.Free;
FreeAndNil(TrapB);
FreeAndNil(TrapA);
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = char(VK_ESCAPE) then
begin
if DefiningTrap then
begin
CurrentTrap.Clear;
if DefiningTrapA then
fDefiningTrapA := false
else
fDefiningTrapB := false;
PaintBox1.Invalidate;
Key := #0;
fUpdateTrapButtons := true;
end;
end;
end;
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
begin
if fUpdateTrapButtons then
if DefiningTrap then
begin
defTrapA.Enabled := false;
defTrapB.Enabled := false;
end
else
begin
defTrapA.Enabled := true;
defTrapB.Enabled := true;
end;
fUpdateTrapButtons := false;
end;
procedure TForm1.AToBExecute(Sender: TObject);
var
LengthX, LengthY : single;
X, Y : integer;
Percent : single;
Color : TColor;
DestPoint, SourcePoint : TPoint;
PaintBMP : TBitmap;
begin
//setup a painting area for the results so overlap will not cause an issue.
//this could be used for a one level undo as well.
PaintBMP := TBitmap.Create;
try
PaintBMP.Width := fBack.Width;
PaintBMP.Height := fBack.Height;
PaintBMP.Canvas.CopyRect(R, fBack.Canvas, R);
LengthX := TrapB.LengthX;
LengthY := TrapB.LengthY;
{I am assuming that the coordinates will be entered from top left in a
clockwise manner, this should be reinforced by sorting them before they get
to this point. The sorting would also take care of the possibility of the
lines crossing.
B
A
C
D
}
{At this point we have the minimum resolution for loops in the X and Y
directions. I will be following each line on the Y scale through all of
the X values. With each resulting coordinate I will translate the
coordinate into the coordinate on the A trapezoid, get the color, and place
the color in the B trapezoid.}
{To increase the color accuracy you would use a multiple of the X and Y
minimum values and take extra samples. The samples would need to be
recorded in such a way that each coordinate could have multiple colors. To
end up at the final color you would average the samples. This would be
multiples slower, so I only mention it here in case you want to try it
later.}
{This is one of may approaches you could take to this problem. Another I
considered would be to create a black and white bitmap of the same
dimensions as the original image and clear it to white. drawing the 4
lines black and filling the bounded area with black would give you a simple
test you could use to see if any pixel in the image was inside the
trapezoid. Using this you could go through all of the X, Y values of a box
that would encompass the trapezoid, test to see if the point is inside the
trapezoid, and do the same coordinate translation, color fetch, and color
set as I will be doing in this approach. The bitmap is one way to make an
easy fast test for inclusion. Another approach would be to do the math for
each side and find out which lines cross the X axis at which points and
make those the low and high point of the X loop for each line.}
for Y := 0 to Trunc(LengthY)  1 do
begin
{Setup the initial calculations for this row in each trapezoid}
TrapA.CalcLine(Y, LengthY);
TrapB.CalcLine(Y, LengthY);
for X := 0 to Trunc(LengthX)  1 do
begin
{this X and Y are in virtual coordinates that roughly follow the
line of the trapezoid, they will need to be converted to actual
coordinates. Doing it this way there is a common virtual
coordinate for each of the trapezoids and you convert from it to
get source and dest coordinates.}
Percent := X / LengthX;
DestPoint := TrapB.PointOnCurrentLine(Percent);
SourcePoint := TrapA.PointOnCurrentLine(Percent);
Color := fBack.Canvas.Pixels[SourcePoint.X, SourcePoint.Y];
PaintBMP.Canvas.Pixels[DestPoint.X, DestPoint.Y] := Color;
end;
end;
fBack.Canvas.CopyRect(R, PaintBMP.Canvas, R);
TrapA.Clear;
TrapB.Clear;
PaintBox1.Invalidate;
finally
PaintBMP.Free;
end;
end;
procedure TForm1.defTrapAExecute(Sender: TObject);
begin
fDefiningTrapA := true;
fUpdateTrapButtons := true;
TrapA.Clear;
PaintBox1.Invalidate;
NeedToErase := false;
end;
procedure TForm1.defTrapBExecute(Sender: TObject);
begin
fDefiningTrapB := true;
fUpdateTrapButtons := true;
TrapB.Clear;
PaintBox1.Invalidate;
NeedToErase := false;
end;
function TForm1.GetCurrentTrap: TTrapezoid;
begin
Result := nil;
if not DefiningTrap then
exit;
if DefiningTrapA then
Result := TrapA
else
Result := TrapB;
end;
function TForm1.GetDefiningTrap: boolean;
begin
Result := DefiningTrapA or DefiningTrapB;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Trap : TTrapezoid;
begin
if DefiningTrap then
begin
Trap := CurrentTrap;
Trap.AddPoint(Point(X, Y));
if Trap.PointsDefined = 4 then
begin
if DefiningTrapA then
fDefiningTrapA := false
else
fDefiningTrapB := false;
fUpdateTrapButtons := true;
end;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Trap : TTrapezoid;
LastPoint : TPoint;
begin
if DefiningTrap then
begin
Trap := CurrentTrap;
if Trap.PointsDefined > 0 then
begin
LastPoint := Trap.Points[Trap.PointsDefined  1];
with PaintBox1, Canvas do
begin
Pen.Mode := pmXor;
//erase last line
if NeedToErase then
begin
MoveTo(LastPoint.X, LastPoint.Y);
LineTo(LastMouseMove.X, LastMouseMove.Y);
end;
//draw new line
MoveTo(LastPoint.X, LastPoint.Y);
LineTo(X, Y);
LastMouseMove.X := X;
LastMouseMove.Y := Y;
NeedToErase := true;
end;
end;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
I : integer;
P : TPoint;
begin
with PaintBox1, Canvas do
begin
//set the base image
CopyRect(R, fBack.Canvas, R);
if TrapA.PointsDefined <> 0 then
begin
for I := 0 to TrapA.PointsDefined  1 do
begin
P := TrapA.Points[I];
Pen.Color := clRed;
Pen.Mode := pmCopy;
Rectangle(P.X  2, P.Y  2, P.X + 2, P.Y + 2);
if I = 0 then
MoveTo(P.X, P.Y)
else
LineTo(P.X, P.Y);
end;
if TrapA.PointsDefined = 4 then
LineTo(TrapA.Points[0].X, TrapA.Points[0].Y);
end;
if TrapB.PointsDefined <> 0 then
begin
for I := 0 to TrapB.PointsDefined  1 do
begin
P := TrapB.Points[I];
Pen.Color := clBlue;
Pen.Mode := pmCopy;
Rectangle(P.X  2, P.Y  2, P.X + 2, P.Y + 2);
if I = 0 then
MoveTo(P.X, P.Y)
else
LineTo(P.X, P.Y);
end;
if TrapB.PointsDefined = 4 then
LineTo(TrapB.Points[0].X, TrapB.Points[0].Y);
end;
end;
end;
procedure TForm1.SetDefiningTrapA(const Value: boolean);
begin
fDefiningTrapA := Value;
end;
procedure TForm1.SetDefiningTrapB(const Value: boolean);
begin
fDefiningTrapB := Value;
end;
{ TTrapezoid }
procedure TTrapezoid.AddPoint(Point: TPoint);
begin
Assert(fPointsDefined < 4, 'Attempting to add more than 4 points to ' +
'TTrapezoid.AddPoint');
fPoints[fPointsDefined] := Point;
inc(fPointsDefined);
end;
procedure TTrapezoid.CalcLine(Y, MaxY: single);
var
Percent, DistanceX, DistanceY : single;
begin
{This will do calculations that only need to be done once per row. The
calculations will determine the start and end points for a row. This is
assuming that the "rows" are virtual and are parallel to the A>B AND C>D
lines. This means that as each line is calculated the lines will skew.
Starting at the first row the line will be parallel to the A>B. As the
rows progress they will be less and less parallel to A>B and more and more
parallel to C>D. I will do this by finding the point that is a percentage
of the way from A>D (left side) and another point that is the same
percentage of the way from B>C (Right side).
}
Percent := Y / MaxY;
DistanceX := Point['D'].X  Point['A'].X;
DistanceY := Point['D'].Y  Point['A'].Y;
fLineP1.X := Point['A'].X + Round((Percent * DistanceX));
fLineP1.Y := Point['A'].Y + Round((Percent * DistanceY));
DistanceX := Point['C'].X  Point['B'].X;
DistanceY := Point['C'].Y  Point['B'].Y;
fLineP2.X := Point['B'].X + Round((Percent * DistanceX));
fLineP2.Y := Point['B'].Y + Round((Percent * DistanceY));
frDistanceX := fLineP2.X  fLineP1.X;
frDistanceY := fLineP2.Y  fLineP1.Y;
end;
procedure TTrapezoid.Clear;
begin
fPointsDefined := 0;
fLengthX := 0;
fLengthY := 0;
end;
procedure TTrapezoid.Draw(Canvas: TCanvas);
begin
end;
function TTrapezoid.GetLengthX: single;
var
LengthA, LengthB : single;
XSqr, YSqr : single;
begin
if fLengthX = 0 then
begin
{LengthX will be the greater of the lenghts from A > B and C > D and
will represent the minimum viable value for a loop covering X that will
produce an output pixel at each pixel in the trapezoid.}
XSqr := Point['A'].X  Point['B'].X;
XSqr := XSqr * XSqr;
YSqr := Point['A'].Y  Point['B'].Y;
YSqr := YSqr * YSqr;
LengthA := Sqrt(xSqr + ySqr);
XSqr := Point['C'].X  Point['D'].X;
XSqr := XSqr * XSqr;
YSqr := Point['C'].Y  Point['D'].Y;
YSqr := YSqr * YSqr;
LengthB := Sqrt(xSqr + ySqr);
if LengthA > LengthB then
fLengthX := LengthA
else
fLengthX := LengthB;
end;
Result := fLengthX;
end;
function TTrapezoid.GetLengthY: single;
var
LengthA, LengthB : single;
XSqr, YSqr : single;
begin
if fLengthY = 0 then
begin
{LengthY will be the greater of the lenghts from A > D and B > C and
will represent the minimum viable value for a loop covering Y that will
produce an output pixel at each pixel in the trapezoid.}
XSqr := Point['A'].X  Point['D'].X;
XSqr := XSqr * XSqr;
YSqr := Point['A'].Y  Point['D'].Y;
YSqr := YSqr * YSqr;
LengthA := Sqrt(xSqr + ySqr);
XSqr := Point['B'].X  Point['C'].X;
XSqr := XSqr * XSqr;
YSqr := Point['B'].Y  Point['C'].Y;
YSqr := YSqr * YSqr;
LengthB := Sqrt(xSqr + ySqr);
if LengthA > LengthB then
fLengthY := LengthA
else
fLengthY := LengthB;
end;
Result := fLengthY;
end;
function TTrapezoid.GetPoint(Index: char): TPoint;
begin
Assert(Index in ['A'..'D', 'a'..'d'], 'Invalid point argument to GetPoint');
Result := GetPoints(Ord(UpCase(Index))  Ord('A'));
end;
function TTrapezoid.GetPoints(Index: integer): TPoint;
begin
Assert(Index < PointsDefined, 'Invalid index for TTrapezoid.GetPoint');
Result := fPoints[Index];
end;
function TTrapezoid.PointOnCurrentLine(Percent: single): TPoint;
begin
Result.X := fLineP1.X + Round((frDistanceX * Percent));
Result.Y := fLineP1.Y + Round((frDistanceY * Percent));
end;
end.
Experts Exchange Solution brought to you by
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
Start your 7day free trialFrom novice to tech pro — start learning today.
Experts Exchange Solution brought to you by
Normally your axes run as shown:
X>


Y


\/
I figure that you meant that the two bottom points of the trapezoid are perpendicular to the Y axis (parallel to the X axis). If any two points were parallel to the Y axis then the line between them would be a vertical bar on the left or right side of your shape.
You then make the statement that you move the "upside bottom" to any position... I translate upside as top... the top bottom? If the two bottom points are always on the same Y coordinate then one is the left bottom point and one is the right bottom point. Again later in your dialog you refer to the "downside bottom" and I am equally unsure what that means.
Once you clarify your language and show some images (with text showing your point references in the images) then we can move on. One important thing to note. Any function capable of doing this manipulation will be lossy. If you stretch A into B, then use B to stretch to C, and continue using the output to create new output your image will loose clarity. This could happen easily if you just stretch the area repeatedly during a mouse drag, or the user does the operation repeatedly. Knowing this, the Trapezoid should have the ORIGINAL bitmap associated with it, and it (and the original dimensions of the trapezoid) should always be used to stretch it to the new dimensions.
I will await example images and further explanation.