图形程序中的自定义线型

GDI/GID+中提供的线型总是有限的，在一些行业应用领域，需要有非常专业的线型定义，如“铁路线”、“长城线”、“断崖”、“国界线”等，这就需要进行自定义的开发。

我的实现思路是：先制作一些线型的图元（图元就是线型的一个片断），矢量格式，然后用线型类来调用，重载系统的MoveTo和LineTo，调用时不用关心底层实现，只要设好线型类型就行。这样设计可以比较方便地实现自定义线型，不过在线型的转角和接缝处要精细处理，保证无缝接合另外专为制作图元开发了一套小工具。TGeoSequinType = (GeoNull,GeoPoint,GeoLine,GeoPoly,GeoEllipse);{ 每个线型中的基本组成单位，目前只有点、线、圆和多边形四个类型    每个Sequin有线颜色和填充颜色，无线宽和填充样式}TGeoSequin = class(TObject)private PtList : TList;      //包含PPoint类型 procedure DrawLine(Canvas: TCanvas;dX,dY: double;dSlope: double;dOffsetLength,dEndLength: double;nFlag : integer;nIndex: integer);     procedure DrawETOBLine(Canvas: TCanvas;dSeqX1,dSeqY1,dSlope:double;X,Y:double;CurX,CurY:double;nFlag:integer); procedure LineAll(Canvas:TCanvas;x0,y0,x1,y1:integer;cColor:TColor);  //Bresenham画线算法 procedure DrawPoly(Canvas: TCanvas;dX,dY: double;dSlope: double;dOffsetLength,dEndLength: double;nFlag : integer;nIndex: integer); procedure DrawPoint(Canvas: TCanvas;dX,dY: double;dSlope: double;dOffsetLength,dEndLength: double;nFlag : integer;nIndex: integer);     procedure DrawPolyWithClip(Canvas :TCanvas;dX,dY :double;dSlope :double;dOffsetLength,dEndLength :double;nFlag :integer;nIndex :integer);     procedure DrawLineWithClip(Canvas :TCanvas;dX,dY :double;dSlope :double;dOffsetLength,dEndLength :double;nFlag :integer;nIndex :integer);     procedure DrawTurnLine(Canvas :TCanvas;Pt1,Pt2,Pt3 :PPoint;dClipLength :double;nFlag :integer);public     Style : integer;      //1 - 成比例拉长； 2 -　保持原来的尺寸     SequinType : TGeoSequinType;  //线型类型，目前只有各GeoPoint,GeoLine,GeoPoly,GeoEllipse四种     LineColor,FillColor : TColor;     LineWidth : integer;    //缺省为１     CurPt : TPoint;      //用来连接下一点的当前结束点     TurnStyle : smallint ;     //Sequin拐角截断画法 0 - 两段都画;1 - 画前半截;2 - 画后半截;3 - 都不画;缺省为0     Length : integer ;     Height : integer ;     function PtCount : integer;     constructor Create;     destructor Destroy;override;     procedure Draw(Canvas: TCanvas;Sequin :TGeoSequin;LPtList :TList);     procedure DrawStretch(Canvas: TCanvas;Sequin: TGeoSequin;PtList: TList;dTotalLength: double);     procedure AddPt(Pt : PPoint);     procedure Assign(Sequin : TGeoSequin;LinePatternWidth : integer);end;{ 线型对象}TGeoLinePattern = classprivate SequinList : TList;    function GetLinePatternWidth: integer;    procedure SetLinePatternWidth(const Value: integer);public Size : TSize;    //Size.cx =  线段长度，Size.cy = 线段宽度 ID : LongWord; FLinePatternWidth : integer ; Name : string;     constructor Create;     destructor Destroy;override;     function SequinCount : integer;     procedure AddSequin(Sequin : TGeoSequin);     procedure Draw(PtList : TList;Canvas : TCanvas);     function GetLineLength(PtList : TList) : double;     procedure GetNextPt(X1,Y1 : integer;LineLength : integer;dSlope : double;var X,Y : integer);published property LinePatternWidth :integer read GetLinePatternWidth write SetLinePatternWidth default 1;end;TGeoLinesPatternCollections = classprivate LineList : TList;public constructor Create;     destructor Destroy; override; procedure LoadFromFile(FileName : string);     procedure AddLine(NewLine : TGeoLinePattern);     function GetLine(LineName : string):TGeoLinePattern; overload;     function GetLine(LineIndex : integer):TGeoLinePattern; overload;     function GetLineCount:integer;published property LineCount :integer read GetLineCount;end;TGeoLineComboBox = class(TCustomComboBox)private     FLineStyle : TPenStyle;     FMaxLineStyle: TPenStyle;     function GetLineStyle: TPenStyle;     procedure SetLineStyle(const Value: TPenStyle);     procedure SetMaxLineStyle(const Value: TPenStyle);public     GeoL : TGeoLinesPatternCollections;     GeoLineStyle : TList;     constructor Create(AOwner :TComponent); override;     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;     procedure Click; override;     procedure CreateWnd; override;published     property Color;     property Ctl3D;     property Enabled;     property Height default 23;     property ItemHeight default 17;     property LineStyle: TPenStyle read GetLineStyle write SetLineStyle             default psDot;     property MaxLineStyle: TPenStyle read FMaxLineStyle write SetMaxLineStyle             default psDashDotDot;     property ParentColor;     property ParentCtl3D;     property ParentShowHint;     property PopupMenu;     property ShowHint;     property TabOrder;     property TabStop;     property Visible;     property OnChange;     property OnClick;     property OnDblClick;     property OnDropDown;     property OnEndDrag;     property OnEnter;     property OnExit;     property OnKeyDown;     property OnKeyPress;     property OnKeyUp;end;