grapoint.pas

图论算法

unit grapoint;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TGraphPoint = class(TGraphicControl)
  private
        Flinecolor : Tcolor;
        Ffillcolor : Tcolor;
        FBrushStyle: TBrushStyle;
        FPenStyle:TPenStyle;
	FPointLabelColor: TColor;
        FPointLabel:integer;
        FOnMouseEnter: TNotifyEvent;
        FOnMouseLeave: TNotifyEvent;
	procedure Setfillcolor(Value: TColor);
        procedure SetPointLabelcolor(value:Tcolor);
        procedure SetPointLabel(value:integer);
        procedure Setlinecolor(value:TColor);
        procedure SetBrushStyle(value:TBrushStyle);
        procedure SetPenStyle(value:TPenStyle);
        procedure CMMOUSELEAVE(var Message: TMessage); message CM_MOUSELEAVE;
        procedure CMMOUSEENTER(var Message: TMessage); message CM_MOUSEENTER;
  protected
	procedure Paint; override;
//        procedure CreateParams(var Params: TCreateParams);override;
//        procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
        procedure MouseEnter;
        procedure MouseLeave;
  public
        Vertex:Tobject;
	constructor Create(AOwner: TComponent);override;
        destructor  destroy;override;
        function centerpoint:Tpoint;
  published
	property DragCursor;
	property DragMode;
	property Enabled;
	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 PointLabelcolor:Tcolor read FPointLabelColor write SetPointLabelColor;
        property PointLabel:integer read FPointLabel write SetPointLabel;

	property ParentColor;
	property ParentShowHint;
	property ShowHint;
	property Visible;
	property OnDragDrop;
	property OnDragOver;
	property OnEndDrag;
	property OnMouseDown;
	property OnMouseMove;
	property OnMouseUp;
	property OnStartDrag;
//        property OnKeyPress;
        property OnDblClick;
        property PopupMenu;
        property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
        property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Graph', [TGraphPoint]);
end;

constructor TGraphPoint.Create(AOwner: TComponent);
begin
  PointLabel := 0;
  inherited Create(AOwner);
//  ControlStyle := ControlStyle - [csOpaque];
  Width := 16;
  Height := 16;
  Ffillcolor := clWhite;
  Flinecolor := clBlack;
  FPointLabelColor :=clBlack;
  FBrushStyle := bsSolid;
  FPenStyle := psSolid;
 // BringtoFront;
end;

destructor  TGraphPoint.destroy;
begin
  inherited destroy;
end;

//procedure TGraphPoint.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 TGraphPoint.WMEraseBkgnd(var Message: TWMEraseBkgnd);
//begin
                                       { completely fake erase, don't call inherited, don't collect $200 }
//  Message.Result := 1;

//end;

procedure TGraphPoint.Paint;
begin
  with canvas do
    begin
      pen.color := FLineColor;
      pen.style := FPenStyle;
      pen.width := 1;
      brush.color := FFillColor;
      brush.Style := FBrushStyle;
      Ellipse(0, 0, Width, Height);
      font.color := FPointLabelColor;
      font.name := 'MS Serif';
      if PointLabel < 10 then
         begin
           font.size := 8;
           TextOut(5,1,inttostr(PointLabel));
         end
      else if PointLabel < 100 then
         begin
           font.size := 6;
           TextOut(2,3,inttostr(PointLabel));
         end
      else
         begin
           font.name := 'Small Fonts';
           font.size := 5;
           TextOut(2,4,inttostr(PointLabel));
         end
    end;
end;

function TGraphPoint.centerpoint:Tpoint;
begin
  result.X := left + 8;
  result.Y := top + 8;
end;


procedure TGraphPoint.Setfillcolor(Value: TColor);
begin
  if Ffillcolor <> Value then
  begin
    Ffillcolor := Value;
    Invalidate;
  end;
end;

procedure TGraphPoint.SetPointLabelcolor(value:Tcolor);
begin
  if FPointLabelColor <> Value then
  begin
    FPointLabelColor := Value;
    Invalidate;
  end;
end;

procedure TGraphPoint.SetPointLabel(value:integer);
begin
  if FPointLabel <> Value then
  begin
    FPointLabel := Value;
    Invalidate;
  end;
end;

procedure TGraphPoint.Setlinecolor(value:TColor);
begin
  if Flinecolor <> Value then
  begin
    Flinecolor := Value;
    Invalidate;
  end;
end;

procedure TGraphPoint.SetBrushStyle(value:TBrushStyle);
begin
  if FBrushStyle <> Value then
  begin
    FBrushStyle := Value;
    Invalidate;
  end;
end;
procedure TGraphPoint.SetPenStyle(value:TPenStyle);
begin
  if FPenStyle <> Value then
  begin
    FPenStyle := Value;
    Invalidate;
  end;
end;

procedure TGraphPoint.CMMOUSELEAVE(var Message: TMessage);
begin
  inherited;
  MouseLeave;
end;

procedure TGraphPoint.CMMOUSEENTER(var Message: TMessage);
begin
  inherited;
  MouseEnter;
end;

procedure TGraphPoint.MouseEnter;
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TGraphPoint.MouseLeave;
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

end.