unit KolPolyline;
//
// purpose: Polyline draw object
//  author: © 2004, Thaddy de Koning, parts © Dr Steve Evans
// Remarks: based on sample code written by Dr Steve Evans (steve@lociuk.com)
//          I have translated it to KOL and created the component.
// KOLPolyline is a unit designed to store, manipulate and draw polylines.
// The TPolyLineObject type provides a KOL component derived from Tlist that is
// a container within which TPolyline objects can be stored.
// The TPolyline type (derived from Tlist) contains a complete description
// of an individual polyline object and how to draw it.
//

(*
*************
Example code:
*************
program poly;  //save as 'poly.dpr' and compile/run
{$WARNINGS OFF}//shut up the compiler, it's KOL, not VCL code
uses
  windows, messages, kol,KolPolyLine;
type
  PForm1=^TForm1;
  TForm1=object(Tobj)
  Form:pControl;
  Btn1,btn2,btn3:Pcontrol;
  PolyStore:PPolyLineObject;
public
  procedure Btn1Click(sender:pobj);
  procedure Btn2Click(sender:pobj);
  procedure Btn3Click(sender:pobj);
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
  New(Result,Create);
  with Result^ do
  begin
    Applet :=NewApplet('poly');
    Form:= NewForm(Applet,Applet.Caption).SetSize(600,400).centeronparent;
    Form.Add2AutoFree(Result);
    btn1:=NewButton(form,'Draw new polyline').autosize(true).placeright;
    btn2:=NewButton(form,'Select a polyline').autosize(true).placeright;
    btn3:=NewButton(form,'Delete selected polyline').autosize(true).PlaceRight;
    btn1.OnClick:=btn1Click;
    btn2.OnClick:=Btn2Click;
    btn3.Onclick:=btn3Click;
    PolyStore:=NewPolyLineObject(Form);
  end;
end;

procedure TForm1.Btn1Click(sender: pobj);
begin
  PolyStore.DrawMode:=dmPolyline;
end;

procedure TForm1.Btn2Click(sender: pobj);
begin
  PolySTore.DrawMode:=dmSelect;
end;

procedure TForm1.Btn3Click(sender: pobj);
begin
  PolyStore.DeleteSelectedPolylines;
end;

var
  Form1:pForm1;

begin
  NewForm1( Form1, Applet);
  Run(Applet);
end.
*)
interface

uses
  Windows,messages,Kol;

type

PGeoPt = ^TGeoPt;
TGeoPt = object(TObj)
 public
 X,Y: Integer;
 Selected: Boolean;
end;

function NewGeoPt:PGeoPt;

type

 TDrawingMode = (dmNone, dmPolyline, dmSelect);

  PPolyLine = ^TPolyLine;
  TPolyline = object(Tlist)
  private
    { Private declarations }
    FColor:Tcolor;
    FSelected:Boolean;
    function getItems(index: integer): PGeopt;
    procedure SetItems(index: integer; const Value: PGeopt);
   public
    procedure SetSelected(Value: Boolean);
    function AddPointToPolyline(pDPoint: PGeoPt): Integer;
    procedure DeleteNode(ListIndex: Integer);
    procedure Draw(aCanvas:PCanvas);
    procedure MovePolyline(dx,dy: Integer);
    procedure MoveSelectedPolyPoint(dx,dy: Integer);
    function GetPointSelRect(Index: Integer): TRect;
    property Selected : Boolean read FSelected write SetSelected;
    property Color:Tcolor read Fcolor Write Fcolor;
    property Items[index:integer]:PGeopt read getItems write SetItems;
  end;

  function NewPolyLine:PPolyLine;

