圖形程序中的自定義線型

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 = class
private
 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 = class
private
 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;