发信人: lihai155(天琴)
整理人: kingron(2000-12-27 18:20:13), 站内信件
|
unit Line;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TLine = class(TPanel)
private
FEndY: Integer;
FStartY: Integer;
FEndX: Integer;
FStartX: Integer;
HdlRgn:THandle;
FLineWidth: Integer;
procedure SetEndX(const Value: Integer);
procedure SetEndY(const Value: Integer);
procedure SetStartX(const Value: Integer);
procedure SetStartY(const Value: Integer);
procedure DrawLine;
procedure SetLineWidth(const Value: Integer);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner:TComponent);override;
Destructor Destroy;override;
published
{ Published declarations }
property StartX:Integer Read FStartX write SetStartX;
property StartY:Integer Read FStartY write SetStartY;
property EndX:Integer Read FEndX write SetEndX;
property EndY:Integer Read FEndY write SetEndY;
property LineWidth:Integer Read FLineWidth write SetLineWidth;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TLine]);
end;
{ TLine }
constructor TLine.Create(AOwner: TComponent);
begin
inherited;
Self.Caption:='';
Color:=clRed;
if Parent=nil then
Parent:=TWinControl(AOwner);
Left:=0; Top:=0;
FStartX:=0; FStartY:=0;
FEndX:=100; FEndY:=100;
FLineWidth:=3;
DrawLine;
end;
destructor TLine.Destroy;
begin
inherited;
DeleteObject(HdlRgn);
end;
procedure TLine.DrawLine;
Var
Pnts:Array[1..4]of TPoint;
begin
if Parent=nil then exit;
Pnts[1].x:=FStartX; Pnts[1].y:=FStartY;
Pnts[2].x:=FEndX; Pnts[2].y:=FEndY;
Pnts[3].x:=FEndX+FLineWidth; Pnts[3].y:=FEndY - FLineWidth;
Pnts[4].x:=FStartX+FLineWidth; Pnts[4].y:=FStartY - FLineWidth;
if HdlRgn>0 then
DeleteObject(HdlRgn);
HdlRgn:=CreatePolyGonRgn(Pnts,4,Winding);
SetWindowRgn(Handle,HdlRgn,True);
DeleteObject(Handle);
end;
procedure TLine.SetEndX(const Value: Integer);
begin
FEndX := Value;
DrawLine;
end;
procedure TLine.SetEndY(const Value: Integer);
begin
FEndY := Value;
DrawLine;
end;
procedure TLine.SetLineWidth(const Value: Integer);
begin
FLineWidth := Value;
DrawLine;
end;
procedure TLine.SetStartX(const Value: Integer);
begin
FStartX := Value;
DrawLine;
end;
procedure TLine.SetStartY(const Value: Integer);
begin
FStartY := Value;
DrawLine;
end;
end.
//这个控件在编辑环境下有一个虚框，在运行时就是一个线形了。
//有什么改进意见欢迎回复，谢谢。
----
头上起包包，鲜血直见飚。
脚杆不松活，据说要开刀。
还考啥子初中，差点儿进高烟囱。 |
|