ddhedcol.pas

Delphi高级开发指南是开发程序的好帮手

unit DdhEdCol;

interface

///// {$R *.DCR}

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

type
  TDdhEdGraph = class; // forward declaration

  TDdhEdPoint = 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;
    procedure SetX (Value: Integer);
    procedure SetY (Value: Integer);
    /// new methods ///
    function GetDisplayName: string; override;
    function GetOwner: TPersistent; override;
  published
    property X: Integer read fX write SetX;
    property Y: Integer read fY write SetY;
  end;

  TDdhEdPoints = class (TCollection)
  private
    fGrid: TDdhEdGraph;
    function GetItem (Index: Integer): TDdhEdPoint;
    procedure SetItem (Index: Integer; Value: TDdhEdPoint);
  protected
    procedure Update (Item: TCollectionItem); override;
  public
    constructor Create (Grid: TDdhEdGraph);
    function Add: TDdhEdPoint;
    /// new method ///
    function GetOwner: TPersistent; override;
    property Items [Index: Integer]: TDdhEdPoint
      read GetItem write SetItem; default;
  end;

  TDdhEdGraph = class(TGraphicControl)
  private
    fPoints: TDdhEdPoints;
    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;
    procedure CmDesignHitTest (var Msg: TWMMouse);
      message cm_DesignHitTest;
  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: TDdhEdPoints
      read fPoints write fPoints;
  end;

type
  TCeCollEdit = class (TComponentEditor)
  public
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): string; override;
    procedure ExecuteVerb(Index: Integer); override;
  end;

procedure Register;

implementation

uses
  ColEditF;

// TDdhEdPoint collection item

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

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

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

procedure TDdhEdPoint.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 TDdhEdPoint.Assign (Pt: TPersistent);
begin
  if Pt is TDdhEdPoint then
  begin
    fx := TDdhEdPoint (Pt).fX;
    fY := TDdhEdPoint (Pt).fY;
    Text := TDdhEdPoint (Pt).Text;
    (Collection as TDdhEdPoints).fGrid.Refresh;
  end
  else
    // raise an exception
    inherited Assign (pt);
end;

procedure TDdhEdPoint.SetX (Value: Integer);
begin
  if Value <> fX then
  begin
    fX := Value;
    (Collection as TDdhEdPoints).fGrid.Refresh;
  end;
end;

procedure TDdhEdPoint.SetY (Value: Integer);
begin
  if Value <> fY then
  begin
    fY := Value;
    (Collection as TDdhEdPoints).fGrid.Refresh;
  end;
end;

/// new methods ///

function TDdhEdPoint.GetDisplayName: string;
begin
  Result := Format ('Point %s [%d]',
    [Text, Index]);
end;

function TDdhEdPoint.GetOwner: TPersistent;
begin
  Result := (Collection as TDdhEdPoints).fGrid;
end;

// TDdhEdPoints collection

constructor TDdhEdPoints.Create (Grid: TDdhEdGraph);
begin
  inherited Create (TDdhEdPoint);
  fGrid := Grid;
end;

function TDdhEdPoints.Add: TDdhEdPoint;
begin
  Result := TDdhEdPoint (inherited Add);
  fGrid.Invalidate;
end;

function TDdhEdPoints.GetItem (
  Index: Integer): TDdhEdPoint;
begin
  Result := TDdhEdPoint (inherited GetItem (Index));
end;

procedure TDdhEdPoints.SetItem (
  Index: Integer; Value: TDdhEdPoint);
begin
  inherited SetItem (Index, Value);
  fGrid.Invalidate;
end;

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

/// new methods ///

function TDdhEdPoints.GetOwner: TPersistent;
begin
  Result := fGrid;
end;

// TDdhEdGraph component

constructor TDdhEdGraph.Create (Owner: TComponent);
begin
  inherited Create (Owner);
  fPoints := TDdhEdPoints.Create (self);
  fDefText := 'Pt';
  fBorderStyle := bsNone;
  fLinesColor := clBlack;
end;

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

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

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

procedure TDdhEdGraph.MouseDown (Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Pt: TDdhEdPoint;
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 TDdhEdGraph.CmDesignHitTest (var Msg: TWMMouse);
begin
  if (Msg.Keys and mk_Control) <> 0 then
    // interactive desing
    Msg.Result := 1
  else
    // default designer behavior
    Msg.Result := 0;
end;

procedure TDdhEdGraph.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;

/// component editor ///

function TCeCollEdit.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TCeCollEdit.GetVerb (Index: Integer): string;
begin
  if Index = 0 then
    Result := 'Points Collection Editor...';
end;

procedure TCeCollEdit.ExecuteVerb (Index: Integer);
begin
  if Index = 0 then
  begin
    if not Assigned (PointsListForm) then
    begin
      PointsListForm := TPointsListForm.Create (Application);
      PointsListForm.Desinger := Designer;
      PointsListForm.Graph := Component as TDdhEdGraph;
    end;
    PointsListForm.Show;
  end;
end;

procedure Register;
begin
  RegisterComponents ('DDHB', [TDdhEdGraph]);
  RegisterComponentEditor (TDdhEdGraph, TCeCollEdit);
end;

end.