DELPHI中有没有用来绘出折线得控件?第三方控件也可以,十万火急

Question

DELPHI中有没有用来绘出折线得控件?第三方控件也可以,十万火急

Answer 1

//刚才写了一个，安装上看看～～(*//
标题:折线控件
说明:参考TShape
日期:2003-11-26
设计:Zswang
//*)unit Polygon;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;type
  TPolygon = class(TGraphicControl)
  private
    { Private declarations }
    FItems: TStrings;
    FPoints: array of TPoint;
    FBrush: TBrush;
    FPen: TPen;
    FPolyLine: Boolean;
    FAutoRect: Boolean;
    procedure SetItems(const Value: TStrings);
    procedure SetBrush(const Value: TBrush);
    procedure SetPen(const Value: TPen);
    procedure SetPolyLine(const Value: Boolean);    procedure ItemsChange(Sender: TObject);
    procedure StyleChanged(Sender: TObject);
    procedure SetAutoRect(const Value: Boolean);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;    procedure InsertPoint(mIndex: Integer; mPoint: TPoint);
    function AddPoint(mPoint: TPoint): Integer;
    procedure DeletePoint(mIndex: Integer);
  published
    { Published declarations }
    property Items: TStrings read FItems write SetItems;    property AutoRect: Boolean read FAutoRect write SetAutoRect;
    property Align;
    property Anchors;
    property Brush: TBrush read FBrush write SetBrush;
    property Color;
    property PolyLine: Boolean read FPolyLine write SetPolyLine;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentColor;
    property ParentShowHint;
    property Pen: TPen read FPen write SetPen;
    property ShowHint;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Zswang', [TPolygon]);
end;function StrLeft(const mStr: string; mDelimiter: string): string;
{ 返回左分隔字符串 }
begin
  Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }function StrRight(const mStr: string; mDelimiter: string): string;
begin
  if Pos(mDelimiter, mStr) > 0 then
    Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
  else Result := '';
end; { StrRight }{ TPolygon }function TPolygon.AddPoint(mPoint: TPoint): Integer;
begin
  Result := Items.Add(Format('%d,%d', [mPoint.X, mPoint.Y]));
end;constructor TPolygon.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := ItemsChange;  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
end;procedure TPolygon.DeletePoint(mIndex: Integer);
begin
  Items.Delete(mIndex);
end;destructor TPolygon.Destroy;
begin
  if Assigned(FItems) then FItems.Free;
  SetLength(FPoints, 0);
  FPoints := nil;
  inherited;
end;procedure TPolygon.InsertPoint(mIndex: Integer; mPoint: TPoint);
begin
  Items.Insert(mIndex, Format('%d,%d', [mPoint.X, mPoint.Y]));
end;procedure TPolygon.ItemsChange(Sender: TObject);
var
  I: Integer;
  vMaxX, vMaxY: Integer;
begin
  SetLength(FPoints, TStrings(Sender).Count);
  vMaxX := 0;
  vMaxY := 0;
  for I := 0 to TStrings(Sender).Count - 1 do begin
    FPoints[I].X := StrToIntDef(StrLeft(TStrings(Sender)[I], ','), 0);
    if vMaxX < FPoints[I].X then vMaxX := FPoints[I].X;
    FPoints[I].Y := StrToIntDef(StrRight(TStrings(Sender)[I], ','), 0);
    if vMaxY < FPoints[I].Y then vMaxY := FPoints[I].Y;
  end;
  if AutoRect then begin
    Width := vMaxX;
    Height := vMaxY;
  end;
  Repaint;
end;procedure TPolygon.Paint;
begin
  inherited;
  ///////Begin Clear
  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Canvas.ClipRect);
  ///////End Clear  Canvas.Pen := FPen;
  Canvas.Brush := FBrush;
  if FPolyLine then
    Canvas.Polyline(FPoints)
  else Canvas.Polygon(FPoints);
end;procedure TPolygon.SetAutoRect(const Value: Boolean);
begin
  FAutoRect := Value;
  ItemsChange(FItems);
end;procedure TPolygon.SetBrush(const Value: TBrush);
begin
  FBrush.Assign(Value);
end;procedure TPolygon.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;procedure TPolygon.SetPen(const Value: TPen);
begin
  FPen.Assign(Value);
end;procedure TPolygon.SetPolyLine(const Value: Boolean);
begin
  FPolyLine := Value;
  Invalidate;
end;procedure TPolygon.StyleChanged(Sender: TObject);
begin
  Invalidate;
end;end.

Answer 2

destructor TPolygon.Destroy;
begin
  if Assigned(FItems) then FItems.Free;
  if Assigned(FPen) then FPen.Free; ///漏了
  if Assigned(FBrush) then FBrush.Free; //漏了
  SetLength(FPoints, 0);
  FPoints := nil;
  inherited;
end;

Answer 3

好像上面的高手没有搞懂我的意思，我是说能想在word当中画折线一样，在开发环境中折线做为一个控件出现，并且在每个折线拐角的地方出现箭头，当然这个控件没有固定的形状，而是随着你的鼠标的点击确定折线的形状，不知道诸位高手能否给解答

Answer 4

建议你自已开发一个控件，它的父类是shape

Answer 5

有一个XXcad的控件，中国人自己做的，你搜索以前的帖子，就搜CAD我这里网速慢，不帮你搜了。。