type
  PPolyLineObject = ^TPolyLineObject;
  TPolyLineObject = object(Tlist)
  private
    FOwner:PControl;
    FDrawMode: TDrawingMode;
    OX,OY: Integer;
    FDraggingPoint: Boolean;
    FPointCount: integer;
    TempPolyline:Array of TPoint;
    function GetItems(index: integer): PPolyLine;
    procedure setitems(index: integer; const Value: PPolyLine);
    procedure SetDraggingPoint(const Value: Boolean);
    procedure SetDrawMode(const Value: TDrawingMode);
    procedure SetPointCount(const Value: integer);
  protected
    procedure PolyPaint(sender:Pcontrol;DC:HDC);
    procedure Draw(aCanvas:Pcanvas);
  public
    function  CheckSelectPoly(x,y: Integer): Integer;
    function  IsPointOnLine(XA,YA,XB,YB,XC,YC, Tolerance: Double): Boolean;
    procedure MoveSelectedPolyline(dx,dy: Integer);
    procedure MoveSelectedPolyPoint(dx,dy: Integer);
    function  CursorOverPolyPoint(x,y: Integer): Boolean;
    procedure DeleteSelectedPolylines;
    function  AddPolyline(PolyPtList: array of TPoint):Integer; overload;
    procedure EndAPolyLine;
    procedure DeleteMember(ListIndex: Integer);
    property  Items[index:integer]:PPolyline read GetItems write setitems;
    property  DrawMode:TDrawingMode read FDrawMode write SetDrawMode;
  end;


 function NewPolyLineObject(aOwner:Pcontrol):PPolyLineObject;

implementation

function NewGeoPt:PGeoPt;
begin
  New(Result,Create);
end;

function NewPolyLine:PPolyLine;
begin
 New(Result,Create);
 Result.FColor:=clNone;
 Result.FSelected:=False;
end;

function WndProcPolyLines( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var
  dx,dy: Integer;
  Mouse:TPoint;
begin
  Mouse.X:=0;
  Mouse.Y:=0;
  Result:=False;
  with sender^, PPolyLineObject(sender.CustomObj)^  do
  begin
    case Msg.message of
    WM_MOUSEMOVE: if Msg.wParam AND MK_LBUTTON = MK_LBUTTON then
                  begin
                    Mouse.X:=LoWord(Msg.Lparam);
                    Mouse.Y:=HiWord(Msg.Lparam);
                    dx:=OX-Mouse.X;
                    dy:=OY-Mouse.Y;
                    if FDraggingPoint then MoveSelectedPolyPoint(dx,dy) else
                         MoveSelectedPolyline(dx,dy);
                    Invalidate;
                    OX:=Mouse.X;
                    OY:=Mouse.Y;
                  end;
    WM_LBUTTONDOWN,
    WM_RBUTTONDOWN:
                    begin
                    Mouse.X:=LoWord(Msg.Lparam);
                    Mouse.Y:=HiWord(Msg.Lparam);
                    if DrawMode=dmSelect then
                     begin
                       CheckSelectPoly(Mouse.X,Mouse.Y);
                       if CursorOverPolyPoint(Mouse.x,Mouse.y) then FDraggingPoint:=True;
                       Invalidate;
                     end;

                     if DrawMode=dmPolyline then
                     begin
                        if (msg.Wparam AND MK_LBUTTON = MK_LBUTTON) then
                        begin
                           FPointCount:=FPointCount+1;
                           SetLength(TempPolyline,FPointCount);
                           TempPolyline[FPointCount-1].X:=Mouse.X;
                           TempPolyline[FPointCount-1].Y:=Mouse.Y;
                           Invalidate;
                        end;
                        if (Msg.Wparam AND MK_RBUTTON = MK_RBUTTON) then EndAPolyline;
                     end;
                     OX:=Mouse.X;
                     OY:=Mouse.Y;
                    end;
    WM_LBUTTONUP,
    WM_RBUTTONUP:  FDraggingPoint:=False;
    end;
  end;
end;

function NewPolyLineObject(aOwner:PControl):PPolyLineObject;
begin
 New(Result,Create);
 with Result^ do
 begin
  Fowner:=aOwner;
  aOwner.CustomObj:=Result;
  aOwner.AttachProc(WndProcPolyLines);
  aOwner.OnPaint:=PolyPaint;
  DrawMode:=dmNone;
 end;
end;

function TPolyline.GetPointSelRect(Index: Integer): TRect;
begin
  Result.Left:=Items[Index].X-4;
  Result.Top:=Items[Index].Y-4;
  Result.Right:=Result.Left+8;
  Result.Bottom:=Result.Top+8;
end;


procedure TPolyline.MovePolyline(dx,dy: Integer);
var
i: Integer;
begin
  for i:=0 to Count-1 do
  begin
    Items[i].X:=Items[i].X-dx;
    Items[i].Y:=Items[i].Y-dy;
  end;
end;


procedure TPolyline.MoveSelectedPolyPoint(dx,dy: Integer);
var
i: Integer;
begin
  for i:=0 to Count-1 do
  begin
     if Items[i].Selected then
     begin
      Items[i].X:=Items[i].X-dx;
      Items[i].Y:=Items[i].Y-dy;
     end;
  end;
end;

procedure TPolyline.SetSelected(Value: Boolean);
var
i: Integer;
begin
  FSelected:=Value;
end;


function TPolyline.AddPointToPolyline(pDPoint: PGeoPt):Integer;
begin
  Add(pDPoint);
  Result:=Count-1;
end;

procedure TPolyline.DeleteNode(ListIndex: Integer);
begin
  Delete(ListIndex);
end;

procedure TPolyline.Draw(aCanvas:PCanvas);
var
i: Integer;
begin
  if (Selected) then aCanvas.Pen.Color:= clRed else aCanvas.Pen.Color:= clBlack;

  aCanvas.MoveTo(Items[0].X,Items[0].Y);
  for i:=1 to Count-1 do
     aCanvas.LineTo(Items[i].X,Items[i].Y);

  for i:=0 to Count-1 do
    if Selected then aCanvas.Rectangle(Items[i].X-4,Items[i].Y-4,
                                       Items[i].X+4,Items[i].Y+4);

  aCanvas.Pen.Color:= clBlack;
end;



function TPolyLineObject.AddPolyline(PolyPtList: array of TPoint):Integer;
var
i: Integer;
aNewPolyline: PPolyline;
aNewPoint: PGeoPt;
begin
  aNewPolyline:=NewPolyline;
  for i:=0 to High(PolyPtList) do
  begin
    aNewPoint:=NewGeoPt;
    aNewPoint.X:=PolyPtList[i].X;
    aNewPoint.Y:=PolyPtList[i].Y;
    aNewPolyline.AddPointToPolyline(aNewPoint);
  end;
  Add(aNewPolyline);
  Result:=Count-1;
end;



procedure TPolyLineObject.DeleteMember(ListIndex: Integer);
begin
  Delete(ListIndex);
end;

procedure TPolyLineObject.DeleteSelectedPolylines;
var
i: Integer;
begin
  for i := Count-1 downto 0 do
      if Items[i].Selected then Delete(i);
  FOwner.Invalidate;
end;

procedure TPolyLineObject.Draw(aCanvas: PCanvas);
var
i: Integer;
begin
  for i := 0 to Count-1 do Items[i].Draw(aCanvas);
end;

function abs(aValue:Double):double;
begin
  result:=aValue;
  if result < 0 then result:=result* -1;
end;

function TPolyLineObject.IsPointOnLine(XA,YA,XB,YB,XC,YC, Tolerance: Double): Boolean;
var

L,R,S: Double;

begin

  Result:=False;

  L:=SQRT(((XB-XA)*(XB-XA)+(YB-YA)*(YB-YA)));

  if l<>0 then
  begin
    R:= ((YA-YC)*(YA-YB)-(XA-XC)*(XB-XA))/(L*L);
    S:= ((YA-YC)*(XB-XA)-(XA-XC)*(YB-YA))/(L*L);
    if (r>0) and (r<1) then if Abs(S*L)<=Tolerance then Result:=True;
  end;
end;





function TPolyLineObject.CheckSelectPoly(x,y: Integer): Integer;
var
i,j: Integer;
aRect: TRect;
aPoint: TPoint;
PolyPointIndex: Integer;
begin

  Result:=-1;
  for i:=0 to Count-1 do Items[i].Selected:=False;
  for i:=0 to Count-1 do
  begin
    for j:=0 to PPolyline(Items[i]).Count-2 do
    begin
    if IsPointOnLine(Items[i].Items[j].X,
                     Items[i].Items[j].Y,
                     Items[i].Items[j+1].X,
                     Items[i].Items[j+1].Y,
                     X,Y, 4) then Result:=i;
    end;
  end;

  if (Result<>-1) then Items[Result].Selected:=True;
end;


function TPolyLineObject.CursorOverPolyPoint(x,y: Integer): Boolean;
var
i,j: Integer;
aRect: TRect;
aPoint: TPoint;
begin
 aPoint.X:=x;
 aPoint.Y:=y;
 Result:=False;

  for i:=0 to Count-1 do
    for j:=0 to Items[i].Count-1 do
      Items[i].Items[j].Selected:=False;

  for i:=0 to Count-1 do
  begin
    for j:=0 to Items[i].Count-1 do
    begin
    arect:=Items[i].GetPointSelRect(j);
      if PtInRect(arect,aPoint) then
      begin
      Items[i].Selected:=True;
      Items[i].Items[j].Selected:=True;
      Result:=True;
      end;
    end;
  end;
end;


procedure TPolyLineObject.MoveSelectedPolyline(dx,dy: Integer);
var
i: Integer;
begin
  for i := 0 to Count-1 do
    if Items[i].Selected then Items[i].MovePolyline(dx,dy);
end;

procedure TPolyLineObject.MoveSelectedPolyPoint(dx,dy: Integer);
var
i: Integer;
begin
  for i := 0 to Count-1 do
    Items[i].MoveSelectedPolyPoint(dx,dy);
end;



function TPolyLine.getItems(index: integer): PGeoPt;
begin
 result:=inherited items[index];
end;

procedure TPolyLine.SetItems(index: integer; const Value: PGeopt);
begin
 inherited items[index]:=value;
end;

function TPolyLineObject.GetItems(index: integer): PPolyline;
begin
  result:= inherited items[index];
end;

procedure TPolyLineObject.setitems(index: integer; const Value: PPolyLine);
begin
 inherited items[index]:=value;
end;

procedure TPolyLineObject.EndAPolyLine;
begin
  if FPointCount>1 then AddPolyline(TempPolyLine);
  FPointCount:=0;
  SetLength(TempPolyline,0);
  FOwner.Invalidate;
end;

procedure TPolyLineObject.PolyPaint(sender: Pcontrol; DC: HDC);
var
i: Integer;
begin
  Draw(sender.Canvas);
  if FPointCount>0 then
  begin
    sender.Canvas.MoveTo(TempPolyline[0].X,TempPolyline[0].Y);
    for i:=1 to High(TempPolyline) do
      sender.Canvas.LineTo(TempPolyline[i].X,TempPolyline[i].Y)
  end;
end;

procedure TPolyLineObject.SetDraggingPoint(const Value: Boolean);
begin
  FDraggingPoint := Value;
end;

procedure TPolyLineObject.SetDrawMode(const Value: TDrawingMode);
begin
  EndAPolyLine;
  FDrawMode := Value;
  if Fdrawmode = dmPolyLine then
    Fowner.Cursor:=LoadCursor(0,IDC_CROSS)
  else
   FOwner.Cursor:=LoadCursor(0, IDC_ARROW);
end;

procedure TPolyLineObject.SetPointCount(const Value: integer);
begin
  FPointCount := Value;
end;


end.