我做了一个简易的关于直线的控件,属性:两端点,颜色,粗细,事件:onclick,onpaint
代码如下:
unit Line;
interface
uses
 Windows, Messages, SysUtils, Classes, Controls,Graphics;
type
 TWidthType = (thin,middle,thick);
 TLineType = (solid,dot);
 TOnPaintEvent = procedure (Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;
 TLine = class(TGraphicControl)
 private
   { Private declarations }
   FColor:TColor;     ////
   FLineWidth:TWidthType;  ///////
   FLineType :TLineType;////
   FPoint1,FPoint2:TPoint;   //一条直线的两个端点
   FCaption: String;
   FOnPaint: TOnPaintEvent;  //OnPaint事件
   procedure SetCaption(Value: String);
//    function  NearLine(X,Y: Integer):boolean;
   procedure SetColor(Value:TColor);//
   procedure SetLineWidth(Value:TWidthType);  ///
   procedure SetLineType(Value:TLineType);
   procedure SetPoint1(Value:TPoint);
   procedure SetPoint2(Value:TPoint);
 protected
   { Protected declarations }
 public
   { Public declarations }
   procedure Paint; override;
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   { Published declarations }
   property Point1: TPoint read FPoint1 write SetPoint1;
   property Point2: TPoint read FPoint2 write SetPoint2;
   property LineWidth:TWidthType read FLineWidth write SetLineWidth;////////
   property LineType :TLineType read FLineType write SetLineType;
   property Color :TColor read FColor write SetColor;  //////////////////////
   property OnClick;
   property OnPaint: TOnPaintEvent read FOnPaint write FOnPaint;
 end;procedure Register;implementationprocedure Register;
begin
 RegisterComponents('Samples', [TLine]);
end;{ TLine }constructor TLine.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FPoint1.X := 20;
 FPoint1.Y := 20;
 FPoint2.X := 100;
 FPoint2.Y := 100;
 FColor:= clBlack;
 FLineWidth := middle ;end;destructor TLine.Destroy;
begin
 inherited Destroy;
end;procedure TLine.Paint;
var
  x1,y1:Integer;
  x2,y2:Integer;
begin
 inherited;
 x1 := Point1.X;
 y1 := Point1.Y;
 x2 := Point2.X;
 y2 := Point2.Y;
 case FLineWidth of
 thin : canvas.Pen.Width := 1;
 middle: canvas.Pen.Width := 3;
 thick: canvas.Pen.Width := 5;
 end; case FLineType of
 solid : canvas.Pen.Style := psSolid;
 dot : canvas.Pen.Style := psDot;
 end; if canvas.Pen.Style = psDot then canvas.Pen.Width := 1;
 with canvas do
 begin
 pen.Color:= FColor;
 MoveTo(x1,y1);
 LineTo(x2,y2);
 end;
end;procedure TLine.SetCaption(Value: String);
begin
if Value = FCaption then exit;
FCaption := Value;
invalidate;
end;
procedure TLine.SetColor(Value: TColor);
begin
   if Value = FColor then exit;
   FColor := Value;
   invalidate;
end;procedure TLine.SetLineType(Value: TLineType);
begin
  if Value = FLineType then exit;
  FlineType := Value;
  Invalidate;
end;procedure TLine.SetLineWidth(Value: TWidthType);
begin
   if Value =  FLineWidth then exit;
   FLineWidth := Value;
   Invalidate;
end;procedure TLine.SetPoint1(Value: TPoint);
begin
   if (Value.X=FPoint1.X)and(Value.Y=FPoint1.Y) then exit;
  FPoint1:= Value;
  invalidate;
end;procedure TLine.SetPoint2(Value: TPoint);
begin
   if (Value.X = FPoint2.X)and(Value.Y=FPoint2.Y) then exit;
   FPoint2 := Value ;
   invalidate;
end;
end.
安装上这个控件后,新建一个应用程序,在窗体上增加一个button,button的onclick中,给直线的两个端点重新赋值,但是在单击button后,出现的结果明显是不对的:显示了直线的很少的一部分,为什么呢?即使调用line1.paint也是这样。
unit Unit1;interfaceuses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Line;type
 TForm1 = class(TForm)
   Line1: TLine;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;var
 Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
 dot1,dot2:TPoint;
begin
 dot1.X:=20;
 dot1.Y:=40;
 dot2.X:=100;
 dot2.Y:=400;
 line1.Point1:=dot1;
 line1.Point2:=dot2;
//  line1.Paint;
end;
end.