Delphi指针样式控件代码

郑重感谢：本文代码来自Delphi盒子用户janker (janker)，谢谢janker (janker)对Delphi社区做出的奉献！欢迎加入Delphi开发局QQ群:32422310 Delphi控件源码下载网站

unit FMX.JKArrows;interfaceusesSystem.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.Objects, FMX.Graphics;typeTJKArrowDirect = (Up, Right,  Down, Left);TJKArrowKind = (FillArrow, SingleArrow,  DoubleArrow, DoubleArrowNotTail);TJKArrow = class(TShape)privateFArrowKind: TJKArrowKind;FPath: TPathData;FLinePoints: array of TPointF;FTwoLineInterval: Single;FTailLineLongPer: Single;FTailLineInterval: Single;FTailLineWidthPer: Single;FLineOffsetPer: Single;FArrowDirect: TJKArrowDirect;function GetLinePoints: Integer;procedure DrawFillArrow;procedure DrawLineArrow;procedure SetTailLineLongPer(const Value: Single);procedure SetTailLineInterval(const Value: Single);procedure SetTwoLineInterval(const Value: Single);procedure SetTailLineWidthPer(const Value: Single);procedure SetArrowKind(const Value: TJKArrowKind);procedure SetLineOffsetPer(const Value: Single);procedure SetArrowDirect(const Value: TJKArrowDirect);protectedprocedure CreatePath;procedure ReSize; override;procedure Paint; override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;publishedproperty Align;property Anchors;property ClipChildren default False;property ClipParent default False;property Cursor default crDefault;property DragMode default TDragMode.dmManual;property EnableDragHighlight default True;property Enabled default True;property Fill;property Locked default False;property Height;property HitTest default True;property Padding;property Opacity;property Margins;property PopupMenu;property Position;property RotationAngle;property RotationCenter;property Scale;property Size;property Stroke;property Visible default True;property Width;property ArrowKind: TJKArrowKind read FArrowKind write SetArrowKind default TJKArrowKind.FillArrow;property ArrowDirect: TJKArrowDirect read FArrowDirect write SetArrowDirect;//FillArrowproperty TailLineLongPer: Single read FTailLineLongPer write SetTailLineLongPer;property TailLineWidthPer: Single read FTailLineWidthPer write SetTailLineWidthPer;//LineArrowproperty LineOffsetPer: Single read FLineOffsetPer write SetLineOffsetPer;property TwoLineInterval: Single read FTwoLineInterval write SetTwoLineInterval;property TailLineInterval: Single read FTailLineInterval write SetTailLineInterval;{Drag and Drop events}property OnDragEnter;property OnDragLeave;property OnDragOver;property OnDragDrop;property OnDragEnd;{Mouse events}property OnClick;property OnDblClick;property OnMouseDown;property OnMouseMove;property OnMouseUp;property OnMouseWheel;property OnMouseEnter;property OnMouseLeave;property OnPainting;property OnPaint;property OnResize;property OnResized;end;procedure Register;implementationprocedure Register;
beginRegisterComponents('JkFMXControl', [TJKArrow]);
end;{ TJKArrow }constructor TJKArrow.Create(AOwner: TComponent);
begininherited;FArrowKind := TJKArrowKind.FillArrow;FPath := TPathData.Create;Width := 100;Height := 100;RotationCenter.X := 0.5;RotationCenter.Y := 0.5;FTailLineLongPer := 0.6;FTailLineWidthPer := 0.2;FLineOffsetPer := 0.4;FTailLineInterval := 0;FTwoLineInterval := 10;
end;destructor TJKArrow.Destroy;
beginFPath.DisposeOf;inherited;
end;function TJKArrow.GetLinePoints: Integer;
varaPoint: TPointF;aTailLineLong: Single;aTailLineWidth: Single;aLineOffset: Single;
begincase FArrowKind ofFillArrow:begincase FArrowDirect ofTJKArrowDirect.Up, TJKArrowDirect.Down:beginaTailLineLong := ShapeRect.Height * FTailLineLongPer;aTailLineWidth := ShapeRect.Width * FTailLineWidthPer;end;TJKArrowDirect.Right, TJKArrowDirect.Left:beginaTailLineLong := ShapeRect.Width * FTailLineLongPer;aTailLineWidth := ShapeRect.Height * FTailLineWidthPer;end;
//        Down:
//        begin
//          aTailLineLong := ShapeRect.Height * FTailLineLongPer;
//          aTailLineWidth := ShapeRect.Width * FTailLineWidthPer;
//        end;
//        Left:
//        begin
//          aTailLineLong := ShapeRect.Width * FTailLineLongPer;
//          aTailLineWidth := ShapeRect.Height * FTailLineWidthPer;
//        end;end;if FTailLineLongPer < 0.15 thenbeginResult := 3;SetLength(FLinePoints, 3);case FArrowDirect ofTJKArrowDirect.Up:beginaPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[2] := aPoint;end;TJKArrowDirect.Right:beginaPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[2] := aPoint;end;TJKArrowDirect.Down:beginaPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[2] := aPoint;end;TJKArrowDirect.Left:beginaPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top+ ShapeRect.Height / 2;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[2] := aPoint;end;end;endelsebeginResult := 7;SetLength(FLinePoints, 7);case FArrowDirect ofTJKArrowDirect.Up:beginaPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height - aTailLineLong;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[0].Y;FLinePoints[2] := aPoint;aPoint.X := ShapeRect.Left + (ShapeRect.Width + aTailLineWidth) / 2;aPoint.Y := FLinePoints[2].Y;FLinePoints[3] := aPoint;aPoint.X := FLinePoints[3].X;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[4] := aPoint;aPoint.X := ShapeRect.Left + (ShapeRect.Width - aTailLineWidth) / 2;aPoint.Y := FLinePoints[4].Y;FLinePoints[5] := aPoint;aPoint.X := FLinePoints[5].X;aPoint.Y := FLinePoints[0].Y;FLinePoints[6] := aPoint;end;TJKArrowDirect.Right:beginaPoint.X := ShapeRect.Left + aTailLineLong;aPoint.Y := ShapeRect.Top;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left+ ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top+ ShapeRect.Height;FLinePoints[2] := aPoint;aPoint.X := FLinePoints[2].X;aPoint.Y := ShapeRect.Top + (ShapeRect.Height + aTailLineWidth) / 2;FLinePoints[3] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[3].Y;FLinePoints[4] := aPoint;aPoint.X := FLinePoints[4].X;aPoint.Y := ShapeRect.Top + (ShapeRect.Height - aTailLineWidth) / 2;FLinePoints[5] := aPoint;aPoint.X := FLinePoints[0].X;aPoint.Y := FLinePoints[5].Y;FLinePoints[6] := aPoint;end;TJKArrowDirect.Down:beginaPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top +  aTailLineLong;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[1] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[0].Y;FLinePoints[2] := aPoint;aPoint.X := ShapeRect.Left + (ShapeRect.Width - aTailLineWidth) / 2;aPoint.Y := FLinePoints[2].Y;FLinePoints[3] := aPoint;aPoint.X := FLinePoints[3].X;aPoint.Y := ShapeRect.Top;FLinePoints[4] := aPoint;aPoint.X := ShapeRect.Left + (ShapeRect.Width + aTailLineWidth) / 2;aPoint.Y := FLinePoints[4].Y;FLinePoints[5] := aPoint;aPoint.X := FLinePoints[5].X;aPoint.Y := FLinePoints[0].Y;FLinePoints[6] := aPoint;end;TJKArrowDirect.Left:beginaPoint.X := ShapeRect.Left + ShapeRect.Width - aTailLineLong;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top;FLinePoints[2] := aPoint;aPoint.X := FLinePoints[2].X;aPoint.Y := ShapeRect.Top + (ShapeRect.Height - aTailLineWidth) / 2;FLinePoints[3] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[3].Y;FLinePoints[4] := aPoint;aPoint.X := FLinePoints[4].X;aPoint.Y := ShapeRect.Top + (ShapeRect.Height + aTailLineWidth) / 2;FLinePoints[5] := aPoint;aPoint.X := FLinePoints[0].X;aPoint.Y := FLinePoints[5].Y;FLinePoints[6] := aPoint;end;end;end;end;SingleArrow:beginResult := 6;SetLength(FLinePoints, 6);case FArrowDirect ofTJKArrowDirect.Up:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top +  aLineOffset;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[1].X;FLinePoints[4].Y := FLinePoints[1].Y + FTailLineInterval;aPoint.X := FLinePoints[4].X;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[5] := aPoint;end;TJKArrowDirect.Right:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset;aPoint.Y := ShapeRect.Top;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[1].X - FTailLineInterval;FLinePoints[4].Y := FLinePoints[1].Y;aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[4].Y;FLinePoints[5] := aPoint;end;TJKArrowDirect.Down:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[1].X;FLinePoints[4].Y := FLinePoints[1].Y - FTailLineInterval;aPoint.X := FLinePoints[4].X;aPoint.Y := ShapeRect.Top;FLinePoints[5] := aPoint;end;TJKArrowDirect.Left:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + aLineOffset;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[1].X + FTailLineInterval;FLinePoints[4].Y := FLinePoints[1].Y;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[4].Y;FLinePoints[5] := aPoint;end;end;end;DoubleArrow:beginResult := 10;SetLength(FLinePoints, 10);case FArrowDirect ofTJKArrowDirect.Up:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + aLineOffset;if aPoint.Y > ShapeRect.Height - FTwoLineInterval thenaPoint.Y := ShapeRect.Height - FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X;FLinePoints[4].Y := FLinePoints[0].Y + FTwoLineInterval;FLinePoints[5].X := FLinePoints[1].X;FLinePoints[5].Y := FLinePoints[1].Y + FTwoLineInterval;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X;FLinePoints[7].Y := FLinePoints[3].Y + FTwoLineInterval;FLinePoints[8].X := FLinePoints[5].X;FLinePoints[8].Y := FLinePoints[5].Y + FTailLineInterval;FLinePoints[9].X := FLinePoints[8].X;FLinePoints[9].Y := ShapeRect.Top + ShapeRect.Height;end;TJKArrowDirect.Right:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset;aPoint.Y := ShapeRect.Top;if aPoint.X < ShapeRect.Left + FTwoLineInterval thenaPoint.X := ShapeRect.Left + FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X - FTwoLineInterval;FLinePoints[4].Y := FLinePoints[0].Y;FLinePoints[5].X := FLinePoints[1].X - FTwoLineInterval;FLinePoints[5].Y := FLinePoints[1].Y;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X - FTwoLineInterval;FLinePoints[7].Y := FLinePoints[3].Y;FLinePoints[8].X := FLinePoints[5].X - FTailLineInterval;FLinePoints[8].Y := FLinePoints[5].Y;FLinePoints[9].X := ShapeRect.Left;FLinePoints[9].Y := FLinePoints[8].Y ;end;TJKArrowDirect.Down:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset;if aPoint.Y < ShapeRect.Top + FTwoLineInterval thenaPoint.Y := ShapeRect.Top + FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X;FLinePoints[4].Y := FLinePoints[0].Y - FTwoLineInterval;FLinePoints[5].X := FLinePoints[1].X;FLinePoints[5].Y := FLinePoints[1].Y - FTwoLineInterval;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X;FLinePoints[7].Y := FLinePoints[3].Y - FTwoLineInterval;FLinePoints[8].X := FLinePoints[5].X;FLinePoints[8].Y := FLinePoints[5].Y - FTailLineInterval;FLinePoints[9].X := FLinePoints[8].X;FLinePoints[9].Y := ShapeRect.Top;end;TJKArrowDirect.Left:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + aLineOffset;aPoint.Y := ShapeRect.Top + ShapeRect.Height;if aPoint.X > ShapeRect.Width - FTwoLineInterval thenaPoint.X := ShapeRect.Width - FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X + FTwoLineInterval;FLinePoints[4].Y := FLinePoints[0].Y;FLinePoints[5].X := FLinePoints[1].X + FTwoLineInterval;FLinePoints[5].Y := FLinePoints[1].Y;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X + FTwoLineInterval;FLinePoints[7].Y := FLinePoints[3].Y;FLinePoints[8].X := FLinePoints[5].X + FTailLineInterval;FLinePoints[8].Y := FLinePoints[5].Y;FLinePoints[9].X := ShapeRect.Left + ShapeRect.Width;FLinePoints[9].Y := FLinePoints[8].Y ;end;end;end;DoubleArrowNotTail:beginResult := 8;SetLength(FLinePoints, 8);case FArrowDirect ofTJKArrowDirect.Up:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + aLineOffset;if aPoint.Y > ShapeRect.Height - FTwoLineInterval thenaPoint.Y := ShapeRect.Height - FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X;FLinePoints[4].Y := FLinePoints[0].Y + FTwoLineInterval;FLinePoints[5].X := FLinePoints[1].X;FLinePoints[5].Y := FLinePoints[1].Y + FTwoLineInterval;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X;FLinePoints[7].Y := FLinePoints[3].Y + FTwoLineInterval;end;TJKArrowDirect.Right:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset;aPoint.Y := ShapeRect.Top;if aPoint.X < ShapeRect.Left + FTwoLineInterval thenaPoint.X := ShapeRect.Left + FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X - FTwoLineInterval;FLinePoints[4].Y := FLinePoints[0].Y;FLinePoints[5].X := FLinePoints[1].X - FTwoLineInterval;FLinePoints[5].Y := FLinePoints[1].Y;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X - FTwoLineInterval;FLinePoints[7].Y := FLinePoints[3].Y;end;TJKArrowDirect.Down:beginaLineOffset := ShapeRect.Height * FLineOffsetPer;aPoint.X := ShapeRect.Left + ShapeRect.Width;aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset;if aPoint.Y < ShapeRect.Top + FTwoLineInterval thenaPoint.Y := ShapeRect.Top + FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left + ShapeRect.Width / 2;aPoint.Y := ShapeRect.Top + ShapeRect.Height;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := ShapeRect.Left;aPoint.Y := FLinePoints[0].Y;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X;FLinePoints[4].Y := FLinePoints[0].Y - FTwoLineInterval;FLinePoints[5].X := FLinePoints[1].X;FLinePoints[5].Y := FLinePoints[1].Y - FTwoLineInterval;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X;FLinePoints[7].Y := FLinePoints[3].Y - FTwoLineInterval;end;TJKArrowDirect.Left:beginaLineOffset := ShapeRect.Width * FLineOffsetPer;aPoint.X := ShapeRect.Left + aLineOffset;aPoint.Y := ShapeRect.Top + ShapeRect.Height;if aPoint.X > ShapeRect.Width - FTwoLineInterval thenaPoint.X := ShapeRect.Width - FTwoLineInterval;FLinePoints[0] := aPoint;aPoint.X := ShapeRect.Left;aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2;FLinePoints[1] := aPoint;FLinePoints[2] := FLinePoints[1];aPoint.X := FLinePoints[0].X;aPoint.Y := ShapeRect.Top;FLinePoints[3] := aPoint;FLinePoints[4].X := FLinePoints[0].X + FTwoLineInterval;FLinePoints[4].Y := FLinePoints[0].Y;FLinePoints[5].X := FLinePoints[1].X + FTwoLineInterval;FLinePoints[5].Y := FLinePoints[1].Y;FLinePoints[6] := FLinePoints[5];FLinePoints[7].X := FLinePoints[3].X + FTwoLineInterval;FLinePoints[7].Y := FLinePoints[3].Y;end;end;end;end;
end;procedure TJKArrow.CreatePath;
vari: Integer;aPointCount: Integer;
beginFPath.Clear;aPointCount := GetLinePoints;FPath.MoveTo(FLinePoints[0]);for i := 1 to aPointCount - 1 doFPath.LineTo(FLinePoints[i]);FPath.ClosePath;
end;procedure TJKArrow.DrawFillArrow;
beginCreatePath;Canvas.FillPath(FPath, Opacity, Fill);Canvas.DrawPath(FPath, Opacity, Stroke);
end;procedure TJKArrow.DrawLineArrow;
vari: Integer;aLineCount: Integer;
beginaLineCount := GetLinePoints div 2;for i := 0 to aLineCount - 1 doCanvas.DrawLine(FLinePoints[i*2], FLinePoints[i*2+1], Opacity, Stroke);
end;procedure TJKArrow.Paint;
begininherited;if FArrowKind = TJKArrowKind.FillArrow thenbeginDrawFillArrow;endelsebeginDrawLineArrow;end;
end;procedure TJKArrow.ReSize;
begininherited;end;procedure TJKArrow.SetArrowDirect(const Value: TJKArrowDirect);
beginif FArrowDirect <> Value thenbeginFArrowDirect := Value;Repaint;end;
end;procedure TJKArrow.SetArrowKind(const Value: TJKArrowKind);
beginif FArrowKind <> Value thenbeginFArrowKind := Value;Repaint;end;
end;procedure TJKArrow.SetTailLineLongPer(const Value: Single);
varaNewValue: Single;
beginif FArrowKind <> TJKArrowKind.FillArrow thenExit;aNewValue := Value;if Value > 0.8 thenaNewValue := 0.8;if Value < 0.1 thenaNewValue := 0;if FTailLineLongPer <> aNewValue thenbeginFTailLineLongPer := aNewValue;Repaint;end;
end;procedure TJKArrow.SetTailLineWidthPer(const Value: Single);
varaNewValue: Single;
beginif FArrowKind <> TJKArrowKind.FillArrow thenExit;aNewValue := Value;if Value > 0.8 thenaNewValue := 0.8;if Value < 0.1 thenaNewValue := 0.1;if FTailLineWidthPer <> aNewValue thenbeginFTailLineWidthPer := aNewValue;Repaint;end;
end;procedure TJKArrow.SetLineOffsetPer(const Value: Single);
varaNewValue: Single;
beginif FArrowKind = TJKArrowKind.FillArrow thenExit;aNewValue := Value;if Value > 0.8 thenaNewValue := 0.8;if Value < 0.2 thenaNewValue := 0.2;if FLineOffsetPer <> aNewValue thenbeginFLineOffsetPer := aNewValue;Repaint;end;
end;procedure TJKArrow.SetTailLineInterval(const Value: Single);
varaNewValue: Single;
beginif FArrowKind = TJKArrowKind.FillArrow thenExit;aNewValue := Value;if aNewValue > ShapeRect.Height * 0.2 thenaNewValue := ShapeRect.Height * 0.2;if aNewValue < 0 thenaNewValue := 0;if FTailLineInterval <> aNewValue thenbeginFTailLineInterval := aNewValue;Repaint;end;
end;procedure TJKArrow.SetTwoLineInterval(const Value: Single);
varaNewValue: Single;
beginif FArrowKind = TJKArrowKind.FillArrow thenExit;aNewValue := Value;if aNewValue > ShapeRect.Height * 0.25 thenaNewValue := ShapeRect.Height * 0.25;if aNewValue < 5 thenaNewValue := 5;if FTwoLineInterval <> aNewValue thenbeginFTwoLineInterval := aNewValue;Repaint;end;
end;end.

