GXS.MeshLines.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996
  1. //
  2. // The graphics engine GLXEngine. The unit of GXScene for Delphi
  3. //
  4. unit GXS.MeshLines;
  5. (* Line implementation by means of a Triangle strip *)
  6. interface
  7. uses
  8. Winapi.OpenGL,
  9. System.Classes,
  10. System.SysUtils,
  11. Stage.VectorTypes,
  12. Stage.VectorGeometry,
  13. GXS.VectorLists,
  14. Stage.Spline,
  15. GXS.Scene,
  16. GXS.Objects,
  17. GXS.Texture,
  18. GXS.VectorFileObjects,
  19. GXS.Coordinates,
  20. GXS.Context,
  21. GXS.Material,
  22. GXS.Color,
  23. GXS.State,
  24. GXS.Nodes,
  25. GXS.RenderContextInfo;
  26. type
  27. // Specialized Node for use in a TgxLines objects. Adds a Width property
  28. TLineNode = class(TgxNode)
  29. private
  30. FData: Pointer;
  31. protected
  32. public
  33. constructor Create(Collection : TCollection); override;
  34. destructor Destroy; override;
  35. procedure Assign(Source: TPersistent); override;
  36. property Data: Pointer read FData write FData;
  37. published
  38. end;
  39. { Specialized collection for Nodes in TgxMeshLines objects.
  40. Stores TLineNode items. }
  41. TLineNodes = class(TgxNodes)
  42. public
  43. constructor Create(AOwner : TComponent); overload;
  44. destructor destroy; override;
  45. procedure NotifyChange; override;
  46. function IndexOf(LineNode: TLineNode): Integer;
  47. end;
  48. TLineItem = class(TCollectionItem)
  49. private
  50. FName: String;
  51. FBreakAngle: Single;
  52. FDivision: Integer;
  53. FNodes: TLineNodes;
  54. FSplineMode: TgxLineSplineMode;
  55. FTextureLength: Single;
  56. FWidth: Single;
  57. FTextureCorrection: Boolean;
  58. FHide: Boolean;
  59. FData: Pointer;
  60. procedure SetHide(const Value: Boolean);
  61. procedure SetTextureCorrection(const Value: Boolean);
  62. procedure SetBreakAngle(const Value: Single);
  63. procedure SetDivision(const Value: Integer);
  64. procedure SetNodes(const Value: TLineNodes);
  65. procedure SetSplineMode(const Value:TgxLineSplineMode);
  66. procedure SetTextureLength(const Value: Single);
  67. procedure SetWidth(const Value: Single);
  68. protected
  69. procedure DoChanged; virtual;
  70. public
  71. property Data: Pointer read FData write FData;
  72. published
  73. constructor Create(Collection: TCollection); override;
  74. destructor Destroy; override;
  75. property Hide: Boolean read FHide write SetHide;
  76. property Name: String read FName write FName;
  77. property TextureCorrection: Boolean read FTextureCorrection write SetTextureCorrection;
  78. property BreakAngle: Single read FBreakAngle write SetBreakAngle;
  79. property Division: Integer read FDivision write SetDivision;
  80. property Nodes : TLineNodes read FNodes write SetNodes;
  81. property SplineMode: TgxLineSplineMode read FSplineMode write SetSplineMode;
  82. property TextureLength: Single read FTextureLength write SetTextureLength;
  83. property Width: Single read FWidth write SetWidth;
  84. end;
  85. TLineCollection = class(TOwnedCollection)
  86. private
  87. procedure SetItems(Index: Integer; const Val: TLineItem);
  88. function GetItems(Index: Integer): TLineItem;
  89. protected
  90. public
  91. function Add: TLineItem; overload;
  92. function Add(Name: String): TLineItem; overload;
  93. property Items[Index: Integer]: TLineItem read GetItems write SetItems; default;
  94. published
  95. end;
  96. TLightmapBounds = class(TgxCustomCoordinates)
  97. private
  98. function GetLeft: Single;
  99. function GetTop: Single;
  100. function GetRight: Single;
  101. function GetBottom: Single;
  102. function GetWidth: Single;
  103. function GetHeight: Single;
  104. procedure SetLeft(const value: Single);
  105. procedure SetTop(const value: Single);
  106. procedure SetRight(const value: Single);
  107. procedure SetBottom(const value: Single);
  108. published
  109. property Left: Single read GetLeft write SetLeft stored False;
  110. property Top: Single read GetTop write SetTop stored False;
  111. property Right: Single read GetRight write SetRight stored False;
  112. property Bottom: Single read GetBottom write SetBottom stored False;
  113. property Width: Single read GetWidth;
  114. property Height: Single read GetHeight;
  115. end;
  116. TgxMeshLines = class(TgxFreeForm)
  117. private
  118. FLines: TLineCollection;
  119. FMesh: TgxMeshObject;
  120. FLightmapBounds: TLightmapBounds;
  121. FLightmapIndex: Integer;
  122. FLightmapMaterialName: String;
  123. FFaceGroup: TgxFGVertexIndexList;
  124. FIndex: Integer;
  125. FNoZWrite: boolean;
  126. FShowNodes: Boolean;
  127. FUpdating: Integer;
  128. FSelectedLineItem: TLineItem;
  129. FSelectedNode: TLineNode;
  130. FNode1,FNode2: TLineNode;
  131. function GetUpdating: Boolean;
  132. function PointNearLine(const LineItem: TLineItem; const X,Z: Single; Tolerance: single = 1): boolean;
  133. function PointNearSegment(const StartNode, EndNode: TLineNode; const X,Z: Single; LineWidth: single; Tolerance: single = 1): boolean;
  134. procedure StitchStrips(idx: TgxIntegerList);
  135. procedure AddStitchMarker(idx: TgxIntegerList);
  136. procedure SetShowNodes(const Value: Boolean);
  137. procedure SetNoZWrite(const Value: Boolean);
  138. procedure SetLightmapIndex(const value: Integer);
  139. procedure SetLightmapMaterialName(const value: String);
  140. procedure SetLightmapBounds(const value: TLightmapBounds);
  141. procedure DoChanged;
  142. procedure AddIndex;
  143. procedure AddVertices(Up, Inner, Outer: TAffineVector; S: Single; Correction: Single; UseDegenerate: Boolean; LineItem: TLineItem);
  144. procedure BuildLineItem(LineItem: TLineItem);
  145. procedure BuildGeometry;
  146. procedure DrawNode(var rci : TgxRenderContextInfo; Node: TLineNode; LineWidth: Single);
  147. procedure DrawCircle(Radius: Single);
  148. function SelectNode(LineItem: TLineItem; X,Z: Single):TLineNode;
  149. protected
  150. procedure Loaded; override;
  151. public
  152. procedure BeginUpdate;
  153. procedure EndUpdate;
  154. procedure Clear;
  155. function SelectLineItem(const X,Z: Single; Tolerance: single = 1): TLineItem; overload;
  156. function SelectLineItem(LineItem: TLineItem): TLineItem; overload;
  157. function SelectLineItem(LineNode: TLineNode): TLineItem; overload;
  158. procedure DeselectLineItem;
  159. procedure DeselectLineNode;
  160. procedure BuildList(var rci : TgxRenderContextInfo); override;
  161. procedure DoRender(var rci : TgxRenderContextInfo; renderSelf, renderChildren : Boolean); override;
  162. procedure NotifyChange(Sender : TObject); override;
  163. property SelectedLineItem: TLineItem read FSelectedLineItem;
  164. property SelectedNode: TLineNode read FSelectedNode;
  165. property Node1: TLineNode read FNode1;
  166. property Node2: TLineNode read FNode2;
  167. published
  168. constructor Create(AOwner: TComponent); override;
  169. destructor Destroy; override;
  170. property Updating: Boolean Read GetUpdating;
  171. property Lines: TLineCollection read FLines;
  172. property Material;
  173. property LightmapBounds: TLightmapBounds read FLightmapBounds write SetLightmapBounds;
  174. property LightmapIndex: Integer read FLightmapIndex write SetLightmapIndex;
  175. property LightmapMaterialName: String read FLightmapMaterialName write SetLightmapMaterialName;
  176. property NoZWrite: boolean read FNoZWrite write SetNoZWrite;
  177. property ShowNodes: Boolean read FSHowNodes write SetShowNodes;
  178. end;
  179. //--------------------------------------------------------------------------
  180. implementation
  181. //--------------------------------------------------------------------------
  182. const
  183. CIRCLESEGMENTS = 32;
  184. constructor TLineNode.Create(Collection : TCollection);
  185. begin
  186. inherited Create(Collection);
  187. end;
  188. destructor TLineNode.Destroy;
  189. begin
  190. inherited Destroy;
  191. end;
  192. procedure TLineNode.Assign(Source: TPersistent);
  193. begin
  194. if Source is TLineNode then
  195. begin
  196. FData := TLineNode(Source).FData;
  197. end;
  198. inherited;
  199. end;
  200. constructor TLineNodes.Create(AOwner : TComponent);
  201. begin
  202. inherited Create(AOwner, TLineNode);
  203. end;
  204. destructor TLineNodes.destroy;
  205. begin
  206. inherited;
  207. end;
  208. procedure TLineNodes.NotifyChange;
  209. begin
  210. if (GetOwner<>nil) then
  211. TgxMeshLines((GetOwner as TLineItem).Collection.Owner).StructureChanged;
  212. end;
  213. function TLineNodes.IndexOf(LineNode: TLineNode): Integer;
  214. var
  215. i: Integer;
  216. begin
  217. result := -1;
  218. if assigned(LineNode) then
  219. begin
  220. for i := 0 to Count - 1 do
  221. begin
  222. if LineNode = Items[i] then
  223. begin
  224. Result := i;
  225. break;
  226. end;
  227. end;
  228. end;
  229. end;
  230. function TLineCollection.GetItems(index: Integer): TLineItem;
  231. begin
  232. Result:=TLineItem(inherited Items[index]);
  233. end;
  234. procedure TLineCollection.SetItems(index: Integer; const val: TLineItem);
  235. begin
  236. inherited Items[index]:=val;
  237. end;
  238. function TLineCollection.Add: TLineItem;
  239. begin
  240. result := TLineItem.Create(self);
  241. end;
  242. function TLineCollection.Add(Name: String): TLineItem;
  243. begin
  244. Result := Add;
  245. Result.Name := Name;
  246. end;
  247. constructor TLineItem.Create(Collection: TCollection);
  248. begin
  249. inherited;
  250. FNodes:=TLineNodes.Create(Self, TLineNode);
  251. FBreakAngle := 30;
  252. FDivision := 10;
  253. FSplineMode := lsmLines;
  254. FTextureLength := 1;
  255. FWidth := 1;
  256. FTextureCorrection := False;
  257. end;
  258. destructor TLineItem.Destroy;
  259. begin
  260. if TgxMeshLines(Collection.Owner).SelectedLineItem = self then
  261. TgxMeshLines(Collection.Owner).DeSelectLineItem;
  262. FNodes.Free;
  263. inherited;
  264. end;
  265. procedure TLineItem.SetHide(const Value: Boolean);
  266. begin
  267. FHide := Value;
  268. DoChanged;
  269. end;
  270. procedure TLineItem.SetTextureCorrection(const Value: Boolean);
  271. begin
  272. FTextureCorrection := Value;
  273. DoChanged;
  274. end;
  275. procedure TLineItem.SetBreakAngle(const Value: Single);
  276. begin
  277. FBreakAngle := Value;
  278. DoChanged;
  279. end;
  280. procedure TLineItem.SetDivision(const Value: Integer);
  281. begin
  282. FDivision := Value;
  283. DoChanged;
  284. end;
  285. procedure TLineItem.SetNodes(const Value: TLineNodes);
  286. begin
  287. FNodes.Assign(Value);
  288. DoChanged;
  289. end;
  290. procedure TLineItem.SetSplineMode(const Value:TgxLineSplineMode);
  291. begin
  292. FSplineMode := Value;
  293. DoChanged;
  294. end;
  295. procedure TLineItem.SetTextureLength(const Value: Single);
  296. begin
  297. FTextureLength := Value;
  298. DoChanged;
  299. end;
  300. procedure TLineItem.SetWidth(const Value: Single);
  301. begin
  302. FWidth := Value;
  303. DoChanged;
  304. end;
  305. procedure TLineItem.DoChanged;
  306. begin
  307. //Notify parent of change because the mesh needs to be regenerated
  308. if (GetOwner<>nil) then
  309. TgxMeshLines(Collection.Owner).NotifyChange(Self);
  310. end;
  311. //--------------------------------
  312. { TLightmapBounds }
  313. //--------------------------------
  314. function TLightmapBounds.GetLeft: Single;
  315. begin
  316. Result := X;
  317. end;
  318. function TLightmapBounds.GetTop: Single;
  319. begin
  320. Result := Y;
  321. end;
  322. function TLightmapBounds.GetRight: Single;
  323. begin
  324. Result := Z;
  325. end;
  326. function TLightmapBounds.GetBottom: Single;
  327. begin
  328. Result := W;
  329. end;
  330. function TLightmapBounds.GetWidth: Single;
  331. begin
  332. Result := Z - X;
  333. end;
  334. function TLightmapBounds.GetHeight: Single;
  335. begin
  336. Result := W - Y;
  337. end;
  338. procedure TLightmapBounds.SetLeft(const value: Single);
  339. begin
  340. X := Value;
  341. end;
  342. procedure TLightmapBounds.SetTop(const value: Single);
  343. begin
  344. Y := Value;
  345. end;
  346. procedure TLightmapBounds.SetRight(const value: Single);
  347. begin
  348. Z := Value;
  349. end;
  350. procedure TLightmapBounds.SetBottom(const value: Single);
  351. begin
  352. W := Value;
  353. end;
  354. //--------------------------------
  355. // TgxMeshLine
  356. //--------------------------------
  357. constructor TgxMeshLines.Create(AOwner: TComponent);
  358. begin
  359. inherited;
  360. FLines := TLineCollection.Create(self,TLineItem);
  361. FLightmapBounds := TLightmapBounds.Create(Self);
  362. end;
  363. destructor TgxMeshLines.Destroy;
  364. begin
  365. FLines.Free;
  366. FLightmapBounds.Free;
  367. inherited;
  368. end;
  369. procedure TgxMeshLines.Loaded;
  370. begin
  371. DoChanged;
  372. end;
  373. procedure TgxMeshLines.BeginUpdate;
  374. begin
  375. inc(FUpdating);
  376. end;
  377. procedure TgxMeshLines.EndUpdate;
  378. begin
  379. Dec(FUpdating);
  380. if FUpdating < 1 then
  381. begin
  382. FUpdating := 0;
  383. DoChanged;
  384. end;
  385. end;
  386. procedure TgxMeshLines.Clear;
  387. begin
  388. FSelectedLineItem := nil;
  389. FSelectedNode := nil;
  390. FLines.Clear;
  391. MeshObjects.Clear;
  392. StructureChanged;
  393. end;
  394. procedure TgxMeshLines.BuildList(var rci : TgxRenderContextInfo);
  395. var
  396. i,j: Integer;
  397. begin
  398. inherited;
  399. if FShowNodes then
  400. begin
  401. for i:= 0 to Lines.Count - 1 do
  402. begin
  403. if Lines[i] = FSelectedLineItem then
  404. begin
  405. for j := 0 to Lines[i].Nodes.Count-1 do
  406. DrawNode(rci, TLineNode(Lines[i].Nodes[j]),Lines[i].Width);
  407. end;
  408. end;
  409. end;
  410. end;
  411. procedure TgxMeshLines.DoRender(var rci : TgxRenderContextInfo; renderSelf, renderChildren : Boolean);
  412. begin
  413. if FNoZWrite then
  414. begin
  415. glDisable(GL_Depth_Test);
  416. inherited;
  417. glEnable(GL_Depth_Test);
  418. end
  419. else
  420. inherited;
  421. end;
  422. procedure TgxMeshLines.SetShowNodes(const Value: Boolean);
  423. begin
  424. FShowNodes := Value;
  425. DoChanged;
  426. end;
  427. procedure TgxMeshLines.SetNoZWrite(const Value: Boolean);
  428. begin
  429. FNoZWrite := Value;
  430. DoChanged;
  431. end;
  432. procedure TgxMeshLines.SetLightmapIndex(const value: Integer);
  433. begin
  434. FLightmapIndex := Value;
  435. DoChanged;
  436. end;
  437. procedure TgxMeshLines.SetLightmapMaterialName(const value: String);
  438. var
  439. lLibMaterial: TgxLibMaterial;
  440. begin
  441. if Value <> '' then
  442. begin
  443. if assigned(LightmapLibrary) then
  444. begin
  445. lLibMaterial := LightmapLibrary.Materials.GetLibMaterialByName(Value);
  446. if assigned(lLibMaterial) then
  447. begin
  448. FLightmapIndex := lLibMaterial.ID;
  449. FLightmapMaterialName := Value;
  450. DoChanged;
  451. end;
  452. end;
  453. end;
  454. end;
  455. procedure TgxMeshLines.SetLightmapBounds( const value: TLightmapBounds );
  456. begin
  457. FLightmapBounds.SetVector(value.X, value.Y,value.Z,value.W);
  458. DoChanged;
  459. end;
  460. procedure TgxMeshLines.DoChanged;
  461. begin
  462. if Updating then exit;
  463. BuildGeometry;
  464. StructureChanged;
  465. end;
  466. procedure TgxMeshLines.BuildGeometry;
  467. var
  468. i: Integer;
  469. lFirstLineDone: Boolean;
  470. lVertex: TAffineVector;
  471. lTextPoint: TTexPoint;
  472. begin
  473. if Updating then exit;
  474. //clear the mesh
  475. FMeshObjects.Clear;
  476. lFirstLineDone := False;
  477. FMesh := TgxMeshObject.CreateOwned(FMeshObjects);
  478. FMesh.Mode := momFaceGroups;
  479. FFaceGroup := TgxFGVertexIndexList.CreateOwned(FMesh.FaceGroups);
  480. FFaceGroup.Mode := fgmmTriangleStrip;
  481. FFaceGroup.LightMapIndex := FLightmapIndex;
  482. FIndex := 0;
  483. for i := 0 to Lines.Count - 1 do
  484. begin
  485. if not FLines.Items[i].Hide then
  486. begin
  487. if lFirstLineDone then
  488. AddStitchMarker(FFaceGroup.VertexIndices);
  489. if TLineItem(FLines.Items[i]).Nodes.Count > 0 then
  490. begin
  491. BuildLineItem(TLineItem(FLines.Items[i]));
  492. lFirstLineDone := True;
  493. end;
  494. end;
  495. end;
  496. StitchStrips(FFaceGroup.VertexIndices);
  497. //Calculate lightmapping
  498. if assigned(LightmapLibrary) and (LightmapIndex <> -1 ) then
  499. for i := 0 to FMesh.Vertices.Count - 1 do
  500. begin
  501. lVertex := FMesh.Vertices.Items[i];
  502. lTextPoint.s := (lVertex.X - FLightmapBounds.Left) / FLightmapBounds.Width;
  503. lTextPoint.t := (lVertex.Z - FLightmapBounds.Top) / FLightmapBounds.Height;
  504. FMesh.LightMapTexCoords.Add(lTextPoint);
  505. end;
  506. end;
  507. procedure TgxMeshLines.DrawNode(var rci : TgxRenderContextInfo; Node: TLineNode; LineWidth: Single);
  508. var
  509. lNodeSize: Single;
  510. begin
  511. lNodeSize := LineWidth* 0.7;
  512. glPushMatrix;
  513. glTranslatef(Node.x,Node.y,Node.z);
  514. if lNodeSize <>1 then
  515. begin
  516. glPushMatrix;
  517. glScalef(lNodeSize, lNodeSize, lNodeSize);
  518. /// rci.gxStates.UnSetVxState(stTexture2D);
  519. rci.gxStates.UnSetVXState(stColorMaterial);
  520. rci.gxStates.UnSetVXState(stBlend);
  521. if Node = FSelectedNode then
  522. rci.gxStates.SetMaterialColors(cmFRONT, clrBlack, clrGray20, clrYellow, clrBlack, 0)
  523. else
  524. rci.gxStates.SetMaterialColors(cmFRONT, clrBlack, clrGray20, clrGreen, clrBlack, 0);
  525. DrawCircle(lNodeSize);
  526. glPopMatrix;
  527. end
  528. else
  529. begin
  530. if Node = FSelectedNode then
  531. rci.gxStates.SetMaterialColors(cmFRONT, clrBlack, clrGray20, clrYellow, clrBlack, 0)
  532. else
  533. rci.gxStates.SetMaterialColors(cmFRONT, clrBlack, clrGray20, clrGreen, clrBlack, 0);
  534. DrawCircle(lNodeSize);
  535. end;
  536. glPopMatrix;
  537. end;
  538. procedure TgxMeshLines.DrawCircle(Radius: Single);
  539. var
  540. inner,outer,p1,p2: TVector4f;
  541. i: Integer;
  542. a: Single;
  543. lUp: TAffineVector;
  544. begin
  545. inner := VectorMake(1, 0, 0);
  546. outer := VectorMake(1.3, 0, 0);
  547. glBegin(GL_TRIANGLE_STRIP);
  548. for i:= 0 to CIRCLESEGMENTS do
  549. begin
  550. a := i * 2 * pi / CIRCLESEGMENTS;
  551. p1 := outer;
  552. p2 := inner;
  553. lUp := Up.AsAffineVector;
  554. RotateVector(p1,lUp, a);
  555. RotateVector(p2,lUp, a);
  556. glVertex3fv(@p1.X);
  557. glVertex3fv(@p2.X);
  558. end;
  559. glEnd();
  560. end;
  561. function TgxMeshLines.SelectNode(LineItem: TLineItem; X,Z: Single): TLineNode;
  562. var
  563. i: Integer;
  564. lRange: Single;
  565. length: single;
  566. begin
  567. Result := nil;
  568. lRange := LineItem.Width * 0.88;
  569. for i := 0 to LineItem.Nodes.count - 1 do
  570. begin
  571. length := 1/RLength((X - LineItem.Nodes[i].X),(Z - LineItem.Nodes[i].Z));
  572. if length < lRange then
  573. begin
  574. Result := TLineNode(LineItem.Nodes[i]);
  575. Break;
  576. end;
  577. end;
  578. end;
  579. function TgxMeshLines.SelectLineItem(LineItem: TLineItem): TLineItem;
  580. begin
  581. Result := nil;
  582. FSelectedLineItem := LineItem;
  583. FSelectedNode := nil;
  584. DoChanged;
  585. end;
  586. function TgxMeshLines.SelectLineItem(LineNode: TLineNode): TLineItem;
  587. begin
  588. FSelectedLineItem := TLineItem(LineNode.Collection.Owner);
  589. FSelectedNode := LineNode;
  590. Result := FSelectedLineItem;
  591. DoChanged;
  592. end;
  593. procedure TgxMeshLines.DeselectLineItem;
  594. begin
  595. FSelectedLineItem := nil;
  596. FSelectedNode := nil;
  597. DoChanged;
  598. end;
  599. procedure TgxMeshLines.DeselectLineNode;
  600. begin
  601. FSelectedNode := nil;
  602. DoChanged;
  603. end;
  604. function TgxMeshLines.SelectLineItem(const X,Z: Single; Tolerance: single = 1): TLineItem;
  605. var
  606. i: Integer;
  607. lStartPoint: Integer;
  608. lNode: TLineNode;
  609. lNodeWasSelected: Boolean;
  610. begin
  611. Result := nil;
  612. if assigned(FSelectedLineItem) and not lNodeWasSelected then
  613. lStartPoint := FSelectedLineItem.ID + 1
  614. else
  615. lStartPoint := 0;
  616. for i := lStartPoint to FLines.Count - 1 do
  617. begin
  618. if (FLines[i] <> FSelectedLineItem) or lNodeWasSelected then
  619. begin
  620. if PointNearLine(FLines[i],X,Z,Tolerance) then
  621. begin
  622. Result := FLines[i];
  623. lNode := SelectNode(FLines[i], X,Z);
  624. if lNode <> FSelectedNode then
  625. begin
  626. FSelectedNode := lNode;
  627. end;
  628. break;
  629. end;
  630. end;
  631. end;
  632. if not assigned(Result) then
  633. begin
  634. for i := 0 to lStartPoint - 1 do
  635. begin
  636. if FLines[i] <> FSelectedLineItem then
  637. begin
  638. if PointNearLine(FLines[i],X,Z,Tolerance) then
  639. begin
  640. Result := FLines[i];
  641. break;
  642. end;
  643. end;
  644. end;
  645. end;
  646. FSelectedLineItem := Result;
  647. if not assigned(FSelectedLineItem) then
  648. begin
  649. FSelectedNode := nil;
  650. FNode1 := nil;
  651. FNode2 := nil;
  652. end;
  653. DoChanged;
  654. end;
  655. function TgxMeshLines.GetUpdating: Boolean;
  656. begin
  657. Result := FUpdating > 0;
  658. end;
  659. function TgxMeshLines.PointNearLine(const LineItem: TLineItem; const X,Z: Single; Tolerance: single = 1): boolean;
  660. var
  661. i: Integer;
  662. lStartNode,lEndNode: TLineNode;
  663. begin
  664. Result := False;
  665. for i := 0 to LineItem.Nodes.Count - 2 do
  666. begin
  667. lStartNode := TLineNode(LineItem.Nodes[i]);
  668. lEndNode := TLineNode(LineItem.Nodes[i+1]);
  669. if PointNearSegment(lStartNode,lEndNode,X,Z,LineItem.Width,Tolerance) then
  670. begin
  671. Result := True;
  672. FNode1 := lStartNode;
  673. FNode2 := lEndNode;
  674. break;
  675. end;
  676. end;
  677. end;
  678. function TgxMeshLines.PointNearSegment(const StartNode, EndNode: TLineNode; const X,Z: Single; LineWidth: single; Tolerance: single = 1): boolean;
  679. var
  680. xt, yt, u, len: single;
  681. xp, yp: single;
  682. lDist: Single;
  683. begin
  684. result:= false;
  685. lDist := (LineWidth/2) * Tolerance;
  686. xt:= EndNode.X - StartNode.X;
  687. yt:= EndNode.Z - StartNode.Z;
  688. len:= sqrt(xt*xt + yt*yt);
  689. xp:= (X - StartNode.X);
  690. yp:= (Z - StartNode.Z);
  691. u:= (xp * xt + yp * yt) / len;
  692. // point beyond line
  693. if (u < -lDist) or (u > len+lDist) then
  694. exit;
  695. u:= u / len;
  696. // get the point on the line that's pependicular to the point in question
  697. xt:= StartNode.X + xt * u;
  698. yt:= StartNode.Z + yt * u;
  699. // find the distance to the line, and see if it's closer than the specified distance
  700. result:= sqrt(sqr(xt - X) + sqr(yt - Z)) <= lDist;
  701. end;
  702. procedure TgxMeshLines.StitchStrips(idx: TgxIntegerList);
  703. var
  704. i: integer;
  705. i0, i1, i2: integer;
  706. begin
  707. for i := idx.Count - 1 downto 0 do
  708. begin
  709. if idx[i] = -1 then
  710. begin
  711. i0:= idx[i-1];
  712. i1:= idx[i+4];
  713. i2:= idx[i+5];
  714. idx[i]:= i0;
  715. idx[i+1]:= i1;
  716. idx[i+2]:= i1;
  717. idx[i+3]:= i2;
  718. end;
  719. end;
  720. end;
  721. procedure TgxMeshLines.AddStitchMarker(idx: TgxIntegerList);
  722. begin
  723. idx.Add(-1);
  724. idx.Add(-2);
  725. idx.Add(-2);
  726. idx.Add(-2);
  727. end;
  728. procedure TgxMeshLines.NotifyChange(Sender : TObject);
  729. begin
  730. inherited;
  731. DoChanged;
  732. end;
  733. procedure TgxMeshLines.AddIndex;
  734. begin
  735. FFaceGroup.Add(FIndex);
  736. inc(FIndex);
  737. end;
  738. procedure TgxMeshLines.AddVertices(Up,Inner,Outer: TAffineVector; S: Single; Correction: Single; UseDegenerate: Boolean; LineItem: TLineItem);
  739. begin
  740. if not LineItem.TextureCorrection then
  741. Correction := 0
  742. else
  743. Correction := Correction / (LineItem.TextureLength / LineItem.width);
  744. FMesh.Normals.Add(Up);
  745. FMesh.Vertices.Add(Outer);
  746. FMesh.TexCoords.Add(S-Correction,1);
  747. AddIndex;
  748. FMesh.Normals.Add(Up);
  749. FMesh.TexCoords.Add(S+Correction,0);
  750. FMesh.Vertices.Add(Inner);
  751. AddIndex;
  752. if LineItem.TextureCorrection then
  753. begin
  754. FMesh.Normals.Add(Up);
  755. FMesh.Vertices.Add(Outer);
  756. FMesh.TexCoords.Add(S+Correction,1);
  757. AddIndex;
  758. FMesh.Normals.Add(Up);
  759. FMesh.TexCoords.Add(S-Correction,0);
  760. FMesh.Vertices.Add(Inner);
  761. AddIndex;
  762. end;
  763. end;
  764. procedure TgxMeshLines.BuildLineItem(LineItem: TLineItem);
  765. var
  766. Seg1: TAffineVector;
  767. Seg2: TAffineVector;
  768. NSeg1: TAffineVector;
  769. NSeg2: TAffineVector;
  770. N1,N2,N3: TAffineVector;
  771. Inner: TAffineVector;
  772. Outer: TAffineVector;
  773. lUp: TAffineVector;
  774. lAngle: Single;
  775. lAngleOffset: Single;
  776. lTotalAngleChange: Single;
  777. lBreakAngle: Single;
  778. i: Integer;
  779. Flip: Boolean;
  780. s: single;
  781. lSpline: TCubicSpline;
  782. lCount: Integer;
  783. f : Single;
  784. a, b, c : Single;
  785. lHalfLineWidth: single;
  786. begin
  787. inherited;
  788. lTotalAngleChange := 0;
  789. lHalfLineWidth := LineItem.Width/2;
  790. lBreakAngle := DegToRadian(LineItem.BreakAngle);
  791. try
  792. N1 := AffineVectorMake(0,0,0);
  793. N2 := AffineVectorMake(0,0,0);
  794. N3 := AffineVectorMake(0,0,0);
  795. s:= 0;
  796. f := 0;
  797. lSpline := nil;
  798. lUp := Up.AsAffineVector;
  799. lCount := 0;
  800. if LineItem.SplineMode = lsmLines then
  801. lCount := LineItem.Nodes.Count - 1
  802. else
  803. if LineItem.Nodes.Count > 1 then
  804. begin
  805. lCount := (LineItem.Nodes.Count-1) * LineItem.Division;
  806. lSpline := LineItem.Nodes.CreateNewCubicSpline;
  807. f:=1/LineItem.Division;
  808. end;
  809. for i := 0 to lCount do
  810. begin
  811. if LineItem.SplineMode = lsmLines then
  812. begin
  813. N3 := LineItem.Nodes.Items[i].AsAffineVector
  814. end
  815. else
  816. begin
  817. if lCount > 1 then
  818. begin
  819. lSpline.SplineXYZ(i*f, a, b, c);
  820. N3 := AffineVectorMake(a,b,c);
  821. end;
  822. end;
  823. if i > 0 then
  824. begin
  825. Seg1 := Seg2;
  826. Seg2 := VectorSubtract(N3,N2);
  827. end;
  828. if (i = 1) and not VectorEQuals(Seg2,NullVector)then
  829. begin
  830. //Create start vertices
  831. //this makes the assumption that these vectors are different which not always true
  832. Inner := VectorCrossProduct(Seg2, lUp);
  833. NormalizeVector(Inner);
  834. ScaleVector(Inner,lHalfLineWidth);
  835. Outer := VectorNegate(Inner);
  836. AddVector(Inner,N2);
  837. AddVector(Outer,N2);
  838. AddVertices(lUp,Inner, Outer,S,0,False,LineItem);
  839. s := s + VectorLength(Seg2)/LineItem.TextureLength;
  840. end;
  841. if i > 1 then
  842. begin
  843. lUp := VectorCrossProduct(Seg2,Seg1);
  844. if VectorEquals(lUp, NullVector) then
  845. lUp := Up.AsAffineVector;
  846. Flip := VectorAngleCosine(lUp,Self.up.AsAffineVector) < 0;
  847. if Flip then
  848. NegateVector(lUp);
  849. NSeg1 := VectorNormalize(Seg1);
  850. NSeg2 := VectorNormalize(Seg2);
  851. if VectorEquals(NSeg1,NSeg2) then
  852. begin
  853. Inner := VectorCrossProduct(Seg2, lUp);
  854. lAngle := 0;
  855. end
  856. else
  857. begin
  858. Inner := VectorSubtract(NSeg2,NSeg1);
  859. lAngle := (1.5707963 - ArcCosine(VectorLength(Inner)/2));
  860. end;
  861. lTotalAngleChange := lTotalAngleChange + (lAngle * 2);
  862. //Create intermediate vertices
  863. if (lTotalAngleChange > lBreakAngle) or (LineItem.BreakAngle = -1 )then
  864. begin
  865. lTotalAngleChange := 0;
  866. //Correct width for angles less than 170
  867. if lAngle < 1.52 then
  868. lAngleOffset := lHalfLineWidth * sqrt(sqr(Tangent(lAngle))+1)
  869. else
  870. lAngleOffset := lHalfLineWidth;
  871. NormalizeVector(Inner);
  872. ScaleVector(Inner,lAngleOffset);
  873. Outer := VectorNegate(Inner);
  874. AddVector(Inner,N2);
  875. AddVector(Outer,N2);
  876. if not Flip then
  877. AddVertices(lUp,Inner, Outer,S,-Tangent(lAngle)/2,True, LineItem)
  878. else
  879. AddVertices(lUp,Outer, Inner,S,Tangent(lAngle)/2,True, LineItem);
  880. end;
  881. s:= s + VectorLength(seg2)/LineItem.TextureLength;
  882. end;
  883. //Create last vertices
  884. if (lCount > 0) and (i = lCount) and not VectorEQuals(Seg2,NullVector) then
  885. begin
  886. lUp := Up.AsAffineVector;
  887. Inner := VectorCrossProduct(Seg2, lUp);
  888. NormalizeVector(Inner);
  889. ScaleVector(Inner,lHalfLineWidth);
  890. Outer := VectorNegate(Inner);
  891. AddVector(Inner,N3);
  892. AddVector(Outer,N3);
  893. AddVertices(lUp,Inner, Outer,S,0,False, LineItem);
  894. end;
  895. N1 := N2;
  896. N2 := N3;
  897. end;
  898. except
  899. on e: Exception do
  900. raise exception.Create(e.Message);
  901. end;
  902. if assigned(lSpline) then
  903. lSpline.Free;
  904. end;
  905. //--------------------------------
  906. initialization
  907. //--------------------------------
  908. RegisterClasses([TgxMeshLines]);
  909. end.