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

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

thank you in advance
bloodbirdAsked:
Who is Participating?
I wear a lot of hats...

"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.

developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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.
   
  please tell me if you need more info

   thank you again
stretch-question.jpg
0
bloodbirdAuthor Commented:
  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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

developmentguruPresidentCommented:
 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
bloodbirdAuthor Commented:
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
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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
bloodbirdAuthor Commented:
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
developmentguruPresidentCommented:
I assume I and J are to be used in the call to Stretch Trapezoid?  What are the loops doing for you?
0
bloodbirdAuthor Commented:

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
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
could you give me your email ? so i can mail you that code. for some reason,i cant post the code here
0
bloodbirdAuthor Commented:
my email address is escaper@gmail.com
0
developmentguruPresidentCommented:
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
developmentguruPresidentCommented:
I got the selection routine down and will do more tomorrow.
0
developmentguruPresidentCommented:
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 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.

Open in new window

0
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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
developmentguruPresidentCommented:
I think you will see that the method I am using could be applied :-)
0
developmentguruPresidentCommented:
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 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.

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

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 7-day free trial
bloodbirdAuthor Commented:
i am studying your code
0
developmentguruPresidentCommented:
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
bloodbirdAuthor Commented:
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.

By the way, I learn more from your code and still  learning it .

thank you again.

0
developmentguruPresidentCommented:
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
developmentguruPresidentCommented:
---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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.