Delphi指针样式控件代码相关推荐

android 电量控件,Android实现显示电量的控件代码
下面介绍了Android实现显示电量的控件代码,具体代码如下: 1.目录结构,本人是使用安卓死丢丢. 2.运行界面,输入框中输入数值,点击刷新,会再电池中显示出相应的电量 3.绘制自定义电池控件,首先 ...
Delphi XE2 新控件布局Panel TGridPanel TFlowPanel
Delphi XE2 新控件 Firemonkey 布局Panel Windows平台VCl TGridPanel TFlowPanel FMX 跨平台 TLayout TGridLayout TFl ...
0811-按钮操作（加法计算器）（拖控件找控件代码属性名称）（frame center bounds）（上下左右移动button图片）...
-------------------- 加法计算器实现步骤 1.拖控件改textField键盘属性为numberPad ,label双击修改名称自动缩小尺寸改属性名称不会改尺寸, 放 ...
SAP屏幕设计器专题：编写控件代码（三）
上一篇博文我只是画了一个屏幕,一个外壳而已,真正要实现我们需要的功能还需要写相应的代码. 输入SE51,打开我们的例子程序,切换到"流程逻辑",默认的屏幕代码如下图所示: 第一个P ...
Delphi常用通讯控件的应用札记
Delphi常用通讯控件的应用札记 1.SPComm串口控件 2.TClientSocket
delphi使用第三方控件
第三方控件安装时必须把所有的pas,dcu,dpk,res等文件复制到你的Lib目录下然后通过dpk进行安装安装后会多出来新的控件面板,新控件就在那里了当然也有一些控件会安装到原有的面板上比如 ...
Delphi利用MSCOMM控件进行GPS数据采集
1.准备 GPS(Global Positioning System),即全球定位系统,利用GPS卫星的测距和测时功能进行全球定位,在许多系统中,如机场导航系统,出租车辆管理和调度系统.江河流域的灾害 ...
Delphi 7皮肤控件VCLSkin 5 60的使用
分享一下我老师大神的人工智能教程!零基础,通俗易懂!http://blog.csdn.net/jiangjunshow 也欢迎大家转载本篇文章.分享知识,造福人民,实现我们中华民族伟大复兴! VCLS ...
delphi中webbrowse控件中模拟点击文本超链接_功能测试——控件测试
对于单个逻辑功能,测试工程师需要关注其是否正确实现了需求定义的功能性需求,并需明确该需求是否确实应该在需求中体现. 例如,登陆功能,需关注其能否正确实现合法数据能够登陆,而非法数据拒绝登陆.商品查询功 ...

Delphi指针样式控件代码

Delphi指针样式控件代码相关推荐

最新文章

热门文章