⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ctlpoint.pas

📁 图论算法
💻 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 + -