unit DdhGraph;

interface

{$R *.DCR}

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

type
  TDdhGraph = class; // forward declaration

  TDdhPoint = class (TCollectionItem)
  private
    fX, fY: Integer;
  public
    Text: string;
    procedure WriteText (Writer: TWriter);
    procedure ReadText (Reader: TReader);
    procedure DefineProperties (Filer: TFiler); override;
    procedure Paint (Canvas: TCanvas);
    procedure Assign (Pt: TPersistent); override;
  published
    property X: Integer read fX write fX;
    property Y: Integer read fY write fY;
  end;

  TDdhPoints = class (TCollection)
  private
    fGrid: TDdhGraph;
    function GetItem (Index: Integer): TDdhPoint;
    procedure SetItem (Index: Integer; Value: TDdhPoint);
  protected
    procedure Update (Item: TCollectionItem); override;
  public
    constructor Create (Grid: TDdhGraph);
    function Add: TDdhPoint;
    property Items [Index: Integer]: TDdhPoint
      read GetItem write SetItem; default;
  end;

  TDdhGraph = class(TGraphicControl)
  private
    fPoints: TDdhPoints;
    fDefText: string;
    fBorderStyle: TBorderStyle;
    fLinesColor: TColor;
  protected
    procedure SetBorderStyle (Value: TBorderStyle);
    procedure SetLinesColor (Value: TColor);
    procedure MouseDown (Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create (Owner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Color; // fill color
    property LinesColor: TColor
      read fLinesColor write SetLinesColor
      default clBlack;
    property Font;
    property Align;
    property DefaultText: string
      read fDefText write fDefText;
    property BorderStyle: TBorderStyle
      read fBorderStyle write SetBorderStyle
      default bsNone;
    // collection property
    property Points: TDdhPoints
      read fPoints write fPoints;
  end;

procedure Register;

implementation

// TDdhPoint collection item

procedure TDdhPoint.WriteText (Writer: TWriter);
begin
  Writer.WriteString (Text);
end;

procedure TDdhPoint.ReadText (Reader: TReader);
begin
  Text := Reader.ReadString;
end;

procedure TDdhPoint.DefineProperties (Filer: TFiler);
begin
  Filer.DefineProperty (
    'Text', ReadText, WriteText, (Text <> ''));
end;

procedure TDdhPoint.Paint (Canvas: TCanvas);
begin
  if Index > 0 then
    Canvas.LineTo (fX, fY);
  Canvas.Ellipse (fX - 3, fY - 3, fX + 3, fY + 3);
  Canvas.TextOut (fX + 5, fY + 5, Text);
  Canvas.MoveTo (fX, fY);
end;

procedure TDdhPoint.Assign (Pt: TPersistent);
begin
  if Pt is TDdhPoint then
  begin
    fx := TDdhPoint (Pt).fX;
    fY := TDdhPoint (Pt).fY;
    Text := TDdhPoint (Pt).Text;
  end
  else
    // raise an exception
    inherited Assign (pt);
end;

// TDdhPoints collection

constructor TDdhPoints.Create (Grid: TDdhGraph);
begin
  inherited Create (TDdhPoint);
  fGrid := Grid;
end;

function TDdhPoints.Add: TDdhPoint;
begin
  Result := TDdhPoint (inherited Add);
end;

function TDdhPoints.GetItem (
  Index: Integer): TDdhPoint;
begin
  Result := TDdhPoint (inherited GetItem (Index));
end;

procedure TDdhPoints.SetItem (
  Index: Integer; Value: TDdhPoint);
begin
  inherited SetItem (Index, Value);
end;

procedure TDdhPoints.Update (
  Item: TCollectionItem);
begin
  if Item <> nil then
    fGrid.Invalidate;
end;

// TDdhGraph component

constructor TDdhGraph.Create (Owner: TComponent);
begin
  inherited Create (Owner);
  fPoints := TDdhPoints.Create (self);
  fDefText := 'Pt';
  fBorderStyle := bsNone;
  fLinesColor := clBlack;
  // desing time right clicks = left clicks
  ControlStyle := ControlStyle + [csDesignInteractive];
end;

destructor TDdhGraph.Destroy;
begin
  fPoints.Free;
  fPoints := nil;
  inherited Destroy;
end;

procedure TDdhGraph.SetBorderStyle (Value: TBorderStyle);
begin
  if Value <> fBorderStyle then
  begin
    fBorderStyle := Value;
    Invalidate;
  end;
end;

procedure TDdhGraph.SetLinesColor (Value: TColor);
begin
  if Value <> fLinesColor then
  begin
    fLinesColor := Value;
    Invalidate;
  end;
end;

procedure TDdhGraph.MouseDown (Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Pt: TDdhPoint;
begin
  if (not (csDesigning in ComponentState)) or
    ((csDesigning in ComponentState) and
    (ssCtrl in Shift)) then
  begin
    Pt := fPoints.Add;
    Pt.X := X;
    Pt.Y := Y;
    Pt.Text := Format ('%s%d', [fDefText, fPoints.Count]);
    Invalidate;
  end;
end;

procedure TDdhGraph.Paint;
var
  I: Integer;
begin
  // values used when drawing the points
  with Canvas do
  begin
    Brush.Color := Color;
    Pen.Color := fLinesColor;
    Pen.Style := psSolid;
    Font.Assign (self.Font);
  end;

  // draw the points
  for I := 0 to fPoints.Count - 1 do
    fPoints.Items[I].Paint (Canvas);

  // eventually draw a border
  with Canvas do
    // at design time
    if csDesigning in ComponentState then
    begin
      Pen.Color := clBlack;
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle (0, 0, Width, Height);
    end
    // at run time
    else if BorderStyle = bsSingle then
    begin
      Pen.Color := clBlack;
      Pen.Style := psSolid;
      Brush.Style := bsClear;
      Rectangle (0, 0, Width, Height);
    end;
end;

procedure Register;
begin
  RegisterComponents ('DDHB', [TDdhGraph]);
end;

end.