我做了一个简易的关于直线的控件,属性:两端点,颜色,粗细,事件: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.
代码如下:
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.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货