Solved

# new Stretch Method,  Stretch a Trapezoid  but not a Retangle.

Posted on 2010-04-03
Medium Priority
1,078 Views
i have been looking codes to Stretch a Trapezoid for a long time. Is there anyone can help me ?

i have a bitmap(ABmp), i draw a Trapezoid(Trapezoid_A) on it, the two bottom of the Trapezoid is always parallel Y_axis,

then i move the upside bottom to any position(the length of the upside bottom keeps,and it always parallel Y_axis ).

now there is a a new Trapezoid(Trapezoid_B) by old downside bottom and the new upside bottom(the area of Trapezoid_B may less /more than the area of Trapezoid_A ).

what i need is Stretch Trapezoid_A into Trapezoid_B.

the function may like this

NewStretch(ABmp:TBmp;                    //the source bitmap
ATrapezoid:Array of TPoint;     //Old Trapezoid
BTrapezoid:Array of TPoint;     //New Trapezoid
BBmp:TBmp                              //the Dest bitmap
)

by the way, the speed of the function is important, i have wrote one ,but it's too slow to use.
and you can use any component.

could you give me the code?

any comments would be much appricated

0
Question by:bloodbird
• 16
• 13

LVL 21

Expert Comment

ID: 29822143
Wow... OK, more information is required.  When you originally draw your trapezoid are you drawing on a blank canvas?  If you are not drawing on a blank canvas then are you trying to draw over an existing image?  The language you use is also a bit confusing.
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.
0

Author Comment

ID: 29906608
hi ,developmentguru:

thank you.  i uploaded the image to show how it works.

1: the trapezoid is just a selection area. that is to say i am not to drawing on a blank
canvas,but an existing image.
2: what i meant "upside bottom" is top bottom, and :downside bottom" is bottom of a trapezoid.
3: about parallel to the Y axis, that is my mistakes. infact, the top bottom and the bottom do not to be parrallel to Y axis.

thank you again
stretch-question.jpg
0

Author Comment

ID: 29908299
the code may like this ( this code is very slow)

tpye
TLine = record
x1,y1:integer; //  point1 of the line
x2,y2:integer; //  point2 of the line
end;

TTrapezoid = record
bottom:TLine;  //bottom of the Trapezoid
top:TLine;     //top bottom of the Trapezoid
end;

NewStretch(ABmp:TBitmap;                      //the source bitmap
ATrapezoid:TTrapezoid ;     //Old Trapezoid
BTrapezoid:TTrapezoid ;     //New Trapezoid
BBmp:TBitmap                       //the Dest bitmap
)
var
BTrapezoid_Handle:Hrgn;         //handle of BTrapezoid
TopLeft:Tpoint;                 //topLeft of the BTrapezoid
bottomRight:TPoint;             //bottomRight of BTrapezoid
AColor:TRGB;
i,j:integer;

begin
if IS_Parallel(ATrapezoid.bottom,ATrapezoid.top) then Exit;
if IS_Parallel(BTrapezoid.bottom,BTrapezoid.top) then Exit;

BTrapezoid_Handle:=CreatePolygonRgn([(BTrapezoid.bottom.x1,BTrapezoid.bottom.y1),
(BTrapezoid.bottom.x2,BTrapezoid.bottom.y2),
(BTrapezoid.top.x2,BTrapezoid.top.y2),
(BTrapezoid.top.x1,BTrapezoid.top.y1)],4,2) ;

bottomRight:=GetBottomRight(BTrapezoid);
topLeft:=GetTopLeft(BTrapezoid);

for j:=TopLeft.y to BottomRight.y do
for i:=TopLeft.x to BottomRight.x do
begin
if PtInRegion(BTrapezoid) then
begin
BBmp.Picture.Canvas.pixel(i,j):=GetColorFromBmp(ABmp)
end;
end;

end;
0

LVL 21

Expert Comment

ID: 29937960
It may be later this week before I have time to try to create an example.  I can say that this type of manipulation does require a good deal of work no matter how it is accomplished.  One way to help reduce the impact of this type of processor intensive manipulation is to make sure the drag operation you do to accomplish the stretch will only try the stretch after the line is placed.  This will keep it from trying to stretch it multiple times while the user drags.

An advanced way to handle it would be to offload the processing to the video card but this is quite a chore in itself.  As an example:  Does the user have a video card capable of being used for this?  If not, do you want to write your own version?  If they do have a video card, what are it's capabilities?  Who is the manufacturer?  How much resources does the card have?

I will let you know as I make progress.
0

Author Comment

ID: 29949194
hi,developmentguru:
becasue this program is designed for a specail user, so i think i can buy one vedio card .
the most important is the speed , if a vedio card can make it fast,i'll go to market to buy it.
i just don't know which kind of vedio card could be useful. and i haven't ever written a vedio_supported program.

