从网上搜来的,关于Form自己做一下
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;
type
TOperatorType=(otNone,otDrawLine,otSelect);
TAPoint=Array of TPoint;
TLine=Class//Ï߶ÔÏó.
Public
Selected:Boolean;
PointList:TAPoint;//Ï߶ÔÏóµÄµãÁбí.
constructor Create;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
SpinEdit1: TSpinEdit;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button3Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
FOperatorType:TOperatorType;
LineList:TList;
FPointList:TAPoint;
procedure ClearLine;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Const
Minimal=5;
////////////////////////////////////////////////////////////////////
//¼ÆËãÁ½µã¼äµÄ¾àÀë¡£
//²ÎÊý£ºx1,x2,y1,y2:Integer£¬ÐèÒª¼ÆËãµÄÁ½¸öµãµÄXºÍY×ø±ê¡£
//·µ»ØÖµÊÇÁ½¸öµãµÄ¾àÀë¡£
////////////////////////////////////////////////////////////////////
function DotDis(x1,x2,y1,y2:Integer)
ouble;Overload;
Var X,y
ouble;
//ÐèÒªÏȽ«ÕûÐÎÊý¾Ýת»»³ÉË«¾«¶È¸¡µãÐͲŲ»ÈÝÒ×Òç³ö¡£
begin
x:=(x1-x2)/5000000;
y:=(y1-y2)/5000000;
Result:=(SQRT(SQR(x)+SQR
))*5000000;
end;
////////////////////////////////////////////////////////////////////
//¼ÆËãÁ½µã¼äµÄ¾àÀë¡£
//²ÎÊý£ºDot1,Dot2:TPoint£¬ÐèÒª¼ÆËãµÄÁ½¸öµã¡£
//·µ»ØÖµÊÇÁ½¸öµãµÄ¾àÀë¡£
////////////////////////////////////////////////////////////////////
function DotDis(Dot1,Dot2:TPoint)
ouble; Overload;
begin
Result:=DotDis(Dot1.x,Dot2.x,Dot1.y,Dot2.y);
end;
////////////////////////////////////////////////////////////////////
//µãµ½Ï߶εľàÀë¡£Èç¹ûµãÓëÖ±ÏߵĴ¹×ã²»ÔÚÏ߶ÎÉÏ£¬ÔòÈ¡µãµ½Ï߶Î×î½üµãµÄ¾àÀë¡£
//²ÎÊý£ºpFrom, pTo:TPoint£¬Ï߶εĶ˵㡣
// pDot£¬µÚÈýµã¡£
//·µ»ØÖµÊǵÚÈýµãÓëÏ߶εľàÀë¡£
////////////////////////////////////////////////////////////////////
function Dot2Line(pFrom, pTo, pDot: Tpoint)
ouble;
var
F2T_Dis,D2T_Dis,D2F_Dis,s
ouble;
begin
F2T_Dis:=DotDis(pFrom,pTo);
D2T_Dis:=DotDis(pDot,pTo);
D2F_Dis:=DotDis(pDot,pFrom);
if (D2F_Dis>SQRT(SQR(D2T_Dis)+SQR(F2T_Dis))) then
Result:=D2T_Dis
else if (D2T_Dis>SQRT(SQR(D2F_Dis)+SQR(F2T_Dis))) then
Result:=D2F_Dis
else if (Trunc(D2F_Dis)=Trunc(SQRT(SQR(D2T_Dis)+SQR(F2T_Dis)))) then
Result:=D2T_Dis
else if (Trunc(D2T_Dis)=Trunc(SQRT(SQR(D2F_Dis)+SQR(F2T_Dis)))) then
Result:=D2F_Dis
else if F2T_Dis<0.0001 then
begin
if D2T_Dis>D2F_Dis then
Result:=D2F_Dis
else
Result:=D2T_Dis;
end else
begin
s:=(D2F_Dis+D2T_Dis+F2T_Dis)/2;
Result:=SQRT(ABS(s*(s-D2F_Dis)*(s-D2T_Dis)*(s-F2T_Dis)))*2/F2T_Dis;
end;
end;
////////////////////////////////////////////////////////////////////
//&Aring;&ETH;&para;&Iuml;&micro;&atilde;&Ecirc;&Ccedil;·&ntilde;&Ocirc;&Uacute;&Ograve;&raquo;&cedil;&ouml;&Igrave;&otilde;&Iuml;&szlig;&Eacute;&Iuml;&raquo;ò&Ograve;&raquo;&para;¨&frac34;à&Agrave;&euml;&Auml;&Uacute;&iexcl;&pound;
//&sup2;&Icirc;&Ecirc;&yacute;&pound;&ordm;PointArray:Array of TPoint×é&sup3;&Eacute;&Ccedil;&oslash;&Oacute;ò&micro;&Auml;&micro;&atilde;&Aacute;&ETH;±í&iexcl;&pound;
// Dot&pound;&not;&micro;&Uacute;&Egrave;&yacute;&micro;&atilde;&iexcl;&pound;
// Var Contrast
ouble&Ouml;&cedil;&para;¨&micro;&Auml;&frac34;à&Agrave;&euml;&pound;&not;&Egrave;&ccedil;&sup1;&ucirc;&micro;&atilde;&Oacute;&euml;&Iuml;&szlig;&micro;&Auml;&frac34;à&Agrave;&euml;&ETH;&iexcl;&Oacute;&Uacute;&Otilde;&acirc;&cedil;&ouml;&Ouml;&micro;&pound;&not;&Ocirc;ò&Oacute;&Atilde;&Otilde;&acirc;&cedil;&ouml;&Ouml;&micro;&Agrave;&acute;·&micro;&raquo;&Oslash;×&icirc;&frac12;ü&micro;&Auml;&frac34;à&Agrave;&euml;&iexcl;&pound;
// Var PointIndex:Integer·&micro;&raquo;&Oslash;&Oacute;&euml;&cedil;&Atilde;&micro;&atilde;×&icirc;&frac12;ü&micro;&Auml;&Iuml;&szlig;&Eacute;&Iuml;&micro;&Auml;&micro;&atilde;&micro;&Auml;&ETH;ò&ordm;&Aring;&iexcl;&pound;
//·&micro;&raquo;&Oslash;&micro;&Uacute;&Egrave;&yacute;&micro;&atilde;&Ecirc;&Ccedil;·&ntilde;&Ocirc;&Uacute;&Iuml;&szlig;&Eacute;&Iuml;&raquo;ò&frac34;à&Iuml;&szlig;&Ograve;&raquo;&para;¨&frac34;à&Agrave;&euml;&iexcl;&pound;
////////////////////////////////////////////////////////////////////
function MyPTInLine(PointArray:TAPoint;Dot:TPoint;Var Contrast
ouble;Var PointIndex:Integer):Boolean;
Var MaxX,MaxY,MinX,MinY,i,Count:Integer;
dDot2LineValue
ouble;
Dis1,Dis2
ouble;
begin
Result:=False;
Count:=High(PointArray)+1;
PointIndex:=-1;
if Count<=1 then
Exit;
MaxX:=0;
MaxY:=0;
MinX:=MaxInt;
MinY:=MaxInt;
For i:=0 to Count-1 do
begin
if MaxX<PointArray
.x then
MaxX:=PointArray.x;
if MaxY<PointArray.y then
MaxY:=PointArray.y;
if MinX>PointArray.x then
MinX:=PointArray.x;
if MinY>PointArray.y then
MinY:=PointArray.y;
end;
if (Dot.x>MaxX+Contrast)
or (Dot.x<MinX-Contrast)
or (Dot.Y>MaxY+Contrast)
or (Dot.Y<MinY-Contrast)
then
Exit;
For i:=0 to Count-2 do
begin
dDot2LineValue:=Dot2Line(PointArray,PointArray[i+1],Dot);
if dDot2LineValue<=Contrast then
begin
Result:=True;
Contrast:=dDot2LineValue;
Dis1:=DotDis(PointArray,Dot);
Dis2:=DotDis(PointArray[i+1],Dot);
if (Dis1<Dis2) and (Dis1<=Minimal) then
PointIndex:=i
else if (Dis2<Dis1) and (Dis2<=Minimal) then
PointIndex:=i+1;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LineList:=TList.Create; //&acute;&acute;&frac12;¨&Aacute;&ETH;±í±&pound;&acute;&aelig;&para;&Ocirc;&Iuml;ó.
FOperatorType:=otNone; //&Ecirc;&Ccedil;·&ntilde;&Ocirc;&Uacute;&raquo;&shy;&Iuml;&szlig;.
end;
procedure TForm1.ClearLine;//&Ccedil;&aring;&sup3;&yacute;&Iuml;&szlig;&para;&Ocirc;&Iuml;ó.
Var i:Integer;
Line:TLine;
begin
For i:=LineList.Count-1 downto 0 do//&Ecirc;&Iacute;·&Aring;&Atilde;&iquest;&Ograve;&raquo;&cedil;&ouml;&para;&Ocirc;&Iuml;ó.
begin
Line:=LineList;
Line.Free;
LineList.Delete(i);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearLine;//&Iuml;&Egrave;&Ccedil;&aring;&sup3;&yacute;&Iuml;&szlig;&para;&Ocirc;&Iuml;ó.
LineList.Free;//&Ecirc;&Iacute;·&Aring;&Aacute;&ETH;±í.
end;
procedure TForm1.FormPaint(Sender: TObject);
Var i,j:Integer;
Line:TLine;
P:TPoint;
begin
For i:=0 to LineList.Count-1 do
begin
Canvas.Brush.Color:=Color;
Line:=LineList;
Canvas.Polyline(Line.PointList);//&raquo;&shy;&Atilde;&iquest;&Ograve;&raquo;&Igrave;&otilde;&Iuml;&szlig;&para;&Ocirc;&Iuml;ó.
if Line.Selected then
begin
Canvas.Brush.Color:=clRed;
For j:=0 to High(Line.PointList) do
begin
p:=Line.PointList[j];
Canvas.FillRect(Rect(P.X-2,P.Y-2,P.x+2,P.Y+2));
end;
end;
end;
if FOperatorType=otDrawLine then
begin
if High(FPointList)>=1 then
Canvas.Polyline(FPointList);//&Egrave;&ccedil;&sup1;&ucirc;&Otilde;&yacute;&Ocirc;&Uacute;&raquo;&shy;&Iuml;&szlig;,&Ocirc;ò°&Ntilde;&Icirc;&acute;&Iacute;ê&sup3;&Eacute;&micro;&Auml;&Iuml;&szlig;&Ograve;&sup2;&raquo;&shy;&sup3;&ouml;&Agrave;&acute;.
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FOperatorType:=otDrawLine;
SetLength(FPointList,0); //&iquest;&ordf;&Ecirc;&frac14;&raquo;&shy;&Iuml;&szlig;&Ccedil;&aring;&sup3;&yacute;&Aacute;&Ugrave;&Ecirc;±&Iuml;&szlig;&micro;&Auml;&micro;&atilde;&Aacute;&ETH;±í.
end;
procedure TForm1.Button2Click(Sender: TObject);
Var Line:TLine;
begin
FOperatorType:=otNone;
if High(FPointList)>=1 then//&Egrave;&ccedil;&sup1;&ucirc;&Ograve;&Ntilde;&frac34;&shy;&Oacute;&ETH;&Aacute;&frac12;&cedil;&ouml;&Ograve;&Ocirc;&Eacute;&Iuml;&micro;&Auml;&micro;&atilde;
begin
Line:=TLine.Create;//&acute;&acute;&frac12;¨&Ograve;&raquo;&cedil;&ouml;&Iuml;&szlig;&para;&Ocirc;&Iuml;ó.
SetLength(Line.PointList,0);//&sup3;&otilde;&Ecirc;&frac14;&raquo;&macr;&Iuml;&szlig;&para;&Ocirc;&Iuml;ó&micro;&Auml;&micro;&atilde;&Aacute;&ETH;±í.
Line.PointList:=Copy(FPointList,0,Sizeof(TPoint)*(High(FPointList)+1));
//&cedil;&acute;&Ouml;&AElig;&micro;±&Ccedil;°&raquo;&shy;&ordm;&Atilde;&micro;&Auml;&Aacute;&Ugrave;&Ecirc;±&micro;&atilde;&Aacute;&ETH;±í.
LineList.Add(Line);//°&Ntilde;&para;&Ocirc;&Iuml;ó&frac14;&Oacute;&Egrave;&euml;&micro;&frac12;&Aacute;&ETH;±í.
Invalidate;//&Ouml;&Oslash;&raquo;&shy;Form
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var Count,i,PoiIDX:Integer;
Line:TLine;
Contrastouble;
begin
if FOperatorType=otDrawLine then//&Egrave;&ccedil;&sup1;&ucirc;&Otilde;&yacute;&Ocirc;&Uacute;&raquo;&shy;&Iuml;&szlig;.
begin
Count:=High(FPointList)+1;
SetLength(FPointList,Count+1);
FPointList[Count]:=Point(x,y);//&Ocirc;&ouml;&frac14;&Oacute;&Ograve;&raquo;&cedil;&ouml;&micro;&atilde;.
Invalidate;
end else if FOperatorType=otSelect then
begin
For i:=0 to LineList.Count-1 do
begin
Line:=LineList;
Contrast:=Minimal;
if MyPTInLine(Line.PointList,Point(x,y),Contrast,PoiIDX) then
begin
Line.Selected:=not Line.Selected;
Invalidate;
Break;
end;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
Var OldLine,NewLine:TLine;
i,j:Integer;
begin
if (SpinEdit1.Value>0) and (LineList.Count>0) then//&Egrave;&ccedil;&sup1;&ucirc;&ETH;è&Ograve;&ordf;&cedil;&acute;&Ouml;&AElig;&Ecirc;&yacute;&acute;ó&Oacute;&Uacute;0&sup2;&cent;&Ccedil;&Ograve;&Ograve;&Ntilde;&frac34;&shy;&acute;&aelig;&Ocirc;&Uacute;&Ograve;&raquo;&cedil;&ouml;&Ograve;&Ocirc;&Eacute;&Iuml;&micro;&Auml;&Iuml;&szlig;&Igrave;&otilde;.
begin
OldLine:=LineList[LineList.Count-1];//&Egrave;&iexcl;&sup3;&ouml;&frac34;&Eacute;&Iuml;&szlig;&Igrave;&otilde;.
For i:=0 to SpinEdit1.Value-1 do//&cedil;&acute;&Ouml;&AElig;&ETH;è&Ograve;&ordf;&micro;&Auml;·&Yacute;&Ecirc;&yacute;.
begin
NewLine:=TLine.Create;//&acute;&acute;&frac12;¨&ETH;&Acirc;&Iuml;&szlig;&Igrave;&otilde;.
SetLength(NewLine.PointList,0);//&sup3;&otilde;&Ecirc;&frac14;&raquo;&macr;&micro;&atilde;&Aacute;&ETH;±í.
NewLine.PointList:=Copy(OldLine.PointList,0,Sizeof(TPoint)*(High(OldLine.PointList)+1));
//&cedil;&acute;&Ouml;&AElig;&micro;&atilde;&Aacute;&ETH;±í.
For j:=0 to High(NewLine.PointList) do//&para;&Ocirc;&micro;&atilde;&frac12;&oslash;&ETH;&ETH;&Ograve;&AElig;&Icirc;&raquo;.
begin
NewLine.PointList[j].X:=NewLine.PointList[j].X+40*(i+1);
NewLine.PointList[j].y:=NewLine.PointList[j].y+40*(i+1);
end;
LineList.Add(NewLine);//&frac14;&Oacute;&ordm;&Iacute;&micro;&frac12;&Aacute;&ETH;±í.
end;
Invalidate;//&Ouml;&Oslash;&raquo;&shy;.
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (FOperatorType=otDrawLine) and (High(FPointList)>=0) then//&Otilde;&acirc;&Ouml;&Ouml;·&frac12;·¨&frac14;ò&micro;&yen;&sup2;&raquo;&sup1;&yacute;&Ecirc;ó±ê&Ograve;&AElig;&para;&macr;&Ecirc;±&raquo;á&Ocirc;ì&sup3;&Eacute;&Eacute;&Aacute;&para;&macr;.
begin
Invalidate;
Canvas.MoveTo(FPointList[High(FPointList)].x,FPointList[High(FPointList)].y);
Canvas.LineTo(x,y);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
FOperatorType:=otSelect;
end;
{ TLine }
constructor TLine.Create;
begin
inherited;
Selected:=False;
end;
procedure TForm1.Button5Click(Sender: TObject);
Var i:Integer;
Line:TLine;
bDeleted:Boolean;
begin
bDeleted:=False;
For i:=LineList.Count-1 downto 0 do//&Ecirc;&Iacute;·&Aring;&Atilde;&iquest;&Ograve;&raquo;&cedil;&ouml;&para;&Ocirc;&Iuml;ó.
begin
Line:=LineList;
if Line.Selected then
begin
Line.Free;
LineList.Delete(i);
bDeleted:=True;
end;
end;
if bDeleted then
Invalidate;
end;
end.