anyline.pas

图论算法

unit anyline;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  Tlinepoint = record
    X,Y:SmallInt;
  end;

  Tanyline = class(TGraphicControl)
  private
        FlineWidth : integer;
        procedure Setlinewidth(value:integer);
  protected
	procedure Paint; override;
        //NCHitTest on used on Twincontrol
        //procedure NCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
        //        procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  public
        linepoints:array[1..8] of Tlinepoint;
        linepointnum :integer;
	constructor Create(AOwner: TComponent);override;
        procedure drawby(const thepointarray:array of Tpoint);
        function getmidpoint:Tpoint;
  published
        property Align;
        property color;
//	property DragCursor;
//	property DragMode;
//	property Enabled;
        property linewidth :integer read Flinewidth write Setlinewidth;
//	property ParentColor;
//	property ParentShowHint;
//	property ShowHint;
	property Visible;
//	property OnDragDrop;
//	property OnDragOver;
//	property OnEndDrag;
//	property OnMouseDown;
//	property OnMouseMove;
//	property OnMouseUp;
//	property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Graph', [Tanyline]);
end;

constructor Tanyline.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
  Width := 10;
  Height := 10;
  Flinewidth := 1;
  color := clBlack;
  enabled := False;
  //Sendtoback;
end;

{// NCHitTest on used on Twincontrol
procedure Tanyline.NCHitTest(var Msg: TWMNCHitTest);
begin
   inherited;
   Msg.Result := HTTRANSPARENT;
end;
}
procedure Tanyline.Paint;
var i,j:integer;
    linelength:integer; // approxiate line length , sqr((x1-x2)^2+(y1-y2)^2)+ sqr((x2-x3)^2+(y2-y3)^2)+...
    INVALUENUM :integer;
    XX,YY:integer;
    t,tt,ttt,f1,f2,f3,f4:real;
    function getlength(n:integer):real; //(n,n+1) point distance
      var XX,YY:integer;
          k:integer;
      begin
        XX := (linepoints[n].X - linepoints[n+1].X);
        XX := XX * XX;
        YY := (linepoints[n].Y - linepoints[n+1].Y);
        YY := YY * YY;
        result := sqrt(XX + YY);
      end;
begin
  with canvas do
    begin
      pen.color := color;
      pen.width := Flinewidth;
      pen.style := psSolid;
      if linepointnum = 2 then
         begin
           MoveTo(linepoints[1].X,linepoints[1].Y);
           LineTo(linepoints[2].X,linepoints[2].Y);
         end
      else if linepointnum = 3 then
         begin
           INVALUENUM := Round(getlength(1));
           MoveTo(linepoints[1].X,linepoints[1].Y);
           for i := 0 to INVALUENUM do
             begin
    	       t  := i*0.5/(INVALUENUM+1);
               tt := t*t ;
	       f1 := 2*tt - 3*t +1;
    	       f2 := 4*t - 4*tt;
	       f3 := 2*tt - t;
 	       xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
	       yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
	       lineto(xx,yy);
             end;

           INVALUENUM := Round(getlength(2));
           for i := 0 to INVALUENUM do
	     begin
	       t  := 0.5 + i*0.5/(INVALUENUM+1);
  	       tt := t*t ;
	       f1 := 2*tt - 3*t +1;
	       f2 := 4*t - 4*tt;
	       f3 := 2*tt - t;
	       xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
	       yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
	       lineto(xx,yy);
             end;
         end
      else  if linepointnum > 3 then
         begin
           INVALUENUM := Round(getlength(1));
           MoveTo(linepoints[1].X,linepoints[1].Y);
           for i := 0 to INVALUENUM do
             begin
    	       t  := i*0.5/(INVALUENUM+1);
               tt := t*t ;
	       f1 := 2*tt - 3*t +1;
    	       f2 := 4*t - 4*tt;
	       f3 := 2*tt - t;
 	       xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
	       yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
	       lineto(xx,yy);
             end;

           for j := 1 to linepointnum - 3 do
             begin
               INVALUENUM := Round(getlength(j+1));
               for i := 0 to INVALUENUM do
                 begin
	           t   := i*0.5/(INVALUENUM+1);
	           tt  := t*t;
	           ttt := t*t*t;
	           f1  := 4*tt - t - 4*ttt;
	           f2  := 1 - 10*tt + 12*ttt;
	           f3  := t + 8*tt - 12*ttt;
	           f4  := 4*ttt - 2*tt;
	           xx := round(f1* linepoints[j].X + f2* linepoints[j+1].X + f3* linepoints[j+2].X + f4* linepoints[j+3].X);
	           yy := round(f1* linepoints[j].Y + f2* linepoints[j+1].Y + f3* linepoints[j+2].Y + f4* linepoints[j+3].Y);
   	           lineto(xx,yy);
                 end;
             end;
           INVALUENUM := Round(getlength(linepointnum-1));
           for i := 0 to INVALUENUM do
	     begin
	       t  := 0.5 + i*0.5/(INVALUENUM+1);
  	       tt := t*t ;
	       f1 := 2*tt - 3*t +1;
	       f2 := 4*t - 4*tt;
	       f3 := 2*tt - t;
	       xx := round(f1* linepoints[linepointnum-2].X + f2* linepoints[linepointnum-1].X + f3* linepoints[linepointnum].X );
	       yy := round(f1* linepoints[linepointnum-2].Y + f2* linepoints[linepointnum-1].Y + f3* linepoints[linepointnum].Y );
	       lineto(xx,yy);
             end;
         end;
    end;
end;

procedure Tanyline.drawby(const thepointarray:array of Tpoint);
var i:integer;
begin
  linepointnum := High(thepointarray)+1;
  for i := 1 to linepointnum do
    begin
      linepoints[i].X := thepointarray[i-1].X;
      linepoints[i].Y := thepointarray[i-1].Y;
    end;
  Invalidate;
//  Update;
end;

function Tanyline.getmidpoint:Tpoint;
var
    XX,YY:integer;
    t,tt,ttt,f1,f2,f3,f4:real;
begin
  if linepointnum = 2 then
     begin
       result.X := (linepoints[1].X + linepoints[2].X) div 2;
       result.Y := (linepoints[1].Y + linepoints[2].Y) div 2;
     end
  else if linepointnum > 2 then
     begin
       t  := 0.75;
       tt := t*t ;
       f1 := 2*tt - 3*t +1;
       f2 := 4*t - 4*tt;
       f3 := 2*tt - t;
       result.X := round(f1* linepoints[linepointnum-2].X + f2* linepoints[linepointnum-1].X + f3* linepoints[linepointnum].X );
       result.Y := round(f1* linepoints[linepointnum-2].Y + f2* linepoints[linepointnum-1].Y + f3* linepoints[linepointnum].Y );
     end;
end;

procedure Tanyline.Setlinewidth(value:integer);
begin
  if Flinewidth <> Value then
  begin
    Flinewidth := Value;
    Invalidate;
  end;
end;

end.