i heard about a third_party component----fastlib,and i tried to use it,but as my capability, i don't understand how to use it.

thank you again , developmentguru
0

LVL 21

Expert Comment

ID: 30074768
Your example shows the right side line moving.  Do you plan to have the user drag one line at a time to do the change?  Normally these changes are done by dragging points, but I could see where dragging the line would alleviate some issue and possibly make it easier to use.  Let me know how you want to handle the manipulation of the trapezoid so I can make my example to match.
0

Author Comment

ID: 30094482
the cordinate of the vertices of the Trapezoid is given by other fucntions, that's to say ,it can not do the change while dragging.  the scetch funtion will be called in a lots of  loops,and the image would be very large, because of that , i want it be fast.
0

LVL 21

Expert Comment

ID: 30113248
How many loops are we talking about?  Please understand that the more I know about what you are trying to do, the better I can approximate it and provide you what you are looking for.
0

Author Comment

ID: 30162931
two loops now
they look like this
for i:=0 to 20 do
begin
for j:=0 to 15 do
Trapeaoid_A:=...   //get the vertices of source trapezoid
Trapezoid_B:=...   //get the vertices of dest  trapezoid
StretchTrapezoid(Srcbmp,Destbmp,Trapezoid_A,Trapezoid_B);
end;

but  , i am trying to figure out a way to use only one loop, eh,i believe i could figure it out
0

Author Comment

ID: 30163226
i gave you a wrong code ,i forgot to add a "begin,,,end"
it should be this

for i:=0 to 20 do
begin
for j:=0 to 15 do
begin
Trapeaoid_A:=...   //get the vertices of source trapezoid
Trapezoid_B:=...   //get the vertices of dest  trapezoid
StretchTrapezoid(Srcbmp,Destbmp,Trapezoid_A,Trapezoid_B);
end
end;
0

LVL 21

Expert Comment

ID: 30238534
I assume I and J are to be used in the call to Stretch Trapezoid?  What are the loops doing for you?
0

Author Comment

ID: 30264354

the i and j , are used to get  the vertices of trapezoid

they looks like this
for i:=0 to 20 do
begin
for j:=0 to 15 do
begin
DestBmp:=TBitmap.create;
Trapeaoid_A:=GetTrapezoidA(i,j)  //get the vertices of source trapezoid
Trapezoid_B:=GetTrapezoidB(i,j)   //get the vertices of dest  trapezoid
StretchTrapezoid(Srcbmp,Destbmp,Trapezoid_A,Trapezoid_B);
Destbmp.savetofile(i _ j .bmp);
DestBmp.free;
end
end;
the loops make  a selection area(it's a polygon)  of  the SrcBmp   become into some

trapezoid(src trapezoid), each trapzoid(src trapezoid )  change the position of its top

bottom ,and then call the stretch function to get a new bitmap,  the new bitmap  is all

transparent  except the pixels in the area of  dest trapezoid, then i could use these bitmap
to form a new picture;
0

LVL 21

Expert Comment

ID: 30268049
If you would like me to be able to produce something that is ready for you to use I could use the contents of the GetTrapezoidA and GetTrapezoidB functions too.  That way I will have tested exactly what you are testing.  If not I will just see what I can come up with on my own.  I will wait to see if you will post the functions though.
0

Author Comment

ID: 30289226
could you give me your email ? so i can mail you that code. for some reason,i cant post the code here
0

Author Comment

ID: 30289469
0

LVL 21

Expert Comment

ID: 31298348
Since we are not supposed to contact outside of EE, I will attempt to help you here.  Besides that, others may find the information useful.

I will give you a written breakdown of how I intend to approach this.  I will use your coordinate examples to try to give you an idea.

I will call the A -> C line TopH and the B -> D line BottomH (horizontal) lines respectively.  I want to figure a minimum step for X and a minimum step for Y.  This will establish the fastest (and least accurate) of the methods of traversing and translating coordinates.  Once I have these minimums I will take a sample at each point along a line from 0 Y relative along the TopH line.  Each coordinate will be translated to the respective coordinate on the original trapezoid and a color sample read, which will be either plotted or listed (I will get back to this later).  Continuing the process for each Y until we have finished scanning the BottomH line.  Let me know if you have questions on the process.

Once again, I will be doing this in a non-optimized fashion so you understand the process.
0

LVL 21

Expert Comment

ID: 31305703
I got the selection routine down and will do more tomorrow.
0

LVL 21

Expert Comment

ID: 31373685
I have defined two buttons TrapA and TrapB.  The selection routine is working for both.  The A Trapezoid is shown in Red and the B Trapezoid is shown in Blue.  I am going to post the source so far so you can play with it.  Once the two are defined I will be able to do the core routine to translate between the two.  I cleared the picture so I would not have 74,000 lines in the DFM.  When you have recreated the project, just set the picture before you start or it will not look like much.  Let me know if you have questions to this point.
``````---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 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;

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 }

begin
Assert(fPointsDefined < 4, 'Attempting to add more than 4 points to ' +
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.
``````
0

LVL 21

Expert Comment

ID: 31374354
I forgot to mention... the trapezoid selection lets you draw 4 points with connecting lines and you can cancel by hitting the [Esc] key.
0

Author Comment

ID: 31745186
hi, developmentguru:
thank you, it's a nice test framework, much better than mine.  now,   it gave me more confidence that i would get a rapidly TTrapezoid.Draw function. thank you again.
0

LVL 21

Expert Comment

ID: 32303981
I am almost ready to post the initial code.  The code is commented well and details other possible approaches.  This code is fast, but fast is a relative term.  If it is not fast enough for you I am sure you can optimize it fairly easily.  If not, you could always try some of the other approaches I mention in the comments.  I should be ready to post it in a few more days.

I should also mention... it is fun to play with :-)
0

Author Comment

ID: 32332542
thank you developmentguru:
i am thinking about  Stretching a Trapezoid is actrually Stretching two Triangles. Supposed
we have a trapezoid ABCD  which top bottom is AB and bottom is CD.  To Stretch Trapezoid
ABCD is equal to  Stretch triangle ACD and Triangle ABD.  if we make a sub function as
StretchTriangle(); it will be more flexible, and we even can stretch any quadrangle by that function.
this is more useful for some this kinds of manipulation. eh.. i guess you had ideas of that...
0

LVL 21

Expert Comment

ID: 32336682
I think you will see that the method I am using could be applied :-)
0

LVL 21

Accepted Solution

developmentguru earned 2000 total points
ID: 32598359
Time for the first set of code :-)

Let me know what you think.
``````---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 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;

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 }

begin
Assert(fPointsDefined < 4, 'Attempting to add more than 4 points to ' +
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.
``````
0

Author Comment

ID: 32628509
0

LVL 21

Expert Comment

ID: 32628551
The conversion to using triangles would need to be done from the first point doing lines to each point of a line between points 2 and 3.  To do this well you would need to implement the pixel color averaging I mention in the comments.  You can use this "as is" or modify it to better suit your needs.  When I tried it out the algorithm finished almost immediately.  Let me know what you think (comment on the solution).
0

Author Comment

ID: 32629829
hi,

I have read your code. This method is very good. It can not only stretch a trapezoid but also a arbitrary quadrangle. The sample code is simple and well commented making me get your stretching way clearly. I think i am facing two problems with this code.

1: Because of the "Round" things, there must be some pixels lost. we have to paint it to dest trapezoid.

2: I think access the pixels by the function" canvase.pixel[x,y]" would be slower than by function "scanline".I am expecting your way to speed it.

thank you again.

0

LVL 21

Expert Comment

ID: 32634643
If you run into any loss of pixels it just means that the default number of samples I selected is not high enough.  You can always multiply the defaults by... 1.2 or 1.5 to avoid dropping pixels.  Just keep in mind that doing that multiplier will proportionally slow it down.  As I mention in the code you would want a higher number of samples combined with a list containing colors per location so you can accurately average the results and avoid as much color information loss as possible.

As a side note: If you wanted to convert from a circle to another geometric shape you could still use the same method (without loosing pixels that fall outside the shape but are part of the circle).  Doing this would skew the information to basically stretch the circle towards the new shape.  This would result in no skew towards the points of the new shape and maximum skew directly between any two points.  I am not sure this would be ideal, but then it is up to you to decide that.
0

LVL 21

Expert Comment

ID: 32634694
---I am expecting your way to speed it.

I am not sure I understand... you want me to optimize it now?  In order to try to convert this to doing the scan lines I would need to change the algorithm so it processes by scan lines.  The processing itself would be faster in one way and slower in another.  The only speed increase there would be through the use of the lower level graphics.  It would likely be far more productive to look at doing something like this using a 3D api (which then automatically uses the 3D hardware) than to try to handle the lower level manipulations yourself (and making up for a wide array of graphics hardware in your own code).

Is the code not fast enough as it is?  I thought it was plenty fast.  If it is already fast enough you would be better off spending your time working on more functionality.  After all, if it's not broke don't fix it.

Let me know.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Kernel Data Recovery is a renowned Data Recovery solution provider which offers wide range of softwares for both enterprise and home users with its cost-effective solutions. Let's have a quick overview of the journey and data recovery tools range he…
Stellar Phoenix SQL Database Repair software easily fixes the suspect mode issue of SQL Server database. It is a simple process to bring the database from suspect mode to normal mode. Check out the video and fix the SQL database suspect mode problem.
###### Suggested Courses
Course of the Month3 days, 10 hours left to enroll