谁有像VB中的Line控件？能发一份给我吗？

Question

就是像VB中的画线的控件一样，要有顶点坐标(X1,Y1)和(X2,Y2)属性的，发给我马上给分，分不够再给！！[email protected]

Answer 1

// for Delphi 6
// 画箭头和直线的控件
unit dymLineControl;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;type
  TArrowDir = (adUp, adRight, adDown, adLeft);  {
  TArrowCategory = class(TPropertyCategory)
    class function Name: string; override;
    class function Description: string; override;
  end;
  }
  
  TdymLineControl = class(TGraphicControl)
  private
    FFilled: Boolean;
    FArrowHeight: Integer;
    FDirection: TArrowDir;
    FArrowPoints: array[0..3] of TPoint;
    FBrush: TBrush;
    FPen: TPen;
    FArrowDblClick: TNotifyEvent;
    procedure SetArrowHeight(const Value: Integer);
    procedure SetDirection(const Value: TArrowDir);
    procedure SetFilled(const Value: Boolean);
    procedure ComputePoints;
    procedure SetBrush(const Value: TBrush);
    procedure SetPen(const Value: TPen);
    procedure RepaintRequest(Sender: TObject);
    // arrow double click
    procedure ArrowDblClick;
    procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property Pen: TPen read FPen write SetPen;
    property Brush: TBrush read FBrush write SetBrush;
  published
    { Published declarations }
    property Width default 50;
    property Height default 20;
    property Direction: TArrowDir read FDirection write SetDirection
      default adRight;
    property ArrowHeight: Integer read FArrowHeight write SetArrowHeight
      default 10;
    property Filled: Boolean read FFilled write SetFilled default False;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property onArrowDblClick: TNotifyEvent
      read FArrowDblClick write FArrowDblClick;
  end;procedure Register;implementationuses
  DesignIntf;procedure Register;
begin
  RegisterComponents('Samples', [TdymLineControl]);
  //RegisterPropertyInCategory(TInputeCategory, TdymLineControl, 'OnArrowDblClick');
  //RegisterPropertyInCategory(TVisualCategory, TdymLineControl, 'Filled');
  //RegisterPropertyInCategory(TArrowCategory, TdymLineControl, 'Direction');
  //RegisterPropertyInCategory(TArrowCategory, TdymLineControl, 'ArrowHeight');
  //RegisterPropertyInCategory(TArrowCategory, TdymArrow, 'Filled');
end;{ TdymLineControl }constructor TdymLineControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDirection := adRight;
  Width := 50;
  Height := 20;
  FArrowHeight := 10;
  FFilled := False;  FPen := TPen.Create;
  FBrush := TBrush.Create;
  FPen.OnChange := RepaintRequest;
  FBrush.OnChange := RepaintRequest;
end;destructor TdymLineControl.Destroy;
begin
  FreeAndNil(FPen);
  FreeAndNil(FBrush);
  inherited;
end;// TODO -oDongYM -cNotCompleted:  CompleteMethod
procedure TdymLineControl.ComputePoints;
var
  iXCenter, iYCenter: Integer;
begin
  iXCenter := (Width - 1) div 2;
  iYCenter := (Height - 1) div 2;  case FDirection of
    adUp:
         begin
           FArrowPoints[0] := Point(0, FArrowHeight);
           FArrowPoints[1] := Point(iXCenter, 0);
           FArrowPoints[2] := Point(Width - 1, FArrowHeight);
           FArrowPoints[3] := FArrowPoints[0];
         end;
    adRight:
         begin
           FArrowPoints[0] := Point(Width - 1 - FArrowHeight, 0);
           FArrowPoints[1] := Point(Width - 1, iYCenter);
           FArrowPoints[2] := Point(Width - 1 - FArrowHeight, Height - 1);
           FArrowPoints[3] := FArrowPoints[0];
         end;
    adDown:
         // TODO -oDongYM -cToModify: ShouldBeModified
         begin
           FArrowPoints[0] := Point(Width - 1, Height - 1 -FArrowHeight);
           FArrowPoints[1] := Point(iXCenter, Height - 1);
           FArrowPoints[2] := Point(0, Height - 1 - FArrowHeight);
           FArrowPoints[3] := FArrowPoints[0];
         end;
    adLeft:
         begin
           FArrowPoints[0] := Point(Width - 1 - FArrowHeight, Height - 1);
           FArrowPoints[1] := Point(0, iYCenter);
           FArrowPoints[2] := Point(Width - 1 - FArrowHeight, 0);
           FArrowPoints[3] := FArrowPoints[0];
         end;
    end;
end;procedure TdymLineControl.SetArrowHeight(const Value: Integer);
begin
  if FArrowHeight <> Value then
  begin
    FArrowHeight := Value;
    ComputePoints;
    Invalidate;
  end;
end;procedure TdymLineControl.SetDirection(const Value: TArrowDir);
begin
  if FDirection <> Value then
  begin
    FDirection := Value;
    ComputePoints;
    Invalidate;
  end;
end;procedure TdymLineControl.SetFilled(const Value: Boolean);
begin
  if FFilled <> Value then
  begin
    FFilled := Value;
    ComputePoints;
    Invalidate;
  end;
end;procedure TdymLineControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  ComputePoints;
end;procedure TdymLineControl.Paint;
var
  iXCenter, iYCenter: Integer;
begin
  inherited;
  // computer the center
  iXCenter := (Width - 1) div 2;
  iYCenter := (Height - 1) div 2;  Canvas.Pen := FPen;
  Canvas.Brush := FBrush;
  // draw the arrow line
  case FDirection of
    adUp:
      begin
        Canvas.MoveTo(iXCenter, Height - 1);
        Canvas.LineTo(iXCenter, FArrowHeight);
      end;
    adRight:
      begin
        Canvas.MoveTo(0, iYCenter);
        Canvas.LineTo(Width - 1 - FArrowHeight, iYCenter);
      end;
    adDown:
      begin
        Canvas.MoveTo(iXCenter, 0);
        Canvas.LineTo(iXCenter, Height - 1 - FArrowHeight);
      end;
    adLeft:
      begin
        Canvas.MoveTo(Width - 1, iYCenter);
        Canvas.LineTo(FArrowHeight - 1, iYCenter);
      end;
  end;  // draw the arrow point, eventually filling it
  if FFilled then
    Canvas.Polygon(FArrowPoints)
  else
    Canvas.Polyline(FArrowPoints);
end;procedure TdymLineControl.SetBrush(const Value: TBrush);
begin
  FBrush.Assign(Value);
  Invalidate;
end;procedure TdymLineControl.SetPen(const Value: TPen);
begin
  FPen.Assign(Value);
  Invalidate;
end;procedure TdymLineControl.RepaintRequest(Sender: TObject);
begin
  Invalidate;
end;procedure TdymLineControl.ArrowDblClick;
begin
  if Assigned(FArrowDblClick) then
    FArrowDblClick(Self);
end;procedure TdymLineControl.WMLButtonDblClick(var Msg: TWMLButtonDblClk);
var
  HRegion: HRgn;
begin
  // perform default handling
  inherited;  // compute the arrowhead region
  HRegion := CreatePolygonRgn(FArrowDblClick, 3, WINDING);
  try
    // check whether the click took place in the region
    if PtInRegion(HRegion, Msg.XPos, Msg.YPos) then
      ArrowDblClick;
  finally
    DeleteObject(HRegion);
  end;
end;{ TArrowCategory }{
class function TArrowCategory.Description: string;
begin
  Result := 'Properties of the dymLineControl Arrow compenent';
end;
}{
class function TArrowCategory.Name: string;
begin
  Result := 'Arrow';
end;
}end.

Answer 2

shape据可以实现，调整一下宽度