?
Solved

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

Posted on 2010-04-03
30
Medium Priority
?
1,078 Views
Last Modified: 2013-11-23
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
0
Comment
Question by:bloodbird
  • 16
  • 13
29 Comments
 
LVL 21

Expert Comment

by:developmentguru
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

by:bloodbird
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.
   
  please tell me if you need more info

   thank you again
stretch-question.jpg
0
 

Author Comment

by:bloodbird
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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 21

Expert Comment

by:developmentguru
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

by:bloodbird
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

by:developmentguru
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

by:bloodbird
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

by:developmentguru
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

by:bloodbird
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

by:bloodbird
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

by:developmentguru
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

by:bloodbird
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

by:developmentguru
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

by:bloodbird
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

by:bloodbird
ID: 30289469
my email address is escaper@gmail.com
0
 
LVL 21

Expert Comment

by:developmentguru
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

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

Expert Comment

by:developmentguru
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 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
 
LVL 21

Expert Comment

by:developmentguru
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

by:bloodbird
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

by:developmentguru
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

by:bloodbird
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

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

Accepted Solution

by:
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 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
 

Author Comment

by:bloodbird
ID: 32628509
i am studying your code
0
 
LVL 21

Expert Comment

by:developmentguru
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

by:bloodbird
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.

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

thank you again.

0
 
LVL 21

Expert Comment

by:developmentguru
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

by:developmentguru
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

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

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

601 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question