画箭头(50分)

  • 主题发起人 主题发起人 linhuiii
  • 开始时间 开始时间
L

linhuiii

Unregistered / Unconfirmed
GUEST, unregistred user!
有一条线段,它的长度和角度可任意变化,要在它的中间画一个实心的三角箭头(比较小)
有什么好的办法确定箭头的三个顶点坐标,另外点击鼠标怎么判断它是否在这个箭头内部。
 
首先你的箭头的尖点坐标应该会求吧?
既然长度是变化的,那么你的箭头的大小变不变呢?
随便怎么定个小角度都可以计算出另2点的坐标的。

得到3个点,创建一三角形区域,利用 PtInRegion 判断是否在箭头内部.
 
unit viArrow;

{

TviArrow and TviArrowEx
Version 1.0
by Ma Jun

email:junma@126.com
home page:http://go.163.com/~delphiws (in chinese)

You are free to use TviArrow and TviArrowEx for any purpose. If you do some
modification, please let me know.

}
interface

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

type TArrowPosition = (apLeft, apRight, apBoth);

type TArrowDirection = (adTopToTop, adTopToBottom, adBottomToTop, adBottomToBottom,
adLeftToLeft, adRightToRight);

type
TviArrow = class(TGraphicControl)
private
fLineWidth : Word; // 1 to ...
fArrowThicknessRate : Word; // 1 to ... 一般为奇数倍
fArrowHeadLengthRate: Word; // 1 to ...
fArrowPosition : TArrowPosition; // 箭头参数,是否两端有箭头
fArrowDirection : TArrowDirection; // 怎样利用矩形的四个端点确定箭头线的位置

fPoints: array[1..3] of TPoint; // 内部使用,箭头的三个点
fOnMouseEnter : TNotifyEvent;
fOnMouseLeave : TNotifyEvent;

procedure SetLineWidth( Value : word );
procedure SetArrowThicknessRate( Value : Word );
procedure SetArrowHeadLengthRate( Value : Word );
procedure SetArrowPosition ( Value : TArrowPosition );
procedure SetArrowDirection( Value : TArrowDirection );
procedure Paint; override;
protected
{ Protected declarations }
procedure DrawArrow(StartPoint, EndPoint, ArrowHead : TPoint; Reversed : Boolean); virtual;
// 开始、结束点定斜率,箭头点定位置,Reverse确定是否反转
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property LineWidth : Word read fLineWidth write SetLineWidth default 1;
property ThicknessRate : Word read fArrowThicknessRate write SetArrowThicknessRate default 3;
property HeadLengthRate : Word read fArrowHeadLengthRate write SetArrowHeadLengthRate default 2;
property ArrowPosition : TArrowPosition read fArrowPosition write SetArrowPosition;
property ArrowDirection : TArrowDirection read fArrowDirection write SetArrowDirection default adTopToBottom;
property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property Align;
property Color;
property ShowHint;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

type
TviArrowEx = class (TviArrow) //重载DrawArrow使对边画的方法移动到图形中央
private
protected
procedure DrawArrow(StartPoint, EndPoint, ArrowHead : TPoint; Reversed : Boolean); override;
public
end;

procedure Register;

implementation

constructor TviArrow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 100;
Height := 60;
Color := clBlack;
fLineWidth := 1;
fArrowThicknessRate := 10;
fArrowHeadLengthRate:= 2;
fArrowPosition := apBoth;
fArrowDirection := adTopToBottom;
end;

procedure TviArrow.SetLineWidth( Value : word );
begin
if Value>0 then
begin
fLineWidth := Value;
Invalidate;
end;
end;

procedure TviArrow.SetArrowThicknessRate( Value : Word );
begin
if Value>0 then
begin
fArrowThicknessRate := Value;
Invalidate;
end;
end;

procedure TviArrow.SetArrowHeadLengthRate( Value : Word );
begin
if Value>0 then
begin
fArrowHeadLengthRate := Value;
Invalidate;
end;
end;

procedure TviArrow.SetArrowPosition ( Value : TArrowPosition );
begin
fArrowPosition := Value;
Invalidate;
end;

procedure TviArrow.SetArrowDirection( Value : TArrowDirection );
begin
fArrowDirection := Value;
Invalidate;
end;

procedure TviArrow.CMMouseEnter(var Message: TMessage);
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TviArrow.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TviArrow.DrawArrow(StartPoint, EndPoint, ArrowHead : TPoint; Reversed : Boolean);
var
// 关于变量的定义参见说明
M, N, L, angleA, angleB : Double;
begin
//对效果不理想的进行微调, not standard
if fArrowDirection=adRightToRight then
begin
Dec(StartPoint.x);
Dec(EndPoint.x);
end;
if fArrowDirection=adBottomToBottom then
begin
Dec(StartPoint.y);
Dec(EndPoint.y);
end;

//计算数值
M := fLineWidth * fArrowThicknessRate;
L := M * fArrowHeadLengthRate;
N := sqrt( M * M / 4 + L * L );
if EndPoint.x<>StartPoint.x then angleA := Arctan((EndPoint.y - StartPoint.y)/(EndPoint.x - StartPoint.x))
else angleA := PI / 2;
angleB := Arctan( M / L / 2 );
// 如果需要反转,加3.1415
if Reversed then angleA := angleA - PI;
fPoints[1].x := ArrowHead.x;
fPoints[1].y := ArrowHead.y;
fPoints[2].x := ArrowHead.x + Round( N * cos( angleA + angleB ));
fPoints[2].y := ArrowHead.y + Round( N * sin( angleA + angleB ));
fPoints[3].x := ArrowHead.x + Round( N * cos( angleA - angleB ));
fPoints[3].y := ArrowHead.y + Round( N * sin( angleA - angleB ));
with Canvas do
begin
// 如果取两头都画箭头则画线在一次Paint中被调用两次
Pen.Width := fLineWidth;
Pen.Color := Color;
MoveTo( StartPoint.x, StartPoint.y);
LineTo( EndPoint.x, EndPoint.y);
// 显示箭头
Brush.Color := Color;
Polygon(fPoints);
end;
end;

procedure TviArrow.Paint;
begin
inherited Paint;
// 画箭头
with ClientRect do
begin
// 先显示连线
{ with Canvas do
begin
Pen.Width := fLineWidth;
Pen.Color := Color;
case fArrowDirection of
adTopToTop : begin
MoveTo( Left, Top );
LineTo( Right, Top);
end;
adTopToBottom : begin
MoveTo( Left, Top );
LineTo( Right, Bottom);
end;
adBottomToTop : begin
MoveTo( Left, Bottom );
LineTo( Right, Top);
end;
adBottomToBottom: begin
MoveTo( Left, Bottom-1 );
LineTo( Right, Bottom-1);
end;
adLeftToLeft : begin
MoveTo( Left, Top );
LineTo( Left, Bottom);
end;
adRightToRight : begin
MoveTo( Right-1, Top );
LineTo( Right-1, Bottom);
end;
end;
end;}

// 如果箭头在左边或两边都有,则显示左箭头,左箭头在显示时不反转
if (fArrowPosition=apLeft) or (fArrowPosition=apBoth) then
begin
case fArrowDirection of
adTopToTop : DrawArrow(TopLeft, Point( Right, Top), TopLeft, False);
adTopToBottom : DrawArrow(TopLeft, BottomRight, TopLeft, False);
adBottomToTop : DrawArrow(Point( Left, Bottom), Point( Right, Top),
Point( Left, Bottom), False);
adBottomToBottom: DrawArrow(Point(Left,Bottom), BottomRight,
Point(Left,Bottom), False);
adLeftToLeft : DrawArrow(TopLeft, Point(Left, Bottom),
TopLeft, False);
adRightToRight : DrawArrow(Point(Right,Top), BottomRight,
Point(Right,Top), False);
end;
end;

// 如果箭头在右边或两边都有,则显示右箭头
if (fArrowPosition=apRight) or (fArrowPosition=apBoth) then
begin
case fArrowDirection of
adTopToTop : DrawArrow(TopLeft, Point(Right,Top),
Point(Right,Top), True);
adTopToBottom : DrawArrow(TopLeft, BottomRight,
BottomRight, True);
adBottomToTop : DrawArrow(Point(Left,Bottom), Point(Right,Top),
Point(Right, Top), True);
adBottomToBottom: DrawArrow(Point(Left,Bottom), BottomRight,
BottomRight, True);
adLeftToLeft : DrawArrow(TopLeft, Point(Left, Bottom),
Point(Left, Bottom), True);
adRightToRight : DrawArrow(Point(Right,Top), BottomRight,
BottomRight, True);
end;
end;
end;
end;

// --------------------- TviArrowEx -----------------------
procedure TviArrowEx.DrawArrow(StartPoint, EndPoint, ArrowHead : TPoint; Reversed : Boolean);
begin
case ArrowDirection of
adTopToTop, adBottomToBottom : begin
StartPoint.y := Height div 2;
EndPoint.y := StartPoint.y;
ArrowHead.y := StartPoint.y;
end;
adLeftToLeft, adRightToRight : begin
StartPoint.x := Width div 2;
EndPoint.x := StartPoint.x;
ArrowHead.x := StartPoint.x;
end;
end;
inherited DrawArrow(StartPoint, EndPoint, ArrowHead ,Reversed);
end;

// -------------------- Register -------------------------
procedure Register;
begin
RegisterComponents('viPackEx', [TviArrow]);
RegisterComponents('viPackEx', [TviArrowEx]);
end;

end.

应该可以了吧!
 
晕倒!!!!画个箭头这么复杂?
 
如果直线角度改变了,箭头也应相应地改变才是!?
 
to::wk_knife
首先感谢你给我提供的控件,能不能告诉我参数M,L,N的意思以及确定原理
 
有一个简单一点的:不过是C的

void DrawArrow(CDC *pdc,CPoint m_One, CPoint m_Two)
{
double slopy , cosy , siny;
double Par = 10.0; //length of Arrow (>)
slopy = atan2( ( m_One.y - m_Two.y ),
( m_One.x - m_Two.x ) );
cosy = cos( slopy );
siny = sin( slopy ); //need math.h for these functions

//draw a line between the 2 endpoint
pdc->MoveTo( m_One );
pdc->LineTo( m_Two );

//here is the tough part - actually drawing the arrows
//a total of 6 lines drawn to make the arrow shape
pdc->MoveTo( m_One);
pdc->LineTo( m_One.x + int( - Par * cosy - ( Par / 2.0 * siny ) ),
m_One.y + int( - Par * siny + ( Par / 2.0 * cosy ) ) );
pdc->LineTo( m_One.x + int( - Par * cosy + ( Par / 2.0 * siny ) ),
m_One.y - int( Par / 2.0 * cosy + Par * siny ) );
pdc->LineTo( m_One );
/*/-------------similarly the the other end-------------/*/
pdc->MoveTo( m_Two );
pdc->LineTo( m_Two.x + int( Par * cosy - ( Par / 2.0 * siny ) ),
m_Two.y + int( Par * siny + ( Par / 2.0 * cosy ) ) );
pdc->LineTo( m_Two.x + int( Par * cosy + Par / 2.0 * siny ),
m_Two.y - int( Par / 2.0 * cosy - Par * siny ) );
pdc->LineTo( m_Two );

}

 
小箭头
大学问
 
多人接受答案了。
 
后退
顶部