📄 ctlpoint.pas
字号:
unit ctlpoint;
interface
uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus,
Graphics;
type
TControlPoint = class(TGraphicControl)
private
Flinecolor : Tcolor;
Ffillcolor : Tcolor;
FPenStyle:TPenStyle;
FBrushStyle: TBrushStyle;
procedure Setfillcolor(Value: TColor);
procedure Setlinecolor(value:TColor);
procedure SetBrushStyle(value:TBrushStyle);
procedure SetPenStyle(value:TPenStyle);
protected
procedure Paint; override;
// procedure CreateParams(var Params: TCreateParams);override;
public
controledge:Tobject;
orderno:integer;
constructor Create(AOwner: TComponent); override;
// destructor Destroy; override;
published
property fillcolor: TColor read Ffillcolor write Setfillcolor;
property linecolor :Tcolor read Flinecolor write Setlinecolor;
property BrushStyle :TBrushStyle read FBrushStyle write SetBrushStyle;
property PenStyle :TPenStyle read FPenStyle write SetPenStyle;
property DragCursor;
property DragMode;
property Enabled;
property ShowHint;
property Visible;
property PopupMenu;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDblClick;
property OnStartDrag;
end;
procedure register;
implementation
procedure register;
begin
RegisterComponents('Graph', [TControlPoint]);
end;
constructor TControlPoint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 8;
Height := 8;
with canvas do
begin
Ffillcolor := clLime;
Flinecolor := clGreen;
FBrushStyle := bsSolid;
FPenStyle := psSolid;
end;
// bringtofront;
end;
//procedure TControlPoint.CreateParams(var Params: TCreateParams);
//begin
{ set default Params values }
// inherited CreateParams(Params);
{ then add transparency; ensures correct repaint order }
// Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
//end;
procedure TControlPoint.Paint;
begin
with Canvas do
begin
Pen.color := Flinecolor;
pen.style := FPenStyle;
Brush.color := Ffillcolor;
Brush.style := FBrushStyle;
Ellipse(0,0,width,height);
end;
end;
procedure TControlPoint.Setfillcolor(Value: TColor);
begin
if Ffillcolor <> Value then
begin
Ffillcolor := Value;
Invalidate;
end;
end;
procedure TControlPoint.Setlinecolor(value:TColor);
begin
if Flinecolor <> Value then
begin
Flinecolor := Value;
Invalidate;
end;
end;
procedure TControlPoint.SetBrushStyle(value:TBrushStyle);
begin
if FBrushStyle <> Value then
begin
FBrushStyle := Value;
Invalidate;
end;
end;
procedure TControlPoint.SetPenStyle(value:TPenStyle);
begin
if FPenStyle <> Value then
begin
FPenStyle := Value;
Invalidate;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -