2
0

GLS.GizmoEx.pas 134 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521
  1. //
  2. // The multimedia graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.GizmoEx;
  5. (*
  6. Invisible component for helping to Move, Rotate and Scale an Object
  7. under GLScene (usefull for an Editor).
  8. This is an enhanced version of TGLGizmo
  9. *)
  10. interface
  11. {$I GLScene.inc}
  12. uses
  13. Winapi.OpenGL,
  14. Winapi.Windows,
  15. System.Classes,
  16. System.SysUtils,
  17. System.Types,
  18. Vcl.StdCtrls,
  19. GLS.Scene,
  20. GLS.Color,
  21. GLS.Objects,
  22. GLS.VectorGeometry,
  23. GLS.Material,
  24. GLS.Strings,
  25. GLS.GeomObjects,
  26. GLS.BitmapFont,
  27. GLS.SceneViewer,
  28. GLS.VectorFileObjects,
  29. GLS.Coordinates,
  30. GLS.RenderContextInfo,
  31. GLS.GeometryBB,
  32. GLS.VectorTypes,
  33. GLS.Canvas,
  34. GLS.PersistentClasses,
  35. GLS.Screen,
  36. GLS.State,
  37. GLS.Selection;
  38. type
  39. TGLGizmoExObjectCollection = class;
  40. TGLGizmoEx = class;
  41. TGLGizmoExObjectItem = class(TCollectionItem)
  42. private
  43. FOldAutoScaling: TGLVector;
  44. FEffectedObject: TGLBaseSceneObject;
  45. FParentOldObject: TGLBaseSceneObject;
  46. FIndexOldObject: Integer;
  47. FNameOldObject: string;
  48. FReturnObject: Boolean;
  49. FOldMatrix: TGLMatrix;
  50. FGizmoTmpRoot: TGLBaseSceneObject;
  51. procedure SetEffectedObject(const Value: TGLBaseSceneObject);
  52. procedure SetOldMatrix(const Value: TGLMatrix);
  53. protected
  54. procedure DoUndo;
  55. function GetParent: TGLGizmoExObjectCollection;
  56. function GetGizmo: TGLGizmoEx;
  57. public
  58. property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write FGizmoTmpRoot;
  59. constructor Create(AOwner: TCollection); override;
  60. destructor Destroy; override;
  61. procedure Notification(AComponent: TComponent; Operation: TOperation); virtual;
  62. procedure AssignFromObject(const AObject: TGLBaseSceneObject; AssignAndRemoveObj: Boolean = False);
  63. // TODO: create a special type for Matrix.
  64. property OldMatrix: TGLMatrix read FOldMatrix write SetOldMatrix;
  65. published
  66. property EffectedObject: TGLBaseSceneobject read FEffectedObject write SetEffectedObject;
  67. end;
  68. TGLGizmoExObjectCollection = class(TOwnedCollection)
  69. private
  70. function GetItems(const Index: Integer): TGLGizmoExObjectItem;
  71. procedure SetItems(const Index: Integer; const Value: TGLGizmoExObjectItem);
  72. protected
  73. function GetParent: TGLGizmoEx;
  74. procedure DoUndo;
  75. public
  76. procedure Notification(AComponent: TComponent; Operation: TOperation);
  77. procedure RemoveByObject(const AObject: TGLCustomSceneObject);
  78. function Add: TGLGizmoExObjectItem;
  79. property Items[const Index: Integer]: TGLGizmoExObjectItem read GetItems write SetItems; default;
  80. end;
  81. TGLGizmoExActionHistoryItem = class(TCollectionItem)
  82. private
  83. FObject: TObject;
  84. FGizmoObjectCollection: TGLGizmoExObjectCollection;
  85. procedure SetObject(aValue: TObject);
  86. procedure SetGizmoObjectCollection(aValue: TGLGizmoExObjectCollection);
  87. public
  88. constructor Create(AOwner: TCollection); override;
  89. destructor Destroy; override;
  90. property BaseObject: TObject read FObject write SetObject;
  91. property GizmoObjectCollection: TGLGizmoExObjectCollection read FGizmoObjectCollection write SetGizmoObjectCollection;
  92. end;
  93. TGLGizmoExActionHistoryCollection = class(TOwnedCollection)
  94. private
  95. FItemIndex: Integer;
  96. FItemsMaxCount: Integer;
  97. FGizmoTmpRoot: TGLBaseSceneObject;
  98. function GetItems(const Index: Integer): TGLGizmoExActionHistoryItem;
  99. procedure SetItems(const Index: Integer; const Value: TGLGizmoExActionHistoryItem);
  100. function Add: TGLGizmoExActionHistoryItem;
  101. public
  102. constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  103. procedure Notification(AComponent: TComponent; Operation: TOperation);
  104. property ItemIndex: Integer read FItemIndex write FItemIndex;
  105. function Undo: TGLGizmoExActionHistoryItem;
  106. function Redo: TGLGizmoExActionHistoryItem;
  107. procedure AddObjects(objs: TGLPickList);
  108. procedure AddObject(obj: TObject);
  109. procedure RemoveObjects(objs: TGLPickList);
  110. property MaxCount: Integer read FItemsMaxCount write FItemsMaxCount;
  111. property Items[const Index: Integer]: TGLGizmoExActionHistoryItem read GetItems write SetItems; default;
  112. property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write FGizmoTmpRoot;
  113. end;
  114. TGLGizmoExVisibleInfoLabel = (vliName, vliOperation, vliCoords);
  115. TGLGizmoExVisibleInfoLabels = set of TGLGizmoExVisibleInfoLabel;
  116. TInfoLabelCoordType = (ilcChanging, ilcChangeRate);
  117. TGLGizmoExAxis = (gaNone, gaX, gaY, gaZ, gaXY, gaXZ, gaYZ, gaXYZ);
  118. TGLGizmoExSelectionRegion = (gsrRectangular, gsrCircular, gsrFence,
  119. gsrLasso);
  120. TGLGizmoExReferenceCoordinateSystem = (rcsView, rcsLocal);
  121. TGLGizmoExSelRec = array of TPoint;
  122. TGLGizmoExOperation = (gopMove, gopRotate, gopScale, gopNone);
  123. TGLGizmoExOperationMode = (gomNone, gomSelect, gomMove, gomRotate, gomScale);
  124. TGLGizmoExAcceptEvent = procedure(Sender: TObject; var objs: TGLPickList) of object;
  125. TGLGizmoExAxisSelected = procedure(Sender: TObject; var Axis: TGLGizmoExAxis) of object;
  126. TGLGizmoExPickMode = (pmGetPickedObjects, pmRayCast);
  127. //Gizmo objects
  128. TGLGizmoExUIFrustrum = class(TGLFrustrum)
  129. private
  130. FNoZWrite: Boolean;
  131. public
  132. constructor Create(AOwner: TComponent); override;
  133. procedure BuildList(var rci: TGLRenderContextInfo); override;
  134. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  135. end;
  136. TGLGizmoExUISphere = class(TGLSphere)
  137. private
  138. FNoZWrite: Boolean;
  139. public
  140. constructor Create(AOwner: TComponent); override;
  141. procedure BuildList(var rci: TGLRenderContextInfo); override;
  142. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  143. end;
  144. TGLGizmoExUIDisk = class(TGLDisk)
  145. private
  146. FNoZWrite: Boolean;
  147. public
  148. constructor Create(AOwner: TComponent); override;
  149. procedure BuildList(var rci: TGLRenderContextInfo); override;
  150. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  151. end;
  152. TGLGizmoExUITorus = class(TGLTorus)
  153. private
  154. FNoZWrite: Boolean;
  155. public
  156. constructor Create(AOwner: TComponent); override;
  157. procedure BuildList(var rci: TGLRenderContextInfo); override;
  158. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  159. end;
  160. TGLGizmoExUIPolygon = class(TGLPolygon)
  161. private
  162. FNoZWrite: Boolean;
  163. public
  164. constructor Create(AOwner: TComponent); override;
  165. procedure BuildList(var rci: TGLRenderContextInfo); override;
  166. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  167. end;
  168. TGLGizmoExUIArrowLine = class(TGLArrowLine)
  169. private
  170. FNoZWrite: Boolean;
  171. public
  172. constructor Create(AOwner: TComponent); override;
  173. procedure BuildList(var rci: TGLRenderContextInfo); override;
  174. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  175. end;
  176. TGLGizmoExUILines = class(TGLLines)
  177. private
  178. FNoZWrite: Boolean;
  179. public
  180. constructor Create(AOwner: TComponent); override;
  181. procedure BuildList(var rci: TGLRenderContextInfo); override;
  182. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  183. end;
  184. TGLGizmoExUIFlatText = class(TGLFlatText)
  185. private
  186. FNoZWrite: Boolean;
  187. public
  188. constructor Create(AOwner: TComponent); override;
  189. procedure BuildList(var rci: TGLRenderContextInfo); override;
  190. property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
  191. end;
  192. TGLGizmoEx = class(TComponent)
  193. private
  194. FUIBaseGizmo: TGLBaseSceneObject;
  195. FUIRootHelpers: TGLBaseSceneObject;
  196. FUIRootSelect: TGLBaseSceneObject; // for None
  197. FUIRootMovement: TGLBaseSceneObject; // for Move
  198. FUIRootRotate: TGLBaseSceneObject; //for Rotate
  199. FUIRootRotateAxisLabel: TGLBaseSceneObject;
  200. FUIRootScale: TGLBaseSceneObject; // for Scale
  201. FUIRootAxisLabel: TGLBaseSceneObject;
  202. FUIRootVisibleInfoLabels: TGLBaseSceneObject;
  203. FInterfaceRender: TGLDirectOpenGL;
  204. FInternalRender: TGLDirectOpenGL;
  205. FUISelectLineX, FUISelectLineY, FUISelectLineZ: TGLGizmoExUILines; // For None (Select)
  206. //IC- Invisible Control
  207. //For Move
  208. FUIICMovementLineX, FUIICMovementLineY, FUIICMovementLineZ, FUIICMovementLineXY, FUIICMovementLineXZ, FUIICMovementLineYZ: TGLGizmoExUIFrustrum;
  209. FUIMovementArrowX, FUIMovementArrowY, FUIMovementArrowZ: TGLGizmoExUIArrowLine; // For Move
  210. FUIMovementLineX, FUIMovementLineY, FUIMovementLineZ, FUIMovementLineXY, FUIMovementLineXZ, FUIMovementLineYZ: TGLGizmoExUILines; // For Move
  211. FUIMovementPlaneXY, FUIMovementPlaneXZ, FUIMovementPlaneYZ: TGLGizmoExUIPolyGon; // For Move
  212. //ForRotate
  213. FUIRotateLineX, FUIRotateLineY, FUIRotateLineZ, FUIRotateLineXY, FUIRotateLineXZ: TGLGizmoExUILines;
  214. FUIICRotateTorusX, FUIICRotateTorusY, FUIICRotateTorusZ, FUIICRotateTorusXZ: TGLGizmoExUITorus; // For Rotate
  215. FUIRotateDiskXY, FUIRotateDiskX, FUIRotateDiskX2, FUIRotateDiskY, FUIRotateDiskY2, FUIRotateDiskZ, FUIRotateDiskZ2: TGLGizmoExUIDisk;
  216. FUIRotateLineArrowX, FUIRotateLineArrowY, FUIRotateLineArrowZ: TGLGizmoExUILines;
  217. FUIICRotateSphereXY: TGLGizmoExUISphere;
  218. FUIRotateAxisLabelX, FUIRotateAxisLabelY, FUIRotateAxisLabelZ: TGLGizmoExUIFlatText;
  219. //ForScale
  220. FUIScaleArrowX, FUIScaleArrowY, FUIScaleArrowZ: TGLGizmoExUISphere; // For Scale
  221. FUIScaleLineX, FUIScaleLineY, FUIScaleLineZ, FUIScaleLineXY, FUIScaleLineYZ, FUIScaleLineXZ: TGLGizmoExUILines;
  222. FUIICScaleLineX, FUIICScaleLineY, FUIICScaleLineZ, FUIICScaleLineXY, FUIICScaleLineXZ, FUIICScaleLineYZ, FUIICScaleLineXYZ: TGLGizmoExUIFrustrum;
  223. FUIScalePlaneXY, FUIScalePlaneXZ, FUIScalePlaneYZ, FUIScalePlaneXYZ: TGLGizmoExUIPolyGon; // For Move
  224. FUIAxisLabelX, FUIAxisLabelY, FUIAxisLabelZ: TGLGizmoExUIFlatText;
  225. FUIVisibleInfoLabels: TGLGizmoExUIFlatText;
  226. FRootGizmo: TGLBaseSceneObject;
  227. FRootObjects: TGLBaseSceneObject;
  228. FGizmoTmpRoot: TGLBaseSceneObject;
  229. FSelectedObj: TGLBaseSceneObject;
  230. FOperation: TGLGizmoExOperation;
  231. FOperationMode: TGLGizmoExOperationMode;
  232. FSelAxis: TGLGizmoExAxis;
  233. fInfoLabelCoordType: TInfoLabelCoordType;
  234. FReferenceCoordSystem: TGLGizmoExReferenceCoordinateSystem;
  235. FBoundingBoxColor: TGLColor;
  236. FSelectedColor: TGLColor;
  237. FVisibleInfoLabelsColor: TGLColor;
  238. FSelectionRegionColor: TGLColor;
  239. FVisibleInfoLabelsColorChanged: Boolean;
  240. FAutoZoom: Boolean;
  241. FExcludeObjects: Boolean;
  242. FExcludeClassname: Boolean;
  243. FNoZWrite: Boolean;
  244. FEnabled: Boolean;
  245. FAutoZoomFactor: Single;
  246. FZoomFactor: Single;
  247. FMoveCoef: Single;
  248. FRotationCoef: Single;
  249. FViewer: TGLSceneViewer;
  250. FVisibleVisibleInfoLabels: TGLGizmoExVisibleInfoLabels;
  251. FExcludeObjectsList: TStrings;
  252. FExcludeClassNameList: TStrings;
  253. FSelectionRegion: TGLGizmoExSelectionRegion;
  254. FEnableMultiSelection: Boolean;
  255. FShowMultiSelecting: Boolean;
  256. FSelectionRec: TGLGizmoExSelRec;
  257. FCanAddObjToSelectionList: Boolean;
  258. FCanRemoveObjFromSelectionList: Boolean;
  259. FSelectedObjects: TGLPickList;
  260. FAntiAliasedLines: Boolean;
  261. FShowAxisLabel: Boolean;
  262. FShowObjectInfos: Boolean;
  263. FShowBoundingBox: Boolean;
  264. FCanChangeWithChildren: Boolean;
  265. moving: Boolean;
  266. mx, my: Integer;
  267. fCursorPos: TPoint;
  268. fLastCursorPos: TPoint;
  269. fChangeRate: TAffineVector; //total rotate angle
  270. FEnableLoopCursorMoving: Boolean;
  271. lastMousePos: TGLVector;
  272. FOnUpdate: TNotifyEvent;
  273. FOnSelect: TGLGizmoExAcceptEvent;
  274. FOnOperationChange: TNotifyEvent;
  275. FOnOperationModeChange: TNotifyEvent;
  276. FOnSelectionLost: TNotifyEvent;
  277. FOnAxisSelected: TGLGizmoExAxisSelected;
  278. FScaleCoef: Single;
  279. FGizmoThickness: Single;
  280. FPickMode: TGLGizmoExPickMode;
  281. FEnableHistory: Boolean;
  282. FHistory: TGLGizmoExActionHistoryCollection;
  283. FHistoryStepsCount: Integer;
  284. FLabelFont: TGLCustomBitmapFont;
  285. procedure SetRootGizmo(const AValue: TGLBaseSceneObject);
  286. procedure SetRootObjects(const AValue: TGLBaseSceneObject);
  287. procedure SetGizmoTmpRoot(const AValue: TGLBaseSceneObject);
  288. procedure SeTGLGizmoExVisibleInfoLabels(const AValue: TGLGizmoExVisibleInfoLabels);
  289. procedure SetBoundingBoxColor(const AValue: TGLColor);
  290. procedure SetSelectedColor(const AValue: TGLColor);
  291. procedure SetVisibleInfoLabelsColor(const AValue: TGLColor);
  292. procedure SetSelectionRegionColor(const AValue: TGLColor);
  293. procedure SetCanChangeWithChildren(AValue: Boolean);
  294. procedure SetAALines(aValue: Boolean);
  295. procedure SetInfoLabelCoordType(aValue: TInfoLabelCoordType);
  296. procedure SetReferenceCoordSystem(aValue: TGLGizmoExReferenceCoordinateSystem);
  297. procedure SetHistoryStepsCount(aValue: Integer);
  298. procedure SetExcludeObjectsList(const AValue: TStrings);
  299. procedure SetExcludeClassNameList(const AValue: TStrings);
  300. function MouseWorldPos(const X, Y: Integer): TGLVector;
  301. function CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
  302. function CheckClassNameInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
  303. procedure UpdateVisibleInfoLabels;
  304. procedure SetGLGizmoExThickness(const Value: Single);
  305. procedure ActivatingElements(PickList: TGLPickList);
  306. procedure InterfaceRender(Sender: TObject; var rci: TGLRenderContextInfo);
  307. procedure InternalRender(Sender: TObject; var rci: TGLRenderContextInfo);
  308. function InternalGetPickedObjects(const x1, y1, x2, y2: Integer; const guessCount: Integer = 8): TGLPickList;
  309. procedure SetViewer(const Value: TGLSceneViewer);
  310. procedure SetLabelFont(const Value: TGLCustomBitmapFont);
  311. procedure SetSelectedObj(const Value: TGLBaseSceneObject);
  312. function GetSelectedObj: TGLBaseSceneObject;
  313. procedure SetNoZWrite(const Value: Boolean);
  314. procedure SetOperation(const Value: TGLGizmoExOperation);
  315. procedure SetOperationMode(const Value: TGLGizmoExOperationMode);
  316. procedure SetAngleDisk(aAngle: Single);
  317. procedure SetEnableLoopCursorMoving(const AValue: Boolean);
  318. procedure SetEnableMultiSelection(const AValue: Boolean);
  319. procedure SetSelectionRegion(const AValue: TGLGizmoExSelectionRegion);
  320. procedure SetShowAxisLabel(const AValue: Boolean);
  321. procedure SetShowObjectInfos(const AValue: Boolean);
  322. procedure SetShowBoundingBox(const AValue: Boolean);
  323. procedure SetAutoZoomFactor(const AValue: Single);
  324. procedure SetZoomFactor(const AValue: Single);
  325. procedure SetSelAxis(aValue: TGLGizmoExAxis);
  326. procedure SetPickMode(APickMode: TGLGizmoExPickMode);
  327. procedure AssignPickList(aList: TGLPickList; RemoveObj: Boolean = False);
  328. procedure AddObjToSelectionList(Obj: TGLBaseSceneObject);
  329. procedure RemoveObjFromSelectionList(Obj: TGLBaseSceneObject);
  330. procedure MultiSelMouseDown(X, Y: Integer);
  331. procedure MultiSelMouseUp(X, Y: Integer);
  332. procedure MultiSelMouseMove(X, Y: Integer);
  333. function GetPickList: TGLPickList;
  334. procedure SetPickList(aValue: TGLPickList);
  335. property SelAxis: TGLGizmoExAxis read FSelAxis write SetSelAxis;
  336. property Operation: TGLGizmoExOperation read FOperation write SetOperation;
  337. procedure ClearSelection;
  338. procedure SetVisible(const AValue: Boolean);
  339. function GetVisible: Boolean;
  340. public
  341. constructor Create(AOwner: TComponent); override;
  342. destructor Destroy; override;
  343. procedure Loaded; override;
  344. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  345. procedure ViewerMouseMove(const X, Y: Integer);
  346. procedure ViewerMouseDown(const X, Y: Integer);
  347. procedure ViewerMouseUp(const X, Y: Integer);
  348. procedure UpdateGizmo; overload;
  349. procedure LooseSelection; virtual;
  350. procedure UndoAdd(const AObject: TObject);
  351. procedure RemoveSelectedObjects;
  352. function Undo: TGLGizmoExActionHistoryItem;
  353. function Redo: TGLGizmoExActionHistoryItem;
  354. property CanAddObjToSelectionList: Boolean read FCanAddObjToSelectionList write FCanAddObjToSelectionList;
  355. property CanRemoveObjFromSelectionList: Boolean read FCanRemoveObjFromSelectionList write FCanRemoveObjFromSelectionList;
  356. procedure LooseCursorSelection;
  357. property CursorSelectingRegion: Boolean read FShowMultiSelecting;
  358. property RootObjects: TGLBaseSceneObject read FRootObjects write SetRootObjects;
  359. property RootGizmo: TGLBaseSceneObject read FRootGizmo write SetRootGizmo;
  360. property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write SetGizmoTmpRoot;
  361. //--------------------------------------------------------------------
  362. published
  363. property Viewer: TGLSceneViewer read FViewer write SetViewer;
  364. property BoundingBoxColor: TGLColor read FBoundingBoxColor write SetBoundingBoxColor;
  365. property SelectedColor: TGLColor read FSelectedColor write SetSelectedColor;
  366. property SelectionRegionColor: TGLColor read FSelectionRegionColor write SetSelectionRegionColor;
  367. property SelectedObj: TGLBaseSceneObject read GetSelectedObj write SetSelectedObj;
  368. property SelectedObjects: TGLPickList read GetPickList write SetPickList;
  369. property OperationMode: TGLGizmoExOperationMode read FOperationMode write SetOperationMode default gomSelect;
  370. property ExcludeObjects: Boolean read FExcludeObjects write FExcludeObjects;
  371. property ExcludeObjectsList: TStrings read FExcludeObjectsList write SetExcludeObjectsList;
  372. property ExcludeClassname: Boolean read FExcludeClassname write FExcludeClassname;
  373. property ExcludeClassnameList: TStrings read FExcludeClassnameList write SetExcludeClassnameList;
  374. property VisibleInfoLabels: TGLGizmoExVisibleInfoLabels read FVisibleVisibleInfoLabels write SeTGLGizmoExVisibleInfoLabels;
  375. property VisibleInfoLabelsColor: TGLColor read FVisibleInfoLabelsColor write SetVisibleInfoLabelsColor;
  376. property AutoZoom: Boolean read FAutoZoom write FAutoZoom default True;
  377. property AutoZoomFactor: Single read FAutoZoomFactor write SetAutoZoomFactor;
  378. property ZoomFactor: Single read FZoomFactor write SetZoomFactor;
  379. property MoveCoef: Single read FMoveCoef write FMoveCoef;
  380. property RotationCoef: Single read FRotationCoef write FRotationCoef;
  381. property ScaleCoef: Single read FScaleCoef write FScaleCoef;
  382. property NoZWrite: Boolean read FNoZWrite write SetNoZWrite default True;
  383. property GizmoThickness: Single read FGizmoThickness write SeTGLGizmoExThickness;
  384. {Indicates whether the gizmo is enabled or not.
  385. WARNING: When loading/editing (possibly whenever a structureChanged
  386. call is made) a model, sometimes the gizmo will trigger a
  387. bug if the mouse is inside the glscene Viewer. To prevent that,
  388. remember to disable the gizmo before loading, then process windows
  389. messages (i.e. application.processMessage) and then enable the gizmo
  390. again. }
  391. {Warning Enable is ReadOnly property if you set to False, Gizmo is not Hidden
  392. use Visible instead if you want to Hide, if you want to Hide but keep enabled
  393. see the VisibleGizmo property }
  394. {Use the property OperationMode=gomNone to unactivate gizmo and make it invisible}
  395. property Enabled: Boolean read FEnabled write FEnabled default True;
  396. property LabelFont: TGLCustomBitmapFont read FLabelFont write SetLabelFont default nil;
  397. property OnSelectionLost: TNotifyEvent read FOnSelectionLost write FOnSelectionLost;
  398. property OnOperationChange: TNotifyEvent read FOnOperationChange write FOnOperationChange;
  399. property OnOperationModeChange: TNotifyEvent read FOnOperationModeChange write FOnOperationModeChange;
  400. property OnSelect: TGLGizmoExAcceptEvent read FOnSelect write FOnSelect;
  401. property OnAxisSelected: TGLGizmoExAxisSelected read FOnAxisSelected write FOnAxisSelected;
  402. property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
  403. property PickMode: TGLGizmoExPickMode read FPickMode write SetPickMode default pmGetPickedObjects;
  404. property EnableActionHistory: Boolean read FEnableHistory write FEnableHistory default True;
  405. property HistoryStepsCount: Integer read FHistoryStepsCount write SetHistoryStepsCount;
  406. property EnableLoopCursorMoving: Boolean read FEnableLoopCursorMoving write SetEnableLoopCursorMoving default True;
  407. property EnableMultiSelection: Boolean read FEnableMultiSelection write SetEnableMultiSelection default True;
  408. property CanChangeWithChildren: Boolean read FCanChangeWithChildren write SetCanChangeWithChildren;
  409. property AntiAliasedLines: Boolean read FAntiAliasedLines write SetAALines default True;
  410. property InfoLabelCoordType: TInfoLabelCoordType read fInfoLabelCoordType write SetInfoLabelCoordType default ilcChangeRate;
  411. property SelectionRegion: TGLGizmoExSelectionRegion read FSelectionRegion write SetSelectionRegion default gsrRectangular;
  412. property ShowAxisLabel: Boolean read FShowAxisLabel write SetShowAxisLabel default True;
  413. property ShowObjectInfos: Boolean read FShowObjectInfos write SetShowObjectInfos default True;
  414. property ShowBoundingBox: Boolean read FShowBoundingBox write SetShowBoundingBox default True;
  415. property ReferenceCoordSystem: TGLGizmoExReferenceCoordinateSystem read FReferenceCoordSystem write SetReferenceCoordSystem default rcsView;
  416. property Visible: Boolean read GetVisible write SetVisible;
  417. end;
  418. //==================================================================
  419. implementation
  420. //==================================================================
  421. uses
  422. GLS.Context,
  423. GLS.PipelineTransformation,
  424. GLS.OpenGLTokens;
  425. procedure RotateAroundArbitraryAxis(const anObject: TGLBaseSceneObject; const Axis, Origin: TAffineVector; const angle: Single);
  426. var
  427. M, M1, M2, M3: TGLMatrix;
  428. begin
  429. M1 := CreateTranslationMatrix(VectorNegate(Origin));
  430. M2 := CreateRotationMatrix(Axis, Angle * PI / 180);
  431. M3 := CreateTranslationMatrix(Origin);
  432. M := MatrixMultiply(M1, M2);
  433. M := MatrixMultiply(M, M3);
  434. anObject.AbsoluteMatrix := MatrixMultiply(anObject.AbsoluteMatrix, M);
  435. //Just a workarround to Update angles...
  436. anObject.Roll(0);
  437. anObject.Pitch(0);
  438. anObject.Turn(0);
  439. end;
  440. //-------------------------------------------------------------------
  441. // Mathematical functions for canvas
  442. //-------------------------------------------------------------------
  443. function Det(const a, b, c, d: real): real;
  444. begin
  445. Det := a * d - b * c;
  446. end;
  447. //Distance between two points
  448. function Dist(const P1, P2: TPoint): real;
  449. begin
  450. Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y));
  451. end;
  452. function CrossingPointLine(p: TPoint; p1, p2: TPoint): Boolean;
  453. begin
  454. Result := (abs(p1.X - p.X) + abs(p2.X - p.X) = abs(p2.X - p1.X)) and
  455. (abs(p1.Y - p.Y) + abs(p2.Y - p.Y) = abs(p2.Y - p1.Y));
  456. end;
  457. //Intersection between two lines, return true or false
  458. //converted from http://doc-for-prog.narod.ru/topics/math/crossing.html
  459. function IsLineIntLine(const p11, p12, p21, p22: TPoint; var p: TPoint): Boolean;
  460. var
  461. Z, ca, cb, ua, ub: Single;
  462. begin
  463. // demominator
  464. Z := (p12.Y - p11.Y) * (p21.X - p22.X) - (p21.Y - p22.Y) * (p12.X - p11.X);
  465. // numerator 1
  466. Ca := (p12.Y - p11.Y) * (p21.X - p11.X) - (p21.Y - p11.Y) * (p12.X - p11.X);
  467. // numerator 2
  468. Cb := (p21.Y - p11.Y) * (p21.X - p22.X) - (p21.Y - p22.Y) * (p21.X - p11.X);
  469. // if numerator and demominator = 0, then coincide lines
  470. if (Z = 0) and (Ca = 0) and (Cb = 0) then
  471. begin
  472. Result := False;
  473. Exit;
  474. end
  475. else
  476. // if demominator = 0, then parallel lines
  477. if Z = 0 then
  478. begin
  479. Result := False;
  480. Exit;
  481. end;
  482. Ua := Ca / Z;
  483. Ub := Cb / Z;
  484. // if 0<=Ua<=1 and 0<=Ub<=1, then the intersection point is inside intervals
  485. if (0 <= Ua) and (Ua <= 1) and (0 <= Ub) and (Ub <= 1) then
  486. begin
  487. p.X := round(p11.X + (p12.X - p11.X) * Ub);
  488. p.Y := round(p11.Y + (p12.Y - p11.Y) * Ub);
  489. Result := True;
  490. end
  491. // otherwise the intersection point is outside intervals
  492. else
  493. Result := False;
  494. end;
  495. //Intersection of line and circle
  496. function IsLineIntCirlce(CR: Single; CC: TPoint; LP1, LP2: TPoint; var PIL1, PIL2: TPoint): Smallint;
  497. var
  498. d, K, b: Single;
  499. begin
  500. K := (LP1.Y - LP2.Y) / (LP1.X - LP2.X);
  501. b := LP1.Y - K * LP1.X;
  502. //determine decrement of quadratic equation
  503. d := (PowerInteger((2 * K * b - 2 * CC.X - 2 * CC.Y * K), 2) - (4 + 4 * K * K) * (b * b - cr * cr + CC.X * CC.X + CC.Y * CC.Y - 2 * CC.Y * b));
  504. //if decrement = 0, then no decision and line and circle do not intersect
  505. if (d < 0) then
  506. begin
  507. Result := -1;
  508. PIL1 := point(0, 0);
  509. PIL2 := point(0, 0);
  510. Exit;
  511. end;
  512. //otherwise find roots of quadratic equation
  513. PIL1.X := round((-(2 * K * b - 2 * CC.X - 2 * CC.Y * K) - sqrt(d)) / (2 + 2 * K * K));
  514. PIL2.X := round((-(2 * K * b - 2 * CC.X - 2 * CC.Y * K) + sqrt(d)) / (2 + 2 * K * K));
  515. //if abscissas of points are coinside, then the intersection is only in one point
  516. //and line and circle have a point of contact
  517. if (PIL1.X = PIL2.X) then
  518. begin
  519. Result := 0;
  520. PIL1.Y := round(K * PIL1.X + b);
  521. PIL2 := PIL1;
  522. Exit;
  523. end;
  524. //otherwise find ordinates of intersection points
  525. PIL1.Y := round(K * PIL1.X + b);
  526. PIL2.Y := round(K * PIL2.X + b);
  527. Result := 1;
  528. end;
  529. constructor TGLGizmoExUIArrowLine.Create(AOwner: TComponent);
  530. begin
  531. FNoZWrite := True;
  532. inherited;
  533. end;
  534. procedure TGLGizmoExUIArrowLine.BuildList(var rci: TGLRenderContextInfo);
  535. begin
  536. if FNoZWrite then
  537. rci.GLStates.Disable(stDepthTest)
  538. else
  539. rci.GLStates.Enable(stDepthTest);
  540. inherited;
  541. end;
  542. constructor TGLGizmoExUIDisk.Create(AOwner: TComponent);
  543. begin
  544. FNoZWrite := True;
  545. inherited;
  546. end;
  547. procedure TGLGizmoExUIDisk.BuildList(var rci: TGLRenderContextInfo);
  548. begin
  549. if FNoZWrite then
  550. rci.GLStates.Disable(stDepthTest)
  551. else
  552. rci.GLStates.Enable(stDepthTest);
  553. inherited;
  554. end;
  555. constructor TGLGizmoExUISphere.Create(AOwner: TComponent);
  556. begin
  557. FNoZWrite := True;
  558. inherited;
  559. end;
  560. procedure TGLGizmoExUISphere.BuildList(var rci: TGLRenderContextInfo);
  561. begin
  562. if FNoZWrite then
  563. rci.GLStates.Disable(stDepthTest)
  564. else
  565. rci.GLStates.Enable(stDepthTest);
  566. inherited;
  567. end;
  568. constructor TGLGizmoExUIPolyGon.Create(AOwner: TComponent);
  569. begin
  570. FNoZWrite := True;
  571. inherited;
  572. end;
  573. procedure TGLGizmoExUIPolyGon.BuildList(var rci: TGLRenderContextInfo);
  574. begin
  575. if FNoZWrite then
  576. rci.GLStates.Disable(stDepthTest)
  577. else
  578. rci.GLStates.Enable(stDepthTest);
  579. inherited;
  580. end;
  581. constructor TGLGizmoExUIFrustrum.Create(AOwner: TComponent);
  582. begin
  583. FNoZWrite := True;
  584. inherited;
  585. end;
  586. procedure TGLGizmoExUIFrustrum.BuildList(var rci: TGLRenderContextInfo);
  587. begin
  588. if FNoZWrite then
  589. rci.GLStates.Disable(stDepthTest)
  590. else
  591. rci.GLStates.Enable(stDepthTest);
  592. inherited;
  593. end;
  594. constructor TGLGizmoExUITorus.Create(AOwner: TComponent);
  595. begin
  596. FNoZWrite := True;
  597. inherited;
  598. end;
  599. procedure TGLGizmoExUITorus.BuildList(var rci: TGLRenderContextInfo);
  600. begin
  601. if FNoZWrite then
  602. rci.GLStates.Disable(stDepthTest)
  603. else
  604. rci.GLStates.Enable(stDepthTest);
  605. inherited;
  606. end;
  607. constructor TGLGizmoExUILines.Create(AOwner: TComponent);
  608. begin
  609. FNoZWrite := True;
  610. inherited;
  611. end;
  612. procedure TGLGizmoExUILines.BuildList(var rci: TGLRenderContextInfo);
  613. begin
  614. if FNoZWrite then
  615. rci.GLStates.Disable(stDepthTest)
  616. else
  617. rci.GLStates.Enable(stDepthTest);
  618. inherited;
  619. end;
  620. constructor TGLGizmoExUIFlatText.Create(AOwner: TComponent);
  621. begin
  622. FNoZWrite := True;
  623. inherited;
  624. end;
  625. procedure TGLGizmoExUIFlatText.BuildList(var rci: TGLRenderContextInfo);
  626. begin
  627. if FNoZWrite then
  628. rci.GLStates.Disable(stDepthTest)
  629. else
  630. rci.GLStates.Enable(stDepthTest);
  631. inherited;
  632. end;
  633. //------------------------------------------------------------------------------
  634. constructor TGLGizmoEx.Create(aOwner: TComponent);
  635. var
  636. I: Integer;
  637. begin
  638. inherited Create(aOwner);
  639. FHistory := TGLGizmoExActionHistoryCollection.Create(Self, TGLGizmoExActionHistoryItem);
  640. FPickMode := pmGetPickedObjects;
  641. FRotationCoef := 1;
  642. FMoveCoef := 0.1;
  643. FScaleCoef := 0.1;
  644. FBoundingBoxColor := TGLColor.Create(Self);
  645. FBoundingBoxColor.Color := clrWhite;
  646. FSelectionRegionColor := TGLColor.Create(Self);
  647. SelectionRegionColor.Color := clrBlack;
  648. FSelectedColor := TGLColor.Create(Self);
  649. FSelectedColor.Color := clrYellow;
  650. FVisibleInfoLabelsColor := TGLColor.Create(Self);
  651. FVisibleInfoLabelsColor.Color := clrYellow;
  652. FVisibleInfoLabelsColorChanged := False;
  653. FUIBaseGizmo := TGLDummyCube.Create(Self);
  654. //BoundingBoxes...
  655. FInternalRender := TGLDirectOpenGL(FUIBaseGizmo.AddNewChild(TGLDirectOpenGL));
  656. FInternalRender.OnRender := InternalRender;
  657. FUIRootHelpers := TGLDummyCube(FUIBaseGizmo.AddNewChild(TGLDummyCube));
  658. //Canvas...
  659. FInterfaceRender := TGLDirectOpenGL(FUIBaseGizmo.AddNewChild(TGLDirectOpenGL));
  660. FInterfaceRender.OnRender := InterfaceRender;
  661. FSelectedObjects := TGLPickList.Create(psMinDepth);
  662. //For None
  663. FUIRootSelect := FUIRootHelpers.AddNewChild(TGLDummyCube); // for None
  664. FUIRootMovement := FUIRootHelpers.AddNewChild(TGLDummyCube);
  665. FUIRootRotate := FUIRootHelpers.AddNewChild(TGLDummyCube);
  666. FUIRootScale := FUIRootHelpers.AddNewChild(TGLDummyCube);
  667. FUIRootAxisLabel := FUIRootHelpers.AddNewChild(TGLDummyCube);
  668. FUIRootVisibleInfoLabels := FUIRootHelpers.AddNewChild(TGLDummyCube);
  669. FUISelectLineX := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
  670. with FUISelectLineX do
  671. begin
  672. LineColor.Color := clrRed;
  673. LineWidth := 1;
  674. NodesAspect := lnaInvisible;
  675. AddNode(0, 0, 0);
  676. AddNode(1, 0, 0);
  677. AddNode(0.9, 0, -0.1);
  678. addNode(1, 0, 0);
  679. addNode(0.9, 0, 0.1);
  680. end;
  681. FUISelectLineY := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
  682. with FUISelectLineY do
  683. begin
  684. LineColor.Color := clrLime;
  685. LineWidth := 1;
  686. NodesAspect := lnaInvisible;
  687. AddNode(0, 0, 0);
  688. AddNode(0, 1, 0);
  689. AddNode(0.1, 0.9, 0);
  690. addNode(0, 1, 0);
  691. addNode(-0.1, 0.9, 0);
  692. end;
  693. FUISelectLineZ := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
  694. with FUISelectLineZ do
  695. begin
  696. LineColor.Color := clrBlue;
  697. LineWidth := 1;
  698. NodesAspect := lnaInvisible;
  699. AddNode(0, 0, 0);
  700. AddNode(0, 0, 1);
  701. AddNode(0.1, 0, 0.9);
  702. addNode(0, 0, 1);
  703. addNode(-0.1, 0, 0.9);
  704. end;
  705. FUIMovementLineX := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  706. with FUIMovementLineX do
  707. begin
  708. LineColor.Color := clrRed;
  709. LineWidth := 1;
  710. NodesAspect := lnaInvisible;
  711. AddNode(0.2, 0, 0);
  712. AddNode(1, 0, 0);
  713. // Raycast pickable object
  714. FUIICMovementLineX := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  715. with FUIICMovementLineX do
  716. begin
  717. Material.MaterialOptions := [moNoLighting];
  718. Material.BlendingMode := bmTransparency;
  719. Material.FrontProperties.Diffuse.Color := clrYellow;
  720. Material.FrontProperties.Diffuse.Alpha := 0;
  721. Up.SetVector(1, 0, 0);
  722. Height := 0.8;
  723. ApexHeight := 8;
  724. BaseDepth := 0.15;
  725. BaseWidth := 0.15;
  726. position.SetPoint(0.6, 0, 0);
  727. end;
  728. FUIMovementArrowX := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
  729. with FUIMovementArrowX do
  730. begin
  731. Material.MaterialOptions := [moNoLighting];
  732. Material.BlendingMode := bmTransparency;
  733. Material.FrontProperties.Diffuse.Color := clrRed;
  734. TurnAngle := 90;
  735. Height := 0.3;
  736. Position.X := 1;
  737. Slices := 8;
  738. Stacks := 2;
  739. TopRadius := 0;
  740. TopArrowHeadHeight := 0;
  741. TopArrowHeadRadius := 0;
  742. BottomArrowHeadHeight := 0.1;
  743. BottomRadius := 0.06;
  744. end;
  745. end;
  746. FUIMovementLineY := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  747. with FUIMovementLineY do
  748. begin
  749. LineColor.Color := clrLime;
  750. LineWidth := 1;
  751. NodesAspect := lnaInvisible;
  752. AddNode(0, 0.2, 0);
  753. AddNode(0, 1, 0);
  754. FUIMovementArrowY := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
  755. with FUIMovementArrowY do
  756. begin
  757. Material.MaterialOptions := [moNoLighting];
  758. Material.BlendingMode := bmTransparency;
  759. Material.FrontProperties.Diffuse.Color := clrLime;
  760. PitchAngle := 90;
  761. Height := 0.3;
  762. Position.Y := 1;
  763. Slices := 8;
  764. Stacks := 2;
  765. TopRadius := 0;
  766. TopArrowHeadHeight := 0;
  767. TopArrowHeadRadius := 0;
  768. BottomArrowHeadHeight := 0.1;
  769. BottomRadius := 0.06;
  770. end;
  771. // Raycast pickable object
  772. FUIICMovementLineY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  773. with FUIICMovementLineY do
  774. begin
  775. Material.MaterialOptions := [moNoLighting];
  776. Material.BlendingMode := bmTransparency;
  777. Material.FrontProperties.Diffuse.Alpha := 0;
  778. Up.SetVector(0, 1, 0);
  779. Height := 0.8;
  780. ApexHeight := 8;
  781. BaseDepth := 0.15;
  782. BaseWidth := 0.15;
  783. position.SetPoint(0, 0.6, 0);
  784. end;
  785. end;
  786. FUIMovementLineZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  787. with FUIMovementLineZ do
  788. begin
  789. LineColor.Color := clrBlue;
  790. LineWidth := 1;
  791. NodesAspect := lnaInvisible;
  792. AddNode(0, 0, 0.2);
  793. AddNode(0, 0, 1);
  794. FUIMovementArrowZ := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
  795. with FUIMovementArrowZ do
  796. begin
  797. Material.MaterialOptions := [moNoLighting];
  798. Material.BlendingMode := bmTransparency;
  799. Material.FrontProperties.Diffuse.Color := clrBlue;
  800. RollAngle := 90;
  801. Height := 0.3;
  802. Position.Z := 1;
  803. Slices := 8;
  804. Stacks := 2;
  805. TopRadius := 0;
  806. TopArrowHeadHeight := 0;
  807. TopArrowHeadRadius := 0;
  808. BottomArrowHeadHeight := 0.1;
  809. BottomRadius := 0.06;
  810. end;
  811. // Raycast pickable object
  812. FUIICMovementLineZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  813. with FUIICMovementLineZ do
  814. begin
  815. Material.MaterialOptions := [moNoLighting];
  816. Material.BlendingMode := bmTransparency;
  817. Material.FrontProperties.Diffuse.Alpha := 0;
  818. Up.SetVector(0, 0, 1);
  819. Height := 0.8;
  820. ApexHeight := 8;
  821. BaseDepth := 0.15;
  822. BaseWidth := 0.15;
  823. position.SetPoint(0, 0, 0.6);
  824. end;
  825. end;
  826. FUIMovementLineXY := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  827. with FUIMovementLineXY do
  828. begin
  829. LineWidth := 1;
  830. Options := [loUseNodeColorForLines];
  831. NodesAspect := lnaInvisible;
  832. SplineMode := lsmSegments;
  833. addNode(0, 0.4, 0);
  834. TGLLinesNode(Nodes[0]).Color.color := clrLime;
  835. addNode(0.4, 0.4, 0);
  836. TGLLinesNode(Nodes[1]).Color.color := clrLime;
  837. addNode(0.4, 0.4, 0);
  838. TGLLinesNode(Nodes[2]).Color.color := clrRed;
  839. addNode(0.4, 0, 0);
  840. TGLLinesNode(Nodes[3]).Color.color := clrRed;
  841. // Raycast pickable object
  842. FUIMovementPlaneXY := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  843. with FUIMovementPlaneXY do
  844. begin
  845. Material.MaterialOptions := [moNoLighting];
  846. Material.BlendingMode := bmTransparency;
  847. Material.FrontProperties.Diffuse.Color := clrYellow;
  848. Material.FrontProperties.Diffuse.Alpha := 0.01;
  849. addNode(0.01, 0.39, 0);
  850. addNode(0.39, 0.39, 0);
  851. addNode(0.39, 0.01, 0);
  852. addNode(0.01, 0.01, 0);
  853. end;
  854. FUIICMovementLineXY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  855. with FUIICMovementLineXY do
  856. begin
  857. Material.MaterialOptions := [moNoLighting];
  858. Material.BlendingMode := bmTransparency;
  859. Material.FrontProperties.Diffuse.Alpha := 0;
  860. Up.SetVector(1, 0, 0);
  861. Height := 0.35;
  862. ApexHeight := 8;
  863. BaseDepth := 0.1;
  864. BaseWidth := 0.35;
  865. position.SetPoint(0.25, 0.25, 0);
  866. end;
  867. end;
  868. FUIMovementLineXZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  869. with FUIMovementLineXZ do
  870. begin
  871. LineWidth := 1;
  872. Options := [loUseNodeColorForLines];
  873. NodesAspect := lnaInvisible;
  874. SplineMode := lsmSegments;
  875. addNode(0.4, 0, 0);
  876. TGLLinesNode(Nodes[0]).Color.color := clrRed;
  877. addNode(0.4, 0, 0.4);
  878. TGLLinesNode(Nodes[1]).Color.color := clrRed;
  879. addNode(0.4, 0, 0.4);
  880. TGLLinesNode(Nodes[2]).Color.color := clrBlue;
  881. addNode(0, 0, 0.4);
  882. TGLLinesNode(Nodes[3]).Color.color := clrBlue;
  883. FUIMovementPlaneXZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  884. with FUIMovementPlaneXZ do
  885. begin
  886. Material.MaterialOptions := [moNoLighting];
  887. Material.BlendingMode := bmTransparency;
  888. Material.FrontProperties.Diffuse.Color := clrYellow;
  889. Material.FrontProperties.Diffuse.Alpha := 0.01;
  890. addNode(0.39, 0, 0.01);
  891. addNode(0.39, 0, 0.39);
  892. addNode(0.01, 0, 0.39);
  893. addNode(0, 0, 0.01);
  894. end;
  895. // Raycast pickable object
  896. FUIICMovementLineXZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  897. with FUIICMovementLineXZ do
  898. begin
  899. Material.MaterialOptions := [moNoLighting];
  900. Material.BlendingMode := bmTransparency;
  901. Material.FrontProperties.Diffuse.Alpha := 0;
  902. pitchAngle := 90;
  903. Height := 0.35;
  904. ApexHeight := 8;
  905. BaseDepth := 0.1;
  906. BaseWidth := 0.35;
  907. position.SetPoint(0.25, 0, 0.25);
  908. end;
  909. end;
  910. FUIMovementLineYZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
  911. with FUIMovementLineYZ do
  912. begin
  913. LineWidth := 1;
  914. Options := [loUseNodeColorForLines];
  915. NodesAspect := lnaInvisible;
  916. SplineMode := lsmSegments;
  917. addNode(0, 0, 0.4);
  918. TGLLinesNode(Nodes[0]).Color.color := clrBlue;
  919. addNode(0, 0.4, 0.4);
  920. TGLLinesNode(Nodes[1]).Color.color := clrBlue;
  921. addNode(0, 0.4, 0.4);
  922. TGLLinesNode(Nodes[2]).Color.color := clrLime;
  923. addNode(0, 0.4, 0);
  924. TGLLinesNode(Nodes[3]).Color.color := clrLime;
  925. FUIMovementPlaneYZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  926. with FUIMovementPlaneYZ do
  927. begin
  928. Material.MaterialOptions := [moNoLighting];
  929. Material.BlendingMode := bmTransparency;
  930. Material.FrontProperties.Diffuse.Color := clrYellow;
  931. Material.FrontProperties.Diffuse.Alpha := 0.01;
  932. addNode(0, 0.01, 0.39);
  933. addNode(0, 0.39, 0.39);
  934. addNode(0, 0.39, 0);
  935. addNode(0, 0.01, 0);
  936. end;
  937. // Raycast pickable object
  938. FUIICMovementLineYZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  939. with FUIICMovementLineYZ do
  940. begin
  941. Material.MaterialOptions := [moNoLighting];
  942. Material.BlendingMode := bmTransparency;
  943. Material.FrontProperties.Diffuse.Alpha := 0;
  944. Up.SetVector(0, 0, 1);
  945. Height := 0.35;
  946. ApexHeight := 8;
  947. BaseDepth := 0.1;
  948. BaseWidth := 0.35;
  949. position.SetPoint(0, 0.25, 0.25);
  950. end;
  951. end;
  952. //Rotate
  953. FUIRotateLineXY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  954. with FUIRotateLineXY do
  955. begin
  956. LineColor.Color := clrGray50;
  957. SplineMode := lsmCubicSpline;
  958. NodesAspect := lnaInvisible;
  959. LineWidth := 1;
  960. Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
  961. FUIRotateDiskXY := TGLGizmoExUIDisk(addnewChild(TGLGizmoExUIDisk));
  962. with FUIRotateDiskXY do
  963. begin
  964. OuterRadius := 1;
  965. Slices := 18;
  966. with Material do
  967. begin
  968. MaterialOptions := [moNoLighting];
  969. BlendingMode := bmTransparency;
  970. FrontProperties.Diffuse.Color := clrGray50;
  971. FrontProperties.Diffuse.Alpha := 0;
  972. end;
  973. end;
  974. FUIICRotateSphereXY := TGLGizmoExUISphere(addnewChild(TGLGizmoExUISphere));
  975. with FUIICRotateSphereXY do
  976. begin
  977. Radius := 1;
  978. Stop := 180;
  979. Slices := 18;
  980. TurnAngle := -90;
  981. with Material do
  982. begin
  983. MaterialOptions := [moNoLighting];
  984. BlendingMode := bmTransparency;
  985. FrontProperties.Diffuse.Color := clryellow;
  986. FrontProperties.Diffuse.Alpha := 0;
  987. end;
  988. end;
  989. end;
  990. FUIRotateLineXZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  991. with FUIRotateLineXZ do
  992. begin
  993. LineColor.Color := clrGray75;
  994. SplineMode := lsmCubicSpline;
  995. NodesAspect := lnaInvisible;
  996. LineWidth := 1;
  997. Nodes.AddXYArc(1.3, 1.3, 0, 360, 24, AffineVectorMake(0, 0, 0));
  998. FUIICRotateTorusXZ := TGLGizmoExUITorus(addnewChild(TGLGizmoExUITorus));
  999. with FUIICRotateTorusXZ do
  1000. begin
  1001. Rings := 18;
  1002. Sides := 0;
  1003. MajorRadius := 1.3;
  1004. MinorRadius := 0.07;
  1005. with material do
  1006. begin
  1007. FaceCulling := fcNoCull;
  1008. MaterialOptions := [moNoLighting];
  1009. BlendingMode := bmTransparency;
  1010. FrontProperties.Diffuse.Color := clrYellow;
  1011. FrontProperties.Diffuse.Alpha := 0;
  1012. end;
  1013. end;
  1014. end;
  1015. FUIRotateLineX := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1016. with FUIRotateLineX do
  1017. begin
  1018. Options := [loUseNodeColorForLines];
  1019. //Äëÿ èñïðàâëåíèÿ ïðîáëåì ñ ïðîçðà÷íîñòüþ
  1020. lineColor.Alpha := 0.1;
  1021. Nodecolor.Color := clrred;
  1022. Nodecolor.Alpha := 0.1;
  1023. TurnAngle := 90;
  1024. SplineMode := lsmCubicSpline;
  1025. NodesAspect := lnaInvisible;
  1026. LineWidth := 1;
  1027. Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
  1028. for I := 0 to 24 do
  1029. begin
  1030. TGLLinesNode(Nodes[I]).Color.color := clrred;
  1031. end;
  1032. end;
  1033. FUIRotateLineArrowX := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1034. with FUIRotateLineArrowX do
  1035. begin
  1036. LineColor.Color := clrRed;
  1037. LineWidth := 1;
  1038. NodesAspect := lnaInvisible;
  1039. AddNode(0, 0, 0);
  1040. AddNode(0.4, 0, 0);
  1041. end;
  1042. FUIRotateDiskX := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1043. with FUIRotateDiskX do
  1044. begin
  1045. OuterRadius := 1.01;
  1046. Slices := 18;
  1047. sweepangle := 10;
  1048. StartAngle := 0;
  1049. TurnAngle := 90;
  1050. with Material do
  1051. begin
  1052. FaceCulling := fcNoCull;
  1053. MaterialOptions := [moNoLighting];
  1054. BlendingMode := bmTransparency;
  1055. FrontProperties.Diffuse.Color := clrred;
  1056. FrontProperties.Diffuse.Alpha := 0;
  1057. end;
  1058. end;
  1059. FUIRotateDiskX2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1060. with FUIRotateDiskX2 do
  1061. begin
  1062. OuterRadius := 1.01;
  1063. Slices := 18;
  1064. sweepangle := 10;
  1065. StartAngle := 0;
  1066. TurnAngle := 90;
  1067. with Material do
  1068. begin
  1069. FaceCulling := fcNoCull;
  1070. MaterialOptions := [moNoLighting];
  1071. BlendingMode := bmTransparency;
  1072. FrontProperties.Diffuse.Color := clrred;
  1073. FrontProperties.Diffuse.Alpha := 0;
  1074. end;
  1075. end;
  1076. FUIICRotateTorusX := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
  1077. with FUIICRotateTorusX do
  1078. begin
  1079. Rings := 18;
  1080. Sides := 0;
  1081. MajorRadius := 1;
  1082. MinorRadius := 0.07;
  1083. TurnAngle := 90;
  1084. with material do
  1085. begin
  1086. FaceCulling := fcNoCull;
  1087. MaterialOptions := [moNoLighting];
  1088. BlendingMode := bmTransparency;
  1089. FrontProperties.Diffuse.Color := clrYellow;
  1090. FrontProperties.Diffuse.Alpha := 0;
  1091. end;
  1092. end;
  1093. FUIRotateLineY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1094. with FUIRotateLineY do
  1095. begin
  1096. Options := [loUseNodeColorForLines];
  1097. //Äëÿ èñïðàâëåíèÿ ïðîáëåì ñ ïðîçðà÷íîñòüþ
  1098. lineColor.Alpha := 0.1;
  1099. Nodecolor.Color := clrLime;
  1100. Nodecolor.Alpha := 0.1;
  1101. SplineMode := lsmCubicSpline;
  1102. NodesAspect := lnaInvisible;
  1103. LineWidth := 1;
  1104. Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
  1105. PitchAngle := 90;
  1106. for I := 0 to 24 do
  1107. begin
  1108. TGLLinesNode(Nodes[I]).Color.color := clrLime;
  1109. end;
  1110. end;
  1111. FUIRotateLineArrowY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1112. with FUIRotateLineArrowY do
  1113. begin
  1114. LineColor.Color := clrLime;
  1115. LineWidth := 1;
  1116. NodesAspect := lnaInvisible;
  1117. AddNode(0, 0, 0);
  1118. AddNode(0, 0.4, 0);
  1119. end;
  1120. FUIRotateDiskY := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1121. with FUIRotateDiskY do
  1122. begin
  1123. OuterRadius := 1;
  1124. Slices := 18;
  1125. sweepangle := 20;
  1126. startangle := 0;
  1127. PitchAngle := 90;
  1128. with Material do
  1129. begin
  1130. FaceCulling := fcNoCull;
  1131. MaterialOptions := [moNoLighting];
  1132. BlendingMode := bmTransparency;
  1133. FrontProperties.Diffuse.Color := clrLime;
  1134. FrontProperties.Diffuse.Alpha := 0;
  1135. end;
  1136. end;
  1137. FUIRotateDiskY2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1138. with FUIRotateDiskY2 do
  1139. begin
  1140. OuterRadius := 1;
  1141. Slices := 18;
  1142. sweepangle := 20;
  1143. startangle := 0;
  1144. PitchAngle := 90;
  1145. with Material do
  1146. begin
  1147. FaceCulling := fcNoCull;
  1148. MaterialOptions := [moNoLighting];
  1149. BlendingMode := bmTransparency;
  1150. FrontProperties.Diffuse.Color := clrLime;
  1151. FrontProperties.Diffuse.Alpha := 0;
  1152. end;
  1153. end;
  1154. FUIICRotateTorusY := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
  1155. with FUIICRotateTorusY do
  1156. begin
  1157. Rings := 18;
  1158. Sides := 0;
  1159. MajorRadius := 1;
  1160. MinorRadius := 0.07;
  1161. PitchAngle := 90;
  1162. with material do
  1163. begin
  1164. FaceCulling := fcNoCull;
  1165. MaterialOptions := [moNoLighting];
  1166. BlendingMode := bmTransparency;
  1167. FrontProperties.Diffuse.Color := clrYellow;
  1168. FrontProperties.Diffuse.Alpha := 0;
  1169. end;
  1170. end;
  1171. FUIRotateLineZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1172. with FUIRotateLineZ do
  1173. begin
  1174. Options := [loUseNodeColorForLines];
  1175. //to correct transparency problem
  1176. lineColor.Alpha := 0.1;
  1177. Nodecolor.Color := clrBlue;
  1178. Nodecolor.Alpha := 0.1;
  1179. SplineMode := lsmCubicSpline;
  1180. NodesAspect := lnaInvisible;
  1181. LineWidth := 1;
  1182. Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
  1183. for I := 0 to 24 do
  1184. begin
  1185. TGLLinesNode(Nodes[I]).Color.color := clrBlue;
  1186. end;
  1187. end;
  1188. FUIRotateLineArrowZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
  1189. with FUIRotateLineArrowZ do
  1190. begin
  1191. LineColor.Color := clrBlue;
  1192. LineWidth := 1;
  1193. NodesAspect := lnaInvisible;
  1194. AddNode(0, 0, 0);
  1195. AddNode(0, 0, 0.4);
  1196. end;
  1197. FUIRotateDiskZ := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1198. with FUIRotateDiskZ do
  1199. begin
  1200. OuterRadius := 1;
  1201. Slices := 18;
  1202. SweepAngle := 10;
  1203. StartAngle := 0;
  1204. with Material do
  1205. begin
  1206. FaceCulling := fcNoCull;
  1207. MaterialOptions := [moNoLighting];
  1208. BlendingMode := bmTransparency;
  1209. FrontProperties.Diffuse.Color := clrBlue;
  1210. BackProperties.Diffuse.Color := clrBlue;
  1211. FrontProperties.Diffuse.Alpha := 0;
  1212. end;
  1213. end;
  1214. FUIRotateDiskZ2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
  1215. with FUIRotateDiskZ2 do
  1216. begin
  1217. OuterRadius := 1;
  1218. Slices := 18;
  1219. SweepAngle := 10;
  1220. StartAngle := 0;
  1221. with Material do
  1222. begin
  1223. FaceCulling := fcNoCull;
  1224. MaterialOptions := [moNoLighting];
  1225. BlendingMode := bmTransparency;
  1226. FrontProperties.Diffuse.Color := clrBlue;
  1227. FrontProperties.Diffuse.Alpha := 0;
  1228. end;
  1229. end;
  1230. FUIICRotateTorusZ := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
  1231. with FUIICRotateTorusZ do
  1232. begin
  1233. Rings := 18;
  1234. Sides := 0;
  1235. MajorRadius := 1;
  1236. MinorRadius := 0.07;
  1237. with material do
  1238. begin
  1239. FaceCulling := fcNoCull;
  1240. MaterialOptions := [moNoLighting];
  1241. BlendingMode := bmTransparency;
  1242. FrontProperties.Diffuse.Color := clrYellow;
  1243. FrontProperties.Diffuse.Alpha := 0;
  1244. end;
  1245. end;
  1246. FUIRootRotateAxisLabel := FUIRootRotate.AddNewChild(TGLDummyCube);
  1247. FUIRotateAxisLabelX := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1248. with FUIRotateAxisLabelX do
  1249. begin
  1250. ModulateColor.Color := clrRed;
  1251. Alignment := taCenter;
  1252. Layout := TTextLayout.tlCenter;
  1253. Options := Options + [ftoTwoSided];
  1254. Position.X := 0.5;
  1255. Scale.X := 0.010;
  1256. Scale.Y := 0.010;
  1257. Text := 'X';
  1258. end;
  1259. FUIRotateAxisLabelY := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1260. with FUIRotateAxisLabelY do
  1261. begin
  1262. ModulateColor.Color := clrLime;
  1263. Alignment := taCenter;
  1264. Layout := tlCenter;
  1265. Options := Options + [ftoTwoSided];
  1266. Position.Y := 0.5;
  1267. Scale.X := 0.010;
  1268. Scale.Y := 0.010;
  1269. Text := 'Y';
  1270. end;
  1271. FUIRotateAxisLabelZ := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1272. with FUIRotateAxisLabelZ do
  1273. begin
  1274. ModulateColor.Color := clrBlue;
  1275. Alignment := taCenter;
  1276. Layout := tlCenter;
  1277. Options := Options + [ftoTwoSided];
  1278. Position.Z := 0.5;
  1279. Scale.X := 0.010;
  1280. Scale.Y := 0.010;
  1281. Text := 'Z';
  1282. end;
  1283. //for Scale
  1284. FUIScaleLineX := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1285. with FUIScaleLineX do
  1286. begin
  1287. LineColor.Color := clrRed;
  1288. LineWidth := 1;
  1289. NodesAspect := lnaInvisible;
  1290. AddNode(0, 0, 0);
  1291. AddNode(1, 0, 0);
  1292. // Raycast pickable object
  1293. FUIICScaleLineX := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1294. with FUIICScaleLineX do
  1295. begin
  1296. Material.MaterialOptions := [moNoLighting];
  1297. Material.BlendingMode := bmTransparency;
  1298. Material.FrontProperties.Diffuse.Color := clrYellow;
  1299. Material.FrontProperties.Diffuse.Alpha := 0;
  1300. Up.SetVector(1, 0, 0);
  1301. Height := 0.5;
  1302. ApexHeight := 8;
  1303. BaseDepth := 0.15;
  1304. BaseWidth := 0.15;
  1305. position.SetPoint(0.8, 0, 0);
  1306. end;
  1307. end;
  1308. FUIScaleLineY := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1309. with FUIScaleLineY do
  1310. begin
  1311. LineColor.Color := clrLime;
  1312. LineWidth := 1;
  1313. NodesAspect := lnaInvisible;
  1314. AddNode(0, 0, 0);
  1315. AddNode(0, 1, 0);
  1316. // Raycast pickable object
  1317. FUIICScaleLineY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1318. with FUIICScaleLineY do
  1319. begin
  1320. Material.MaterialOptions := [moNoLighting];
  1321. Material.BlendingMode := bmTransparency;
  1322. Material.FrontProperties.Diffuse.Color := clrYellow;
  1323. Material.FrontProperties.Diffuse.Alpha := 0;
  1324. Up.SetVector(0, 1, 0);
  1325. Height := 0.5;
  1326. ApexHeight := 8;
  1327. BaseDepth := 0.15;
  1328. BaseWidth := 0.15;
  1329. position.SetPoint(0, 0.8, 0);
  1330. end;
  1331. end;
  1332. FUIScaleLineZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1333. with FUIScaleLineZ do
  1334. begin
  1335. LineColor.Color := clrBlue;
  1336. LineWidth := 1;
  1337. NodesAspect := lnaInvisible;
  1338. AddNode(0, 0, 0);
  1339. AddNode(0, 0, 1);
  1340. // Raycast pickable object
  1341. FUIICScaleLineZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1342. with FUIICScaleLineZ do
  1343. begin
  1344. Material.MaterialOptions := [moNoLighting];
  1345. Material.BlendingMode := bmTransparency;
  1346. Material.FrontProperties.Diffuse.Color := clrYellow;
  1347. Material.FrontProperties.Diffuse.Alpha := 0;
  1348. Up.SetVector(0, 0, 1);
  1349. Height := 0.5;
  1350. ApexHeight := 8;
  1351. BaseDepth := 0.1;
  1352. BaseWidth := 0.1;
  1353. position.SetPoint(0, 0, 0.8);
  1354. end;
  1355. end;
  1356. FUIScaleLineXY := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1357. with FUIScaleLineXY do
  1358. begin
  1359. Options := [loUseNodeColorForLines];
  1360. SplineMode := lsmSegments;
  1361. LineColor.Color := clrRed;
  1362. LineWidth := 1;
  1363. NodesAspect := lnaInvisible;
  1364. AddNode(0, 0.7, 0);
  1365. AddNode(0.35, 0.35, 0);
  1366. TGLLinesNode(Nodes[0]).Color.color := clrLime;
  1367. TGLLinesNode(Nodes[1]).Color.color := clrLime;
  1368. AddNode(0.35, 0.35, 0);
  1369. AddNode(0.7, 0, 0);
  1370. TGLLinesNode(Nodes[2]).Color.color := clrRed;
  1371. TGLLinesNode(Nodes[3]).Color.color := clrRed;
  1372. AddNode(0.5, 0, 0);
  1373. AddNode(0.25, 0.25, 0);
  1374. TGLLinesNode(Nodes[4]).Color.color := clrRed;
  1375. TGLLinesNode(Nodes[5]).Color.color := clrRed;
  1376. AddNode(0.25, 0.25, 0);
  1377. AddNode(0, 0.5, 0);
  1378. TGLLinesNode(Nodes[6]).Color.color := clrLime;
  1379. TGLLinesNode(Nodes[7]).Color.color := clrLime;
  1380. FUIScalePlaneXY := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  1381. with FUIScalePlaneXY do
  1382. begin
  1383. with Material do
  1384. begin
  1385. MaterialOptions := [moNoLighting];
  1386. BlendingMode := bmTransparency;
  1387. FrontProperties.Diffuse.Color := clrYellow;
  1388. FrontProperties.Diffuse.Alpha := 0.01;
  1389. end;
  1390. AddNode(0, 0.7, 0);
  1391. AddNode(0.35, 0.35, 0);
  1392. AddNode(0.7, 0, 0);
  1393. AddNode(0.5, 0, 0);
  1394. AddNode(0.25, 0.25, 0);
  1395. AddNode(0, 0.5, 0);
  1396. end;
  1397. // Raycast pickable object
  1398. FUIICScaleLineXY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1399. with FUIICScaleLineXY do
  1400. begin
  1401. Material.MaterialOptions := [moNoLighting];
  1402. Material.BlendingMode := bmTransparency;
  1403. Material.FrontProperties.Diffuse.Color := clrYellow;
  1404. Material.FrontProperties.Diffuse.Alpha := 0;
  1405. rollAngle := 45;
  1406. turnAngle := 45;
  1407. Height := 0.8;
  1408. ApexHeight := 8;
  1409. BaseDepth := 0.1;
  1410. BaseWidth := 0.1;
  1411. position.SetPoint(0.3, 0.3, 0);
  1412. end;
  1413. end;
  1414. FUIScaleLineXZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1415. with FUIScaleLineXZ do
  1416. begin
  1417. Options := [loUseNodeColorForLines];
  1418. SplineMode := lsmSegments;
  1419. LineColor.Color := clrRed;
  1420. LineWidth := 1;
  1421. NodesAspect := lnaInvisible;
  1422. AddNode(0.7, 0, 0);
  1423. AddNode(0.35, 0, 0.35);
  1424. TGLLinesNode(Nodes[0]).Color.color := clrRed;
  1425. TGLLinesNode(Nodes[1]).Color.color := clrRed;
  1426. AddNode(0.35, 0, 0.35);
  1427. AddNode(0, 0, 0.7);
  1428. TGLLinesNode(Nodes[2]).Color.color := clrBlue;
  1429. TGLLinesNode(Nodes[3]).Color.color := clrBlue;
  1430. AddNode(0, 0, 0.5);
  1431. AddNode(0.25, 0, 0.25);
  1432. TGLLinesNode(Nodes[4]).Color.color := clrBlue;
  1433. TGLLinesNode(Nodes[5]).Color.color := clrBlue;
  1434. AddNode(0.25, 0, 0.25);
  1435. AddNode(0.5, 0, 0);
  1436. TGLLinesNode(Nodes[6]).Color.color := clrRed;
  1437. TGLLinesNode(Nodes[7]).Color.color := clrRed;
  1438. FUIScalePlaneXZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  1439. with FUIScalePlaneXZ do
  1440. begin
  1441. with Material do
  1442. begin
  1443. MaterialOptions := [moNoLighting];
  1444. BlendingMode := bmTransparency;
  1445. FrontProperties.Diffuse.Color := clrYellow;
  1446. FrontProperties.Diffuse.Alpha := 0;
  1447. end;
  1448. AddNode(0.7, 0, 0);
  1449. AddNode(0.35, 0, 0.35);
  1450. AddNode(0, 0, 0.7);
  1451. AddNode(0, 0, 0.5);
  1452. AddNode(0.25, 0, 0.25);
  1453. AddNode(0.5, 0, 0);
  1454. end;
  1455. // Raycast pickable object
  1456. FUIICScaleLineXZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1457. with FUIICScaleLineXZ do
  1458. begin
  1459. Material.MaterialOptions := [moNoLighting];
  1460. Material.BlendingMode := bmTransparency;
  1461. Material.FrontProperties.Diffuse.Color := clrYellow;
  1462. Material.FrontProperties.Diffuse.Alpha := 0;
  1463. turnAngle := -45;
  1464. pitchAngle := 90;
  1465. Height := 0.8;
  1466. ApexHeight := 8;
  1467. BaseDepth := 0.1;
  1468. BaseWidth := 0.1;
  1469. position.SetPoint(0.3, 0, 0.3);
  1470. end;
  1471. end;
  1472. FUIScaleLineYZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
  1473. with FUIScaleLineYZ do
  1474. begin
  1475. Options := [loUseNodeColorForLines];
  1476. SplineMode := lsmSegments;
  1477. LineColor.Color := clrRed;
  1478. LineWidth := 1;
  1479. NodesAspect := lnaInvisible;
  1480. AddNode(0, 0.7, 0);
  1481. AddNode(0, 0.35, 0.35);
  1482. TGLLinesNode(Nodes[0]).Color.color := clrLime;
  1483. TGLLinesNode(Nodes[1]).Color.color := clrLime;
  1484. AddNode(0, 0.35, 0.35);
  1485. AddNode(0, 0, 0.7);
  1486. TGLLinesNode(Nodes[2]).Color.color := clrBlue;
  1487. TGLLinesNode(Nodes[3]).Color.color := clrBlue;
  1488. AddNode(0, 0, 0.5);
  1489. AddNode(0, 0.25, 0.25);
  1490. TGLLinesNode(Nodes[4]).Color.color := clrBlue;
  1491. TGLLinesNode(Nodes[5]).Color.color := clrBlue;
  1492. AddNode(0, 0.25, 0.25);
  1493. AddNode(0, 0.5, 0);
  1494. TGLLinesNode(Nodes[6]).Color.color := clrLime;
  1495. TGLLinesNode(Nodes[7]).Color.color := clrLime;
  1496. FUIScalePlaneYZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
  1497. with FUIScalePlaneYZ do
  1498. begin
  1499. with Material do
  1500. begin
  1501. MaterialOptions := [moNoLighting];
  1502. BlendingMode := bmTransparency;
  1503. FrontProperties.Diffuse.Color := clrYellow;
  1504. FrontProperties.Diffuse.Alpha := 0;
  1505. end;
  1506. AddNode(0, 0.7, 0);
  1507. AddNode(0, 0.35, 0.35);
  1508. AddNode(0, 0, 0.7);
  1509. AddNode(0, 0, 0.5);
  1510. AddNode(0, 0.25, 0.25);
  1511. AddNode(0, 0.5, 0);
  1512. end;
  1513. // Raycast pickable object
  1514. FUIICScaleLineYZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
  1515. with FUIICScaleLineYZ do
  1516. begin
  1517. Material.MaterialOptions := [moNoLighting];
  1518. Material.BlendingMode := bmTransparency;
  1519. Material.FrontProperties.Diffuse.Color := clrYellow;
  1520. Material.FrontProperties.Diffuse.Alpha := 0;
  1521. pitchAngle := 45;
  1522. Height := 0.8;
  1523. ApexHeight := 8;
  1524. BaseDepth := 0.1;
  1525. BaseWidth := 0.1;
  1526. position.SetPoint(0, 0.3, 0.3);
  1527. end;
  1528. end;
  1529. FUIScalePlaneXYZ := TGLGizmoExUIPolyGon(FUIRootScale.addnewChild(TGLGizmoExUIPolyGon));
  1530. with FUIScalePlaneXYZ do
  1531. begin
  1532. with Material do
  1533. begin
  1534. MaterialOptions := [moNoLighting];
  1535. BlendingMode := bmTransparency;
  1536. FrontProperties.Diffuse.Color := clrYellow;
  1537. FrontProperties.Diffuse.Alpha := 0;
  1538. end;
  1539. AddNode(0.5, 0, 0);
  1540. AddNode(0, 0.5, 0);
  1541. AddNode(0, 0, 0.5);
  1542. AddNode(0.5, 0, 0);
  1543. // Raycast pickable object
  1544. FUIICScaleLineXYZ := TGLGizmoExUIFrustrum(FUIRootScale.AddNewChild(TGLGizmoExUIFrustrum));
  1545. with FUIICScaleLineXYZ do
  1546. begin
  1547. Material.MaterialOptions := [moNoLighting];
  1548. Material.BlendingMode := bmTransparency;
  1549. Material.FrontProperties.Diffuse.Color := clrYellow;
  1550. Material.FrontProperties.Diffuse.Alpha := 0;
  1551. turnAngle := -45;
  1552. rollAngle := 35;
  1553. Height := 0.5;
  1554. ApexHeight := 0.6;
  1555. BaseDepth := 0.6;
  1556. BaseWidth := 0.05;
  1557. position.SetPoint(0.15, 0.2, 0.15);
  1558. end;
  1559. end;
  1560. FUIScaleArrowX := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
  1561. with FUIScaleArrowX do
  1562. begin
  1563. Slices := 8;
  1564. Stacks := 2;
  1565. Radius := 0.04;
  1566. Position.X := 1;
  1567. with material do
  1568. begin
  1569. MaterialOptions := [moNoLighting];
  1570. FrontProperties.Diffuse.Color := clrRed;
  1571. end;
  1572. end;
  1573. FUIScaleArrowY := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
  1574. with FUIScaleArrowY do
  1575. begin
  1576. Slices := 8;
  1577. Stacks := 2;
  1578. Radius := 0.04;
  1579. Position.Y := 1;
  1580. with material do
  1581. begin
  1582. //FaceCulling := fcNoCull;
  1583. // FrontProperties.PolygonMode := pmFill;
  1584. // BackProperties.PolygonMode := pmFill;
  1585. MaterialOptions := [moNoLighting];
  1586. FrontProperties.Diffuse.Color := clrLime;
  1587. //FrontProperties.Emission.Color := clrLime;
  1588. end;
  1589. end;
  1590. FUIScaleArrowZ := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
  1591. with FUIScaleArrowZ do
  1592. begin
  1593. Slices := 8;
  1594. Stacks := 2;
  1595. Radius := 0.04;
  1596. Position.Z := 1;
  1597. with material do
  1598. begin
  1599. // FaceCulling := fcNoCull;
  1600. //FrontProperties.PolygonMode := pmFill;
  1601. //BackProperties.PolygonMode := pmFill;
  1602. MaterialOptions := [moNoLighting];
  1603. FrontProperties.Diffuse.Color := clrBlue;
  1604. //FrontProperties.Emission.Color := clrBlue;
  1605. end;
  1606. end;
  1607. //For Axis
  1608. FUIAxisLabelX := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1609. with FUIAxisLabelX do
  1610. begin
  1611. ModulateColor.Color := clrRed;
  1612. Alignment := taCenter;
  1613. Layout := tlCenter;
  1614. Options := Options + [ftoTwoSided];
  1615. Position.X := 1.3;
  1616. Scale.X := 0.015;
  1617. Scale.Y := 0.015;
  1618. Text := 'X';
  1619. end;
  1620. FUIAxisLabelY := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1621. with FUIAxisLabelY do
  1622. begin
  1623. ModulateColor.Color := clrLime;
  1624. Alignment := taCenter;
  1625. Layout := tlCenter;
  1626. Options := Options + [ftoTwoSided];
  1627. Position.Y := 1.3;
  1628. Scale.X := 0.015;
  1629. Scale.Y := 0.015;
  1630. Text := 'Y';
  1631. end;
  1632. FUIAxisLabelZ := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
  1633. with FUIAxisLabelZ do
  1634. begin
  1635. ModulateColor.Color := clrBlue;
  1636. Alignment := taCenter;
  1637. Layout := tlCenter;
  1638. Options := Options + [ftoTwoSided];
  1639. Position.Z := 1.3;
  1640. Scale.X := 0.015;
  1641. Scale.Y := 0.015;
  1642. Text := 'Z';
  1643. end;
  1644. FUIVisibleInfoLabels := TGLGizmoExUIFlatText(FUIRootVisibleInfoLabels.AddNewChild(TGLGizmoExUIFlatText));
  1645. with FUIVisibleInfoLabels do
  1646. begin
  1647. ModulateColor.Color := clrYellow;
  1648. Alignment := taCenter;
  1649. Layout := tlCenter;
  1650. Options := Options + [ftoTwoSided];
  1651. Position.Y := 1.8;
  1652. Position.X := 0;
  1653. Scale.X := 0.01;
  1654. Scale.Y := 0.01;
  1655. Text := '';
  1656. end;
  1657. HistoryStepsCount := 30;
  1658. BoundingBoxColor.Color := clrWhite;
  1659. VisibleInfoLabelsColor.Color := clrYellow;
  1660. SelectedColor.Color := clrYellow;
  1661. SelectionRegionColor.Color := clrBlack;
  1662. ShowAxisLabel := True;
  1663. ShowObjectInfos := True;
  1664. ShowBoundingBox := True;
  1665. FReferenceCoordSystem := rcsView;
  1666. FEnableHistory := True;
  1667. FinfoLabelCoordType := ilcChangeRate;
  1668. AntiAliasedLines := True;
  1669. FOperation := gopNone;
  1670. FSelAxis := gaNone;
  1671. EnableMultiSelection := True;
  1672. FSelectionRegion := gsrRectangular;
  1673. EnableLoopCursorMoving := True;
  1674. FUIRootHelpers.Visible := False;
  1675. OperationMode := gomSelect;
  1676. FVisibleVisibleInfoLabels := FVisibleVisibleInfoLabels + [vliName, vliOperation, vliCoords];
  1677. GizmoThickness := 1;
  1678. AutoZoom := True;
  1679. AutoZoomFactor := 5.0;
  1680. ZoomFactor := 0.35;
  1681. Enabled := True;
  1682. FNoZWrite := True;
  1683. FExcludeObjectsList := TStringList.Create;
  1684. FExcludeClassNameList := TStringList.Create;
  1685. end;
  1686. destructor TGLGizmoEx.Destroy;
  1687. begin
  1688. if Assigned(FRootGizmo) then
  1689. FRootGizmo.DeleteChildren
  1690. else
  1691. begin
  1692. FUIBaseGizmo.DeleteChildren;
  1693. FUIBaseGizmo.Free;
  1694. end;
  1695. FRootObjects := nil;
  1696. FGizmoTmpRoot := nil;
  1697. FBoundingBoxColor.Free;
  1698. SelectionRegionColor.Free;
  1699. FSelectedObjects.Free;
  1700. FSelectedColor.Free;
  1701. FVisibleInfoLabelsColor.Free;
  1702. FExcludeObjectsList.Free;
  1703. FExcludeClassNameList.Free;
  1704. // FUndoHistory has to be nil before Notification() is called.
  1705. FreeAndNil(FHistory);
  1706. inherited Destroy;
  1707. end;
  1708. procedure TGLGizmoEx.SetVisible(const AValue: Boolean);
  1709. begin
  1710. FUIBaseGizmo.Visible := AValue;
  1711. end;
  1712. function TGLGizmoEx.GetVisible: Boolean;
  1713. begin
  1714. Result := FUIBaseGizmo.Visible;
  1715. end;
  1716. procedure TGLGizmoEx.SetSelectionRegion(const AValue: TGLGizmoExSelectionRegion);
  1717. begin
  1718. if FSelectionRegion <> AValue then
  1719. FSelectionRegion := AValue;
  1720. end;
  1721. procedure TGLGizmoEx.SetShowAxisLabel(const AValue: Boolean);
  1722. begin
  1723. if FShowAxisLabel <> AValue then
  1724. begin
  1725. FShowAxisLabel := AValue;
  1726. FUIRootRotateAxisLabel.Visible := AValue;
  1727. if FOperationMode <> gomRotate then
  1728. FUIRootAxisLabel.Visible := AValue;
  1729. end;
  1730. end;
  1731. procedure TGLGizmoEx.SetSelAxis(aValue: TGLGizmoExAxis);
  1732. begin
  1733. if FSelAxis <> aValue then
  1734. begin
  1735. FSelAxis := aValue;
  1736. if Assigned(OnAxisSelected) then
  1737. OnAxisSelected(self, FSelAxis);
  1738. end;
  1739. end;
  1740. procedure TGLGizmoEx.SetPickMode(APickMode: TGLGizmoExPickMode);
  1741. begin
  1742. if APickMode <> FPickMode then
  1743. FPickMode := APickMode;
  1744. end;
  1745. procedure TGLGizmoEx.SetAutoZoomFactor(const AValue: Single);
  1746. begin
  1747. if (FAutoZoomFactor <> AValue) and (AValue > 0) then
  1748. begin
  1749. FAutoZoomFactor := AValue;
  1750. UpdateGizmo;
  1751. end;
  1752. end;
  1753. procedure TGLGizmoEx.SetZoomFactor(const AValue: Single);
  1754. begin
  1755. if (FZoomFactor <> AValue) and (AValue > 0) then
  1756. begin
  1757. FZoomFactor := AValue;
  1758. UpdateGizmo;
  1759. end;
  1760. end;
  1761. procedure TGLGizmoEx.SetShowObjectInfos(const AValue: Boolean);
  1762. begin
  1763. if FShowObjectInfos <> AValue then
  1764. begin
  1765. FShowObjectInfos := AValue;
  1766. FUIRootVisibleInfoLabels.Visible := FShowObjectInfos;
  1767. end;
  1768. end;
  1769. procedure TGLGizmoEx.SetShowBoundingBox(const AValue: Boolean);
  1770. begin
  1771. if FShowBoundingBox <> AValue then
  1772. FShowBoundingBox := AValue;
  1773. end;
  1774. function TGLGizmoEx.GetPickList: TGLPickList;
  1775. begin
  1776. Result := FSelectedObjects;
  1777. end;
  1778. procedure TGLGizmoEx.SetPickList(aValue: TGLPickList);
  1779. var
  1780. I: Integer;
  1781. begin
  1782. if FSelectedObjects <> aValue then
  1783. if aValue.Count - 1 >= 0 then
  1784. begin
  1785. FSelectedObjects.Clear;
  1786. for I := 0 to aValue.Count - 1 do
  1787. with aValue do
  1788. FSelectedObjects.AddHit(hit[I], SubObjects[I], NearDistance[I], FarDistance[I]);
  1789. UpdateGizmo();
  1790. end
  1791. else
  1792. LooseSelection();
  1793. end;
  1794. procedure TGLGizmoEx.SetSelectedObj(const Value: TGLBaseSceneObject);
  1795. begin
  1796. if FSelectedObjects.FindObject(Value) <> -1 then
  1797. Exit;
  1798. if (FSelectedObjects.Count - 1 >= 0) or (Value = nil) then
  1799. ClearSelection;
  1800. if Value <> nil then
  1801. FSelectedObjects.AddHit(Value, nil, 0, 0);
  1802. UpdateGizmo();
  1803. end;
  1804. function TGLGizmoEx.GetSelectedObj: TGLBaseSceneObject;
  1805. begin
  1806. Result := nil;
  1807. if FSelectedObjects.Count - 1 = -1 then
  1808. Result := nil
  1809. else
  1810. if FSelectedObjects.Count - 1 >= 0 then
  1811. Result := TGLBaseSceneObject(FSelectedObjects.Hit[0]);
  1812. end;
  1813. procedure TGLGizmoEx.AddObjToSelectionList(Obj: TGLBaseSceneObject);
  1814. begin
  1815. if (Obj <> nil) and (FSelectedObjects.FindObject(Obj) = -1) then
  1816. FSelectedObjects.AddHit(Obj, nil, 0, 0);
  1817. end;
  1818. procedure TGLGizmoEx.RemoveObjFromSelectionList(Obj: TGLBaseSceneObject);
  1819. var
  1820. I: Integer;
  1821. begin
  1822. I := FSelectedObjects.FindObject(Obj);
  1823. if I <> -1 then
  1824. FSelectedObjects.Delete(I);
  1825. end;
  1826. procedure TGLGizmoEx.AssignPickList(aList: TGLPickList; RemoveObj: Boolean = False);
  1827. function WithOutGizmoElements(obj: TGLBasesceneobject): Boolean;
  1828. begin
  1829. if (obj <> FInterfaceRender) and
  1830. (obj <> FInternalRender) and not (obj is TGLGizmoExUISphere) and not (obj is TGLGizmoExUIPolyGon) and not (obj is TGLGizmoExUITorus) and not (obj is TGLGizmoExUIFrustrum) and not (obj is TGLGizmoExUIArrowLine) and not (obj is TGLGizmoExUILines) and not (obj is TGLGizmoExUIDisk) and not (obj is TGLGizmoExUIFlatText) and not (CheckObjectInExcludeList(obj)) and not (CheckClassNameInExcludeList(obj)) then
  1831. Result := True
  1832. else
  1833. Result := False;
  1834. end;
  1835. var
  1836. I: Integer;
  1837. begin
  1838. for I := 0 to aList.Count - 1 do
  1839. with aList do
  1840. if WithOutGizmoElements(TGLBaseSceneObject(Hit[I])) then
  1841. if not RemoveObj then
  1842. begin
  1843. if (Hit[I] <> nil) and (FSelectedObjects.FindObject(Hit[I]) = -1) then
  1844. FSelectedObjects.AddHit(Hit[I], SubObjects[I], NearDistance[I], FarDistance[I]);
  1845. end
  1846. else
  1847. if (Hit[I] <> nil) and (FSelectedObjects.FindObject(Hit[I]) <> -1) then
  1848. FSelectedObjects.Delete(FSelectedObjects.FindObject(Hit[I]));
  1849. end;
  1850. procedure TGLGizmoEx.InterfaceRender(Sender: TObject; var rci: TGLRenderContextInfo);
  1851. procedure cLine(glc: TGLCanvas; p1, p2: TPoint);
  1852. begin
  1853. glc.Line(p1.X, p1.Y, p2.X, p2.Y);
  1854. end;
  1855. var
  1856. glc: TGLCanvas;
  1857. I: Integer;
  1858. LastCurPosX, LastCurPosY, CurPosX, CurPosY: Single;
  1859. begin
  1860. if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
  1861. Exit;
  1862. //here takes place rendering of lines and circles on canvas
  1863. //according to modes, it's a pity that canvas has restrictions
  1864. if FShowMultiSelecting then
  1865. begin
  1866. glc := TGLCanvas.Create(Viewer.Width, Viewer.Height);
  1867. glc.PenColor := FSelectionRegionColor.AsWinColor;
  1868. glc.PenWidth := 1;
  1869. LastCurPosX := fLastCursorPos.X;
  1870. LastCurPosY := fLastCursorPos.Y;
  1871. CurPosX := fCursorPos.X;
  1872. CurPosY := fCursorPos.Y;
  1873. with glc do
  1874. case FSelectionRegion of
  1875. gsrRectangular: FrameRect(LastCurPosX, LastCurPosY, CurPosX, CurPosY);
  1876. gsrCircular: Ellipse(LastCurPosX, LastCurPosY,
  1877. MaxFloat(abs(CurPosX - LastCurPosX),
  1878. abs(CurPosY - LastCurPosY)));
  1879. gsrFence:
  1880. begin
  1881. for I := Low(FSelectionRec) to High(FSelectionRec) do
  1882. if I <> High(FSelectionRec) then
  1883. cLine(glc, FSelectionRec[I], FSelectionRec[I + 1])
  1884. else
  1885. cLine(glc, FSelectionRec[I], fcursorPos);
  1886. //glc.PenWidth thickness of rectangle
  1887. //it's necessary to show that the begining and the end
  1888. // of a figure are joining and when cursor is near begining of array
  1889. // then appears square, that show to user that he picked right object
  1890. if High(FSelectionRec) > 0 then
  1891. with FSelectionRec[Low(FSelectionRec)] do
  1892. if IsInRange(CurPosX, X + 2, X - 2) and IsInRange(CurPosY, Y + 2, Y - 2) then
  1893. FillRect(CurPosX - PenWidth - 2, CurPosY - PenWidth - 2,
  1894. CurPosX + PenWidth + 2, CurPosY + PenWidth + 2);
  1895. end;
  1896. gsrLasso:
  1897. begin
  1898. //here showing arrays of lines
  1899. //when additional line formed by begining and and of array
  1900. for I := Low(FSelectionRec) to High(FSelectionRec) do
  1901. if I <> High(FSelectionRec) then
  1902. cLine(glc, FSelectionRec[I], FSelectionRec[I + 1])
  1903. else
  1904. cLine(glc, FSelectionRec[I], FSelectionRec[Low(FSelectionRec)]);
  1905. end;
  1906. end;
  1907. glc.Destroy;
  1908. end;
  1909. end;
  1910. procedure TGLGizmoEx.InternalRender(Sender: TObject; var rci: TGLRenderContextInfo);
  1911. procedure ShowBoundingBox(aObject: TGLBaseSceneObject);
  1912. const
  1913. ACorners: array [0..7, 0..2] of Byte = ((1, 3, 4),
  1914. (0, 2, 5),
  1915. (1, 6, 3),
  1916. (0, 2, 7),
  1917. (0, 5, 7),
  1918. (1, 4, 6),
  1919. (2, 5, 7),
  1920. (3, 4, 6));
  1921. var
  1922. I, J: Byte;
  1923. BB: THmgBoundingBox;
  1924. AVector: TGLVector;
  1925. begin
  1926. if aObject = nil then
  1927. Exit;
  1928. BB := aObject.BoundingBoxAbsolute(False);
  1929. for I := 0 to 7 do
  1930. begin
  1931. for J := 0 to 2 do
  1932. begin
  1933. AVector := VectorSubtract(BB.BBox[ACorners[I][J]], BB.BBox[I]);
  1934. AVector := VectorScale(AVector, 0.25);
  1935. AVector := VectorAdd(AVector, BB.BBox[I]);
  1936. gl.Begin_(GL_LINES);
  1937. gl.Vertex3f(BB.BBox[I].X, BB.BBox[I].Y, BB.BBox[I].Z);
  1938. gl.Vertex3f(AVector.X, AVector.Y, AVector.Z);
  1939. gl.End_;
  1940. end;
  1941. end;
  1942. end;
  1943. //test#12 result is positive, but only for 2d
  1944. //
  1945. procedure ShowText(const Text: UnicodeString; Position: TGLVector; Scale: TGLVector; Color: TGLVector);
  1946. var
  1947. FLayout: TTextLayout;
  1948. FAlignment: TAlignment;
  1949. wm: TGLMatrix;
  1950. I, J: Integer;
  1951. begin
  1952. if not Assigned(FLabelFont) and (Text = '') then
  1953. Exit;
  1954. rci.GLStates.Enable(stDepthTest);
  1955. FLayout := TTextLayout.tlCenter;
  1956. FAlignment := taCenter;
  1957. gl.MatrixMode(GL_MODELVIEW);
  1958. gl.PushMatrix;
  1959. wm := rci.PipelineTransformation.ViewMatrix^;
  1960. TransposeMatrix(wm);
  1961. for I := 0 to 2 do
  1962. for J := 0 to 2 do
  1963. if I = J then
  1964. wm.V[I].V[J] := 1
  1965. else
  1966. wm.V[I].V[J] := 0;
  1967. gl.LoadMatrixf(@wm);
  1968. rci.GLStates.PolygonMode := pmFill;
  1969. gl.Scalef(Scale.X, Scale.Y, Scale.Z);
  1970. gl.Translatef(Position.X, Position.Y, Position.Z);
  1971. if Color.W <> 1 then
  1972. begin
  1973. rci.GLStates.Enable(stBlend);
  1974. rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  1975. end;
  1976. rci.GLStates.Disable(stDepthTest);
  1977. rci.GLStates.Disable(stCullFace);
  1978. FLabelFont.RenderString(rci, Text, FAlignment, FLayout, Color);
  1979. gl.PopMatrix;
  1980. end;
  1981. var
  1982. I: Integer;
  1983. begin
  1984. if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
  1985. Exit;
  1986. if FShowBoundingBox and (FSelectedObjects.Count - 1 >= 0) then
  1987. begin
  1988. rci.GLStates.Disable(stLighting);
  1989. if FAntiAliasedLines then
  1990. rci.GLStates.Enable(stLineSmooth);
  1991. if (FGizmoThickness >= 0.5) and (FGizmoThickness <= 7) then
  1992. rci.GLStates.LineWidth := FGizmoThickness
  1993. else
  1994. rci.GLStates.LineWidth := 1;
  1995. gl.ColorMaterial(GL_FRONT, GL_EMISSION);
  1996. rci.GLStates.Enable(stColorMaterial);
  1997. gl.Color4fv(@FBoundingBoxColor.Color);
  1998. for I := 0 to FSelectedObjects.Count - 1 do
  1999. ShowBoundingBox(TGLBaseSceneObject(FSelectedObjects.Hit[I]));
  2000. end;
  2001. rci.GLStates.Disable(stColorMaterial);
  2002. end;
  2003. procedure TGLGizmoEx.SetReferenceCoordSystem(aValue: TGLGizmoExReferenceCoordinateSystem);
  2004. begin
  2005. if FReferenceCoordSystem <> aValue then
  2006. begin
  2007. FReferenceCoordSystem := aValue;
  2008. UpdateGizmo;
  2009. end;
  2010. end;
  2011. procedure TGLGizmoEx.SetHistoryStepsCount(aValue: Integer);
  2012. begin
  2013. if (FHistoryStepsCount <> aValue) and (aValue > 5) then
  2014. begin
  2015. FHistoryStepsCount := aValue;
  2016. FHistory.FItemsMaxCount := aValue;
  2017. end;
  2018. end;
  2019. procedure TGLGizmoEx.SetCanChangeWithChildren(AValue: Boolean);
  2020. begin
  2021. if FCanChangeWithChildren <> AValue then
  2022. FCanChangeWithChildren := AValue;
  2023. end;
  2024. procedure TGLGizmoEx.SetAALines(aValue: Boolean);
  2025. begin
  2026. if FAntiAliasedLines <> aValue then
  2027. begin
  2028. FAntiAliasedLines := aValue;
  2029. FUISelectLineX.AntiAliased := aValue;
  2030. FUISelectLineY.AntiAliased := aValue;
  2031. FUISelectLineZ.AntiAliased := aValue;
  2032. FUIMovementLineX.AntiAliased := aValue;
  2033. FUIMovementLineY.AntiAliased := aValue;
  2034. FUIMovementLineZ.AntiAliased := aValue;
  2035. FUIMovementLineXY.AntiAliased := aValue;
  2036. FUIMovementLineXZ.AntiAliased := aValue;
  2037. FUIMovementLineYZ.AntiAliased := aValue;
  2038. FUIRotateLineX.AntiAliased := aValue;
  2039. FUIRotateLineY.AntiAliased := aValue;
  2040. FUIRotateLineZ.AntiAliased := aValue;
  2041. FUIrotateLineXY.AntiAliased := aValue;
  2042. FUIRotateLineXZ.AntiAliased := aValue;
  2043. FUIRotateLineArrowX.AntiAliased := aValue;
  2044. FUIRotateLineArrowY.AntiAliased := aValue;
  2045. FUIRotateLineArrowZ.AntiAliased := aValue;
  2046. FUIScaleLineX.AntiAliased := aValue;
  2047. FUIScaleLineY.AntiAliased := aValue;
  2048. FUIScaleLineZ.AntiAliased := aValue;
  2049. FUIScaleLineXY.AntiAliased := aValue;
  2050. FUIScaleLineXZ.AntiAliased := aValue;
  2051. FUIScaleLineYZ.AntiAliased := aValue;
  2052. end;
  2053. end;
  2054. procedure TGLGizmoEx.SetInfoLabelCoordType(aValue: TInfoLabelCoordType);
  2055. begin
  2056. if fInfoLabelCoordType <> aValue then
  2057. begin
  2058. fInfoLabelCoordType := aValue;
  2059. UpdateVisibleInfoLabels;
  2060. end;
  2061. end;
  2062. procedure TGLGizmoEx.SetAngleDisk(aAngle: Single);
  2063. var
  2064. Disk1alpha, Disk2alpha, Disk1Angle, Disk2Angle: Single;
  2065. begin
  2066. Disk1alpha := 0;
  2067. Disk2alpha := 0;
  2068. Disk1Angle := 0;
  2069. Disk2Angle := 0;
  2070. if aAngle = 0 then
  2071. begin
  2072. fchangerate := NullVector;
  2073. FUIRotateDiskX.SweepAngle := 0;
  2074. FUIRotateDiskY.SweepAngle := 0;
  2075. FUIRotateDiskZ.SweepAngle := 0;
  2076. FUIRotateDiskX.Material.FrontProperties.Diffuse.Alpha := 0;
  2077. FUIRotateDiskY.Material.FrontProperties.Diffuse.Alpha := 0;
  2078. FUIRotateDiskZ.Material.FrontProperties.Diffuse.Alpha := 0;
  2079. FUIRotateDiskX2.SweepAngle := 0;
  2080. FUIRotateDiskY2.SweepAngle := 0;
  2081. FUIRotateDiskZ2.SweepAngle := 0;
  2082. FUIRotateDiskX2.Material.FrontProperties.Diffuse.Alpha := 0;
  2083. FUIRotateDiskY2.Material.FrontProperties.Diffuse.Alpha := 0;
  2084. FUIRotateDiskZ2.Material.FrontProperties.Diffuse.Alpha := 0;
  2085. end
  2086. else
  2087. if (abs(aAngle) > 0) and (abs(aAngle) <= 360) then
  2088. begin
  2089. Disk1alpha := 0.3;
  2090. Disk2alpha := 0;
  2091. Disk1Angle := aAngle;
  2092. Disk2Angle := 0;
  2093. end
  2094. else
  2095. if (abs(aAngle) > 360) and (abs(aAngle) <= 720) then
  2096. begin
  2097. Disk1alpha := 0.3;
  2098. Disk2alpha := 0.3;
  2099. Disk1Angle := 360;
  2100. if aAngle > 0 then
  2101. Disk2Angle := aAngle - 360
  2102. else
  2103. Disk2Angle := aAngle + 360;
  2104. end
  2105. else
  2106. if (abs(aAngle) > 720) and (abs(aAngle) <= 1080) then
  2107. begin
  2108. Disk1alpha := 0.5;
  2109. Disk2alpha := 0.3;
  2110. Disk1Angle := 360;
  2111. if aAngle > 0 then
  2112. Disk2Angle := aAngle - 720
  2113. else
  2114. Disk2Angle := aAngle + 720;
  2115. end
  2116. else
  2117. if (abs(aAngle) > 1080) and (abs(aAngle) <= 1440) then
  2118. begin
  2119. Disk1alpha := 0.6;
  2120. Disk2alpha := 0.3;
  2121. Disk1Angle := 360;
  2122. if aAngle > 0 then
  2123. Disk2Angle := aAngle - 1080
  2124. else
  2125. Disk2Angle := aAngle + 1080;
  2126. end
  2127. else
  2128. if (abs(aAngle) > 1440) then
  2129. begin
  2130. Disk1alpha := 0.6;
  2131. Disk2alpha := 0.3;
  2132. Disk1Angle := 360;
  2133. Disk2Angle := 360;
  2134. end;
  2135. case SelAxis of
  2136. gaX:
  2137. begin
  2138. FUIRotateDiskX.SweepAngle := Disk1Angle;
  2139. FUIRotateDiskX.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
  2140. FUIRotateDiskX2.SweepAngle := Disk2Angle;
  2141. FUIRotateDiskX2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
  2142. end;
  2143. gaY:
  2144. begin
  2145. FUIRotateDiskY.SweepAngle := Disk1Angle;
  2146. FUIRotateDiskY.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
  2147. FUIRotateDiskY2.SweepAngle := Disk2Angle;
  2148. FUIRotateDiskY2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
  2149. end;
  2150. gaZ:
  2151. begin
  2152. FUIRotateDiskZ.SweepAngle := Disk1Angle;
  2153. FUIRotateDiskZ.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
  2154. FUIRotateDiskZ2.SweepAngle := Disk2Angle;
  2155. FUIRotateDiskZ2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
  2156. end;
  2157. end;
  2158. end;
  2159. procedure TGLGizmoEx.SetBoundingBoxColor(const AValue: TGLColor);
  2160. begin
  2161. if AValue <> FBoundingBoxColor then
  2162. begin
  2163. FBoundingBoxColor.Color := AValue.Color;
  2164. UpdateGizmo;
  2165. end;
  2166. end;
  2167. procedure TGLGizmoEx.SetSelectedColor(const AValue: TGLColor);
  2168. begin
  2169. if AValue <> FSelectedColor then
  2170. begin
  2171. FSelectedColor.Color := AValue.Color;
  2172. UpdateGizmo;
  2173. end;
  2174. end;
  2175. procedure TGLGizmoEx.SetOperation(const Value: TGLGizmoExOperation);
  2176. begin
  2177. if FOperation <> Value then
  2178. begin
  2179. FOperation := Value;
  2180. if Assigned(OnOperationChange) then
  2181. OnOperationChange(self);
  2182. end;
  2183. end;
  2184. procedure TGLGizmoEx.SetOperationMode(const Value: TGLGizmoExOperationMode);
  2185. begin
  2186. if FOperationMode <> Value then
  2187. begin
  2188. FOperationMode := Value;
  2189. if Value = gomNone then
  2190. begin
  2191. Visible := False;
  2192. Enabled := False;
  2193. end
  2194. else
  2195. begin
  2196. Visible := True;
  2197. Enabled := True;
  2198. end;
  2199. if Value = gomSelect then
  2200. FUIRootSelect.Visible := True
  2201. else
  2202. FUIRootSelect.Visible := False;
  2203. if Value = gomMove then
  2204. FUIRootMovement.Visible := True
  2205. else
  2206. FUIRootMovement.Visible := False;
  2207. if Value = gomrotate then
  2208. begin
  2209. FUIRootAxisLabel.Visible := False;
  2210. FUIRootRotate.Visible := True;
  2211. end
  2212. else
  2213. begin
  2214. FUIRootRotate.Visible := False;
  2215. FUIRootAxisLabel.Visible := ShowAxisLabel;
  2216. end;
  2217. if Value = gomscale then
  2218. FUIRootScale.Visible := True
  2219. else
  2220. FUIRootScale.Visible := False;
  2221. if Assigned(OnOperationModeChange) then
  2222. OnOperationModeChange(self);
  2223. UpdateGizmo;
  2224. end;
  2225. end;
  2226. procedure TGLGizmoEx.SetNoZWrite(const Value: Boolean);
  2227. begin
  2228. if fNoZWrite <> Value then
  2229. begin
  2230. fNoZWrite := Value;
  2231. //For Select
  2232. FUISelectLineX.NoZWrite := Value;
  2233. FUISelectLineY.NoZWrite := Value;
  2234. FUISelectLineZ.NoZWrite := Value;
  2235. //For Move
  2236. FUIMovementLineX.NoZWrite := Value;
  2237. FUIMovementLineY.NoZWrite := Value;
  2238. FUIMovementLineZ.NoZWrite := Value;
  2239. FUIMovementLineXY.NoZWrite := Value;
  2240. FUIMovementLineXZ.NoZWrite := Value;
  2241. FUIMovementLineYZ.NoZWrite := Value;
  2242. FUIMovementArrowX.NoZWrite := Value;
  2243. FUIMovementArrowY.NoZWrite := Value;
  2244. FUIMovementArrowZ.NoZWrite := Value;
  2245. FUIMovementPlaneXY.NoZWrite := Value;
  2246. FUIMovementPlaneXZ.NoZWrite := Value;
  2247. FUIMovementPlaneYZ.NoZWrite := Value;
  2248. FUIICMovementLineX.NoZWrite := Value;
  2249. FUIICMovementLineY.NoZWrite := Value;
  2250. FUIICMovementLineZ.NoZWrite := Value;
  2251. FUIICMovementLineXY.NoZWrite := Value;
  2252. FUIICMovementLineXZ.NoZWrite := Value;
  2253. FUIICMovementLineYZ.NoZWrite := Value;
  2254. //ForRotate
  2255. FUIRotateLineX.NoZWrite := Value;
  2256. FUIRotateLineY.NoZWrite := Value;
  2257. FUIRotateLineZ.NoZWrite := Value;
  2258. FUIRotateLineXY.NoZWrite := Value;
  2259. FUIRotateLineXZ.NoZWrite := Value;
  2260. FUIICRotateTorusX.NoZWrite := Value;
  2261. FUIICRotateTorusY.NoZWrite := Value;
  2262. FUIICRotateTorusZ.NoZWrite := Value;
  2263. FUIICRotateTorusXZ.NoZWrite := Value;
  2264. FUIRotateDiskXY.NoZWrite := Value;
  2265. FUIRotateDiskX.NoZWrite := Value;
  2266. FUIRotateDiskY.NoZWrite := Value;
  2267. FUIRotateDiskZ.NoZWrite := Value;
  2268. FUIRotateDiskX2.NoZWrite := Value;
  2269. FUIRotateDiskY2.NoZWrite := Value;
  2270. FUIRotateDiskZ2.NoZWrite := Value;
  2271. FUIICRotateSphereXY.NoZWrite := Value;
  2272. FUIRotateLineArrowX.NoZWrite := Value;
  2273. FUIRotateLineArrowY.NoZWrite := Value;
  2274. FUIRotateLineArrowZ.NoZWrite := Value;
  2275. FUIRotateAxisLabelX.NoZWrite := Value;
  2276. FUIRotateAxisLabelY.NoZWrite := Value;
  2277. FUIRotateAxisLabelZ.NoZWrite := Value;
  2278. //ForScale
  2279. FUIScaleArrowX.NoZWrite := Value;
  2280. FUIScaleArrowY.NoZWrite := Value;
  2281. FUIScaleArrowZ.NoZWrite := Value;
  2282. FUIScaleLineX.NoZWrite := Value;
  2283. FUIScaleLineY.NoZWrite := Value;
  2284. FUIScaleLineZ.NoZWrite := Value;
  2285. FUIScaleLineXY.NoZWrite := Value;
  2286. FUIScaleLineYZ.NoZWrite := Value;
  2287. FUIScaleLineXZ.NoZWrite := Value;
  2288. FUIICScaleLineX.NoZWrite := Value;
  2289. FUIICScaleLineY.NoZWrite := Value;
  2290. FUIICScaleLineZ.NoZWrite := Value;
  2291. FUIICScaleLineXY.NoZWrite := Value;
  2292. FUIICScaleLineXZ.NoZWrite := Value;
  2293. FUIICScaleLineYZ.NoZWrite := Value;
  2294. FUIICScaleLineXYZ.NoZWrite := Value;
  2295. FUIScalePlaneXY.NoZWrite := Value;
  2296. FUIScalePlaneXZ.NoZWrite := Value;
  2297. FUIScalePlaneYZ.NoZWrite := Value;
  2298. FUIScalePlaneXYZ.NoZWrite := Value;
  2299. FUIAxisLabelX.NoZWrite := Value;
  2300. FUIAxisLabelY.NoZWrite := Value;
  2301. FUIAxisLabelZ.NoZWrite := Value;
  2302. FUIVisibleInfoLabels.NoZWrite := Value;
  2303. end;
  2304. end;
  2305. procedure TGLGizmoEx.SetEnableLoopCursorMoving(const AValue: Boolean);
  2306. begin
  2307. if FEnableLoopCursorMoving <> AValue then
  2308. FEnableLoopCursorMoving := AValue;
  2309. end;
  2310. procedure TGLGizmoEx.SetEnableMultiSelection(const AValue: Boolean);
  2311. begin
  2312. if FEnableMultiSelection <> AValue then
  2313. begin
  2314. FEnableMultiSelection := AValue;
  2315. FInterfaceRender.Visible := AValue;
  2316. end;
  2317. end;
  2318. procedure TGLGizmoEx.MultiSelMouseDown(X, Y: Integer);
  2319. begin
  2320. flastcursorPos := Point(X, Y);
  2321. fcursorPos := point(X, Y);
  2322. if (fSelectionRegion = gsrFence) and FShowMultiSelecting then
  2323. begin
  2324. SetLength(FSelectionRec, Length(FSelectionRec) + 1);
  2325. FSelectionRec[high(FSelectionRec)] := point(X, Y);
  2326. end;
  2327. end;
  2328. procedure TGLGizmoEx.MultiSelMouseMove(X, Y: Integer);
  2329. begin
  2330. //calculation starts when the mouse button is down
  2331. //ans distance from pick pisition is not more then 10
  2332. if Moving and not FShowMultiSelecting and
  2333. (Dist(point(X, Y), flastcursorPos) > 10) then
  2334. begin
  2335. FShowMultiSelecting := True;
  2336. if fSelectionRegion = gsrFence then
  2337. begin
  2338. SetLength(FSelectionRec, Length(FSelectionRec) + 1);
  2339. FSelectionRec[high(FSelectionRec)] := point(X, Y);
  2340. end;
  2341. end;
  2342. if FShowMultiSelecting then
  2343. begin
  2344. fcursorPos := point(X, Y);
  2345. //creating lines when moving mouse
  2346. if (fSelectionRegion = gsrLasso) and
  2347. //clculate distance between two points to view as in 3D Max
  2348. (Dist(point(X, Y), flastcursorPos) > 20) then
  2349. begin
  2350. flastcursorPos := point(X, Y);
  2351. SetLength(FSelectionRec, Length(FSelectionRec) + 1);
  2352. FSelectionRec[high(FSelectionRec)] := point(X, Y);
  2353. end;
  2354. end;
  2355. end;
  2356. procedure TGLGizmoEx.MultiSelMouseUp(X, Y: Integer);
  2357. procedure SelectAssignMode(pick: TGLPickList);
  2358. begin
  2359. if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
  2360. AssignPickList(pick)
  2361. else
  2362. if FCanRemoveObjFromSelectionList then
  2363. AssignPickList(pick, FCanRemoveObjFromSelectionList)
  2364. else
  2365. if FCanAddObjtoSelectionList then
  2366. AssignPickList(pick);
  2367. end;
  2368. var
  2369. I, J: Integer;
  2370. pick: TGLPickList;
  2371. p1, p2: TPoint;
  2372. Line: TGLGizmoExSelRec;
  2373. LastCurPosX, LastCurPosY, CurPosX, CurPosY: Single;
  2374. begin
  2375. LastCurPosX := flastcursorPos.X;
  2376. LastCurPosY := flastcursorPos.Y;
  2377. CurPosX := fcursorPos.X;
  2378. CurPosY := fcursorPos.Y;
  2379. if (fSelectionRegion = gsrRectangular) then
  2380. begin
  2381. pick := InternalGetPickedObjects(X - 1, Y - 1, flastcursorPos.X + 1, flastcursorPos.Y + 1, 8);
  2382. if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
  2383. FSelectedObjects.Clear;
  2384. SelectAssignMode(pick);
  2385. pick.Free;
  2386. if Assigned(onSelect) then
  2387. onSelect(self, FSelectedObjects);
  2388. FShowMultiSelecting := False;
  2389. end;
  2390. if (fSelectionRegion = gsrCircular) then
  2391. begin
  2392. FShowMultiSelecting := False;
  2393. if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
  2394. FSelectedObjects.Clear;
  2395. for I := 0 to viewer.Height - 1 do
  2396. if IsLineIntCirlce(Maxfloat(abs(CurPosX - LastCurPosX),
  2397. abs(CurPosY - LastCurPosY)),
  2398. flastcursorPos, point(0, I), point(viewer.Width, I), p1, p2) >= 0 then
  2399. if (I mod 2 = 0) then
  2400. begin
  2401. pick := InternalGetPickedObjects(p2.X - 1, p2.Y - 1, p1.X + 1, p1.Y + 1, 8);
  2402. SelectAssignMode(pick);
  2403. pick.Free;
  2404. end;
  2405. if Assigned(onSelect) then
  2406. onSelect(self, FSelectedObjects);
  2407. end;
  2408. if (fSelectionRegion = gsrFence) and (high(FSelectionRec) > 0) then
  2409. with FSelectionRec[Low(FSelectionRec)] do
  2410. //verify if a pick is near point, not to seek a centre
  2411. if IsInRange(CurPosX, X + 2, X - 2) and IsInRange(CurPosY, Y + 2, Y - 2) then
  2412. begin
  2413. FShowMultiSelecting := False;
  2414. //connect the begining and end
  2415. SetLength(FSelectionRec, Length(FSelectionRec) + 1);
  2416. FSelectionRec[high(FSelectionRec)] := point(X, Y);
  2417. if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
  2418. FSelectedObjects.Clear;
  2419. for J := 0 to viewer.Height - 1 do
  2420. for I := 0 to viewer.Width - 1 do
  2421. begin
  2422. if IsPointInPolygon(FSelectionRec, point(I, J)) then
  2423. begin
  2424. if not IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
  2425. begin
  2426. SetLength(line, Length(line) + 1);
  2427. line[high(line)] := point(I, J);
  2428. end;
  2429. end
  2430. else
  2431. if IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
  2432. begin
  2433. SetLength(line, Length(line) + 1);
  2434. line[high(line)] := point(I, J);
  2435. end;
  2436. end;
  2437. for I := 0 to High(line) do
  2438. if (I mod 2 = 0) then
  2439. begin
  2440. pick := InternalGetPickedObjects(line[I].X - 1, line[I].Y - 1, line[I + 1].X + 1, line[I + 1].Y + 1, 8);
  2441. SelectAssignMode(pick);
  2442. pick.Free;
  2443. end;
  2444. if Assigned(onSelect) then
  2445. onSelect(self, FSelectedObjects);
  2446. //nulling of array
  2447. SetLength(line, 0);
  2448. SetLength(FSelectionRec, 0);
  2449. end;
  2450. if (fSelectionRegion = gsrLasso) then
  2451. begin
  2452. FShowMultiSelecting := False;
  2453. SetLength(FSelectionRec, Length(FSelectionRec) + 1);
  2454. FSelectionRec[high(FSelectionRec)] := FSelectionRec[Low(FSelectionRec)];
  2455. if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
  2456. FSelectedObjects.Clear;
  2457. for J := 0 to viewer.Height - 1 do
  2458. for I := 0 to viewer.Width - 1 do
  2459. begin
  2460. if IsPointInPolygon(FSelectionRec, point(I, J)) then
  2461. begin
  2462. if not IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
  2463. begin
  2464. SetLength(line, Length(line) + 1);
  2465. line[high(line)] := point(I, J);
  2466. end;
  2467. end
  2468. else
  2469. if IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
  2470. begin
  2471. SetLength(line, Length(line) + 1);
  2472. line[high(line)] := point(I, J);
  2473. end;
  2474. end;
  2475. for I := 0 to High(line) do
  2476. if (I mod 2 = 0) then
  2477. begin
  2478. pick := InternalGetPickedObjects(line[I].X - 1, line[I].Y - 1, line[I + 1].X + 1, line[I + 1].Y + 1, 8);
  2479. SelectAssignMode(pick);
  2480. pick.Free;
  2481. end;
  2482. SetLength(line, 0);
  2483. SetLength(FSelectionRec, 0);
  2484. if Assigned(onSelect) then
  2485. onSelect(self, FSelectedObjects);
  2486. end;
  2487. end;
  2488. procedure TGLGizmoEx.SetVisibleInfoLabelsColor(const AValue: TGLColor);
  2489. begin
  2490. if AValue <> FSelectedColor then
  2491. begin
  2492. FVisibleInfoLabelsColor.Color := AValue.Color;
  2493. FUIVisibleInfoLabels.ModulateColor.Color := AValue.Color;
  2494. FVisibleInfoLabelsColorChanged := True;
  2495. UpdateGizmo;
  2496. end;
  2497. end;
  2498. procedure TGLGizmoEx.SetSelectionRegionColor(const AValue: TGLColor);
  2499. begin
  2500. if AValue <> FSelectionRegionColor then
  2501. begin
  2502. FSelectionRegionColor.Color := AValue.Color;
  2503. end;
  2504. end;
  2505. procedure TGLGizmoEx.SeTGLGizmoExVisibleInfoLabels(const AValue: TGLGizmoExVisibleInfoLabels);
  2506. begin
  2507. if AValue <> FVisibleVisibleInfoLabels then
  2508. begin
  2509. FVisibleVisibleInfoLabels := AValue;
  2510. if not (csDesigning in ComponentState) then
  2511. UpdateGizmo;
  2512. end;
  2513. end;
  2514. procedure TGLGizmoEx.UndoAdd(const AObject: TObject);
  2515. begin
  2516. if AObject <> nil then
  2517. FHistory.AddObject(AObject);
  2518. end;
  2519. procedure TGLGizmoEx.RemoveSelectedObjects;
  2520. begin
  2521. if not Assigned(FHistory.FGizmoTmpRoot) then
  2522. Exit;
  2523. FHistory.RemoveObjects(SelectedObjects);
  2524. FHistory.AddObjects(SelectedObjects);
  2525. UpdateGizmo();
  2526. end;
  2527. procedure TGLGizmoEx.SetRootGizmo(const AValue: TGLBaseSceneObject);
  2528. begin
  2529. if FRootGizmo <> AValue then
  2530. begin
  2531. if FRootGizmo <> nil then
  2532. FRootGizmo.RemoveFreeNotification(Self);
  2533. FRootGizmo := AValue;
  2534. if FRootGizmo <> nil then
  2535. FRootGizmo.FreeNotification(Self);
  2536. FUIBaseGizmo.MoveTo(AValue);
  2537. end;
  2538. end;
  2539. procedure TGLGizmoEx.SetGizmoTmpRoot(const AValue: TGLBaseSceneObject);
  2540. begin
  2541. if FGizmoTmpRoot <> AValue then
  2542. begin
  2543. if FGizmoTmpRoot <> nil then
  2544. FGizmoTmpRoot.RemoveFreeNotification(Self);
  2545. FGizmoTmpRoot := AValue;
  2546. FGizmoTmpRoot.Visible := False;
  2547. FHistory.GizmoTmpRoot := FGizmoTmpRoot;
  2548. end;
  2549. end;
  2550. procedure TGLGizmoEx.SetRootObjects(const AValue: TGLBaseSceneObject);
  2551. begin
  2552. if fRootObjects <> AValue then
  2553. begin
  2554. if fRootObjects <> nil then
  2555. fRootObjects.RemoveFreeNotification(Self);
  2556. fRootObjects := AValue;
  2557. end;
  2558. end;
  2559. procedure TGLGizmoEx.SetExcludeObjectsList(const AValue: TStrings);
  2560. begin
  2561. FExcludeObjectsList.Clear;
  2562. FExcludeObjectsList.AddStrings(AValue);
  2563. end;
  2564. procedure TGLGizmoEx.SetExcludeClassNameList(const AValue: TStrings);
  2565. begin
  2566. FExcludeClassNameList.Clear;
  2567. FExcludeClassNameList.AddStrings(AValue);
  2568. end;
  2569. procedure TGLGizmoEx.SetGLGizmoExThickness(const Value: Single);
  2570. begin
  2571. if (FGizmoThickness <> Value) and (Value > 0.2) then
  2572. begin
  2573. FGizmoThickness := Value;
  2574. FUISelectLineX.LineWidth := 1 * Value;
  2575. FUISelectLineY.LineWidth := 1 * Value;
  2576. FUISelectLineZ.LineWidth := 1 * Value;
  2577. FUIMovementLineX.LineWidth := 1 * Value;
  2578. FUIMovementLineY.LineWidth := 1 * Value;
  2579. FUIMovementLineZ.LineWidth := 1 * Value;
  2580. FUIMovementLineXY.LineWidth := 1 * Value;
  2581. FUIMovementLineXZ.LineWidth := 1 * Value;
  2582. FUIMovementLineYZ.LineWidth := 1 * Value;
  2583. FUIRotateLineX.LineWidth := 1 * Value;
  2584. FUIRotateLineY.LineWidth := 1 * Value;
  2585. FUIRotateLineZ.LineWidth := 1 * Value;
  2586. FUIrotateLineXY.LineWidth := 1 * Value;
  2587. FUIRotateLineXZ.LineWidth := 1 * Value;
  2588. FUIRotateLineArrowX.LineWidth := 1 * Value;
  2589. FUIRotateLineArrowY.LineWidth := 1 * Value;
  2590. FUIRotateLineArrowZ.LineWidth := 1 * Value;
  2591. FUIScaleLineX.LineWidth := 1 * Value;
  2592. FUIScaleLineY.LineWidth := 1 * Value;
  2593. FUIScaleLineZ.LineWidth := 1 * Value;
  2594. FUIScaleLineXY.LineWidth := 1 * Value;
  2595. FUIScaleLineXZ.LineWidth := 1 * Value;
  2596. FUIScaleLineYZ.LineWidth := 1 * Value;
  2597. end;
  2598. end;
  2599. //------------------------------------------------------------------------------
  2600. procedure TGLGizmoEx.SetLabelFont(const Value: TGLCustomBitmapFont);
  2601. begin
  2602. if FLabelFont <> Value then
  2603. begin
  2604. if FLabelFont <> nil then
  2605. FLabelFont.RemoveFreeNotification(Self);
  2606. FLabelFont := Value;
  2607. if FLabelFont <> nil then
  2608. FLabelFont.FreeNotification(Self);
  2609. FUIAxisLabelX.BitmapFont := Value;
  2610. FUIAxisLabelY.BitmapFont := Value;
  2611. FUIAxisLabelZ.BitmapFont := Value;
  2612. FUIRotateAxisLabelX.BitmapFont := Value;
  2613. FUIRotateAxisLabelY.BitmapFont := Value;
  2614. FUIRotateAxisLabelZ.BitmapFont := Value;
  2615. FUIVisibleInfoLabels.BitmapFont := Value;
  2616. end;
  2617. end;
  2618. function TGLGizmoEx.InternalGetPickedObjects(const x1, y1, x2, y2: Integer; const guessCount: Integer): TGLPickList;
  2619. procedure AddObjectToPicklList(const root: TGLBaseSceneObject; PickList: TGLPickList; X, Y: Integer);
  2620. var
  2621. t: Integer;
  2622. dist: Single;
  2623. rayStart, rayVector, iPoint, iNormal: TGLVector;
  2624. begin
  2625. SetVector(rayStart, Viewer.Camera.AbsolutePosition);
  2626. SetVector(rayVector, Viewer.Buffer.ScreenToVector(AffineVectorMake(X, Viewer.Height - Y, 0)));
  2627. NormalizeVector(rayVector);
  2628. for t := 0 to root.Count - 1 do
  2629. if root[t].Visible then
  2630. begin
  2631. if (root[t].RayCastIntersect(rayStart, rayVector, @iPoint, @iNormal)) and
  2632. (VectorDotProduct(rayVector, iNormal) < 0) then
  2633. if PickList.FindObject(root[t]) = -1 then
  2634. begin
  2635. dist := VectorLength(VectorSubtract(iPoint, rayStart));
  2636. PickList.AddHit(root[t], nil, dist, 0);
  2637. end;
  2638. AddObjectToPicklList(root[t], PickList, X, Y);
  2639. end;
  2640. end;
  2641. var
  2642. I, J: Integer;
  2643. minx, miny, maxx, maxy: Integer;
  2644. begin
  2645. case FPickMode of
  2646. pmGetPickedObjects:
  2647. begin
  2648. Result := Viewer.Buffer.GetPickedObjects(rect(x1, y1, x2, y2), guessCount);
  2649. end;
  2650. pmRayCast:
  2651. begin
  2652. Result := TGLPickList.Create(psMinDepth);
  2653. maxX := MaxInteger(x1, x2);
  2654. maxY := MaxInteger(Y1, Y2);
  2655. minX := MinInteger(x1, x2);
  2656. minY := MinInteger(Y1, Y2);
  2657. for J := minY to maxY do
  2658. for I := minX to maxX do
  2659. //uploading to exclude hanging of application :)
  2660. if (I mod 4 = 0) or (J mod 4 = 0) then
  2661. AddObjectToPicklList(RootObjects, Result, I, J);
  2662. AddObjectToPicklList(RootGizmo, Result, round((x1 + x2) * 0.5), round((y1 + y2) * 0.5));
  2663. end;
  2664. else
  2665. begin
  2666. Result := nil;
  2667. Assert(False, strUnknownType);
  2668. end;
  2669. end;
  2670. end;
  2671. procedure TGLGizmoEx.Loaded;
  2672. begin
  2673. inherited;
  2674. SeTGLGizmoExThickness(GizmoThickness);
  2675. end;
  2676. //------------------------------------------------------------------------------
  2677. procedure TGLGizmoEx.UpdateVisibleInfoLabels;
  2678. var
  2679. T: string;
  2680. X, Y, Z: Single;
  2681. obj: TGLBaseSceneObject;
  2682. begin
  2683. t := '';
  2684. X := 0;
  2685. Y := 0;
  2686. Z := 0;
  2687. if FSelectedObjects.Count - 1 < 0 then
  2688. Exit;
  2689. if (FSelectedObjects.Count - 1 = 0) and (vliName in FVisibleVisibleInfoLabels) then
  2690. t := TGLBaseSceneObject(FSelectedObjects[0]).Name;
  2691. if vliOperation in FVisibleVisibleInfoLabels then
  2692. begin
  2693. begin
  2694. if Length(t) > 0 then
  2695. T := T + ' - ';
  2696. case Operation of
  2697. gopNone: T := T + 'Selected';
  2698. gopMove: T := T + 'Move';
  2699. gopRotate: T := T + 'Rotate';
  2700. gopScale: T := T + 'Scale';
  2701. end;
  2702. end;
  2703. end;
  2704. if vliCoords in FVisibleVisibleInfoLabels then
  2705. begin
  2706. if (Operation <> gopNone) then
  2707. begin
  2708. if Length(t) > 0 then
  2709. T := T + ' - ';
  2710. if FinfoLabelCoordType = ilcChanging then
  2711. begin
  2712. obj := TGLBaseSceneObject(FSelectedObjects[0]);
  2713. case Operation of
  2714. gopMove:
  2715. begin
  2716. X := obj.Position.X;
  2717. Y := obj.Position.Y;
  2718. Z := obj.Position.Z;
  2719. end;
  2720. gopRotate:
  2721. begin
  2722. X := obj.Rotation.X;
  2723. Y := obj.Rotation.Y;
  2724. Z := obj.Rotation.Z;
  2725. end;
  2726. gopScale:
  2727. begin
  2728. X := obj.Scale.X;
  2729. Y := obj.Scale.Y;
  2730. Z := obj.Scale.Z;
  2731. end;
  2732. end;
  2733. T := T + '[' + Format('%2.2f', [X]);
  2734. T := T + ' ' + Format('%2.2f', [Y]);
  2735. T := T + ' ' + Format('%2.2f', [Z]) + ']';
  2736. end
  2737. else
  2738. begin
  2739. T := T + '[' + Format('%2.2f', [FChangeRate.X]);
  2740. T := T + ' ' + Format('%2.2f', [FChangeRate.Y]);
  2741. T := T + ' ' + Format('%2.2f', [FChangeRate.Z]) + ']';
  2742. end;
  2743. end;
  2744. end;
  2745. FUIVisibleInfoLabels.Text := T;
  2746. FUIVisibleInfoLabels.StructureChanged;
  2747. end;
  2748. //------------------------------------------------------------------------------
  2749. function TGLGizmoEx.CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
  2750. var
  2751. I: Integer;
  2752. begin
  2753. Result := False;
  2754. if FExcludeObjects then
  2755. begin
  2756. for I := 0 to FExcludeObjectsList.Count - 1 do
  2757. begin
  2758. if UpperCase(obj.Name) = UpperCase(FExcludeObjectsList[I]) then
  2759. begin
  2760. Result := True;
  2761. Exit;
  2762. end;
  2763. end;
  2764. end;
  2765. end;
  2766. function TGLGizmoEx.CheckClassNameInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
  2767. var
  2768. I: Integer;
  2769. begin
  2770. Result := False;
  2771. if FExcludeClassName then
  2772. begin
  2773. for I := 0 to FExcludeClassNameList.Count - 1 do
  2774. begin
  2775. if UpperCase(obj.ClassName) = UpperCase(FExcludeClassNameList[I]) then
  2776. begin
  2777. Result := True;
  2778. Exit;
  2779. end;
  2780. end;
  2781. end;
  2782. end;
  2783. function TGLGizmoEx.MouseWorldPos(const X, Y: Integer): TGLVector;
  2784. var
  2785. v: TGLVector;
  2786. InvertedY: Integer;
  2787. begin
  2788. InvertedY := Viewer.Height - Y;
  2789. SetVector(v, X, InvertedY, 0);
  2790. case selAxis of
  2791. gaX: Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
  2792. gaY: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
  2793. gaZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
  2794. gaXY: Viewer.Buffer.ScreenVectorIntersectWithPlaneXY(v, FUIRootHelpers.AbsolutePosition.Z, Result);
  2795. gaYZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
  2796. gaXZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
  2797. gaXYZ:
  2798. begin
  2799. Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
  2800. MakeVector(Result, InvertedY / 25, InvertedY / 25, InvertedY / 25);
  2801. end;
  2802. end;
  2803. end;
  2804. procedure TGLGizmoEx.ActivatingElements(PickList: TGLPickList);
  2805. procedure ActlightRotateLine(const line: TGLLines; const dark: TGLVector);
  2806. var
  2807. v: TVector4f;
  2808. I: Integer;
  2809. begin
  2810. line.options := [loUseNodeColorForLines];
  2811. for I := 0 to line.Nodes.Count - 1 do
  2812. begin
  2813. v := FUIRotateLineXY.AbsoluteToLocal((line.LocalToAbsolute(line.Nodes[I].AsVector)));
  2814. if v.Z >= 0 then
  2815. begin
  2816. TGLLinesNode(line.Nodes[I]).Color.Color := FSelectedColor.Color;
  2817. TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
  2818. end
  2819. else
  2820. begin
  2821. TGLLinesNode(line.Nodes[I]).Color.Color := dark;
  2822. TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
  2823. end;
  2824. end;
  2825. end;
  2826. procedure DeActlightRotateLine(const line: TGLLines; const dark: TGLVector);
  2827. var
  2828. v: TVector4f;
  2829. I: Integer;
  2830. begin
  2831. line.options := [loUseNodeColorForLines];
  2832. for I := 0 to line.Nodes.Count - 1 do
  2833. begin
  2834. v := FUIRotateLineXY.AbsoluteToLocal((line.LocalToAbsolute(line.Nodes[I].AsVector)));
  2835. if v.Z >= 0 then
  2836. begin
  2837. TGLLinesNode(line.Nodes[I]).Color.Color := dark;
  2838. TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
  2839. end
  2840. else
  2841. begin
  2842. TGLLinesNode(line.Nodes[I]).Color.Color := dark;
  2843. TGLLinesNode(line.Nodes[I]).Color.Alpha := 0;
  2844. end;
  2845. end;
  2846. end;
  2847. procedure ActlightLine(const line: TGLLines);
  2848. begin
  2849. line.LineColor.color := FSelectedColor.Color;
  2850. line.Options := [];
  2851. end;
  2852. procedure DeActlightLine(const line: TGLLines; const dark: TGLVector; alterStyle: Boolean = False);
  2853. begin
  2854. with line.LineColor do
  2855. if (AsWinColor = FSelectedColor.AsWinColor) then
  2856. begin
  2857. color := dark;
  2858. line.Options := [];
  2859. if alterStyle then
  2860. line.options := [loUseNodeColorForLines];
  2861. end;
  2862. end;
  2863. procedure ActlightRotateArrowLine(const line: TGLLines; Color: TGLVector);
  2864. begin
  2865. line.LineColor.color := Color;
  2866. line.Options := [];
  2867. end;
  2868. procedure DeActlightRotateArrowLine(const line: TGLLines; const dark: TGLVector);
  2869. begin
  2870. if not VectorEquals(line.LineColor.Color, dark) then
  2871. begin
  2872. line.LineColor.Color := dark;
  2873. line.Options := [];
  2874. end;
  2875. end;
  2876. procedure Actlightobject(const aObject: TGLCustomSceneObject);
  2877. begin
  2878. aObject.Material.FrontProperties.Diffuse.Alpha := 0.4;
  2879. aObject.Visible := True;
  2880. end;
  2881. procedure DeActlightObject(const aObject: TGLCustomSceneObject);
  2882. begin
  2883. aObject.Visible := False;
  2884. end;
  2885. procedure ActlightText(const FlatText: TGLFlatText);
  2886. begin
  2887. FlatText.ModulateColor.Color := FSelectedColor.Color;
  2888. end;
  2889. procedure DeActlightText(const FlatText: TGLFlatText; const dark: TGLVector);
  2890. begin
  2891. with FlatText.ModulateColor do
  2892. if AsWinColor = FSelectedColor.AsWinColor then
  2893. Color := dark;
  2894. end;
  2895. procedure ActlightTextRotate(const FlatText: TGLFlatText; Color: TGLVector);
  2896. begin
  2897. FlatText.ModulateColor.Color := Color;
  2898. end;
  2899. procedure DeActlightTextRotate(const FlatText: TGLFlatText; const dark: TGLVector);
  2900. begin
  2901. with FlatText.ModulateColor do
  2902. if not VectorEquals(Color, dark) then
  2903. Color := dark;
  2904. end;
  2905. procedure AssingOpertion(const aOperation: TGLGizmoExOperation; const axis: TGLGizmoExAxis);
  2906. begin
  2907. if Operation <> aOperation then
  2908. Operation := aOperation;
  2909. if SelAxis <> axis then
  2910. SelAxis := axis;
  2911. end;
  2912. var
  2913. I: Integer;
  2914. begin
  2915. AssingOpertion(gopNone, gaNone);
  2916. if FUIRootMovement.Visible then
  2917. begin
  2918. DeActlightObject(FUIMovementPlaneXY);
  2919. DeActlightObject(FUIMovementPlaneXZ);
  2920. DeActlightObject(FUIMovementPlaneYZ);
  2921. DeActlightLine(FUIMovementLineX, clrRed);
  2922. DeActlightLine(FUIMovementLineY, clrLime);
  2923. DeActlightLine(FUIMovementLineZ, clrBlue);
  2924. DeActlightLine(FUIMovementLineXY, clrWhite, True);
  2925. DeActlightLine(FUIMovementLineXZ, clrWhite, True);
  2926. DeActlightLine(FUIMovementLineYZ, clrWhite, True);
  2927. end;
  2928. if FUIRootRotate.Visible then
  2929. begin
  2930. DeActlightObject(FUIRotateDiskXY);
  2931. DeActlightLine(FUIRotateLineXZ, clrgray70);
  2932. DeActlightRotateArrowLine(FUIRotateLineArrowX, clrgray70);
  2933. DeActlightRotateArrowLine(FUIRotateLineArrowY, clrgray70);
  2934. DeActlightRotateArrowLine(FUIRotateLineArrowZ, clrgray70);
  2935. DeActlightRotateLine(FUIRotateLineX, clrRed);
  2936. DeActlightRotateLine(FUIRotateLineY, clrLime);
  2937. DeActlightRotateLine(FUIRotateLineZ, clrBlue);
  2938. DeActlightTextRotate(FUIRotateAxisLabelX, clrgray70);
  2939. DeActlightTextRotate(FUIRotateAxisLabelY, clrgray70);
  2940. DeActlightTextRotate(FUIRotateAxisLabelZ, clrgray70);
  2941. end;
  2942. if FUIRootScale.Visible then
  2943. begin
  2944. DeActlightLine(FUIScaleLineX, clrRed);
  2945. DeActlightLine(FUIScaleLineY, clrLime);
  2946. DeActlightLine(FUIScaleLineZ, clrBlue);
  2947. DeActlightLine(FUIScaleLineXY, clrWhite, True);
  2948. DeActlightLine(FUIScaleLineYZ, clrWhite, True);
  2949. DeActlightLine(FUIScaleLineXZ, clrWhite, True);
  2950. DeActlightObject(FUIScalePlaneXY);
  2951. DeActlightObject(FUIScalePlaneXZ);
  2952. DeActlightObject(FUIScalePlaneYZ);
  2953. DeActlightObject(FUIScalePlaneXYZ);
  2954. end;
  2955. DeActlightText(FUIAxisLabelX, clrRed);
  2956. DeActlightText(FUIAxisLabelY, clrLime);
  2957. DeActlightText(FUIAxisLabelZ, clrBlue);
  2958. for I := 0 to pickList.Count - 1 do
  2959. with pickList do
  2960. begin
  2961. if FUIRootMovement.Visible then
  2962. begin
  2963. if hit[I] = FUIICMovementLineXY then
  2964. begin
  2965. AssingOpertion(gopMove, gaXY);
  2966. ActlightObject(FUIMovementPlaneXY);
  2967. ActlightLine(FUIMovementLineX);
  2968. ActlightLine(FUIMovementLineY);
  2969. ActlightLine(FUIMovementLineXY);
  2970. ActlightText(FUIAxisLabelX);
  2971. ActlightText(FUIAxisLabelY);
  2972. Break;
  2973. end;
  2974. if hit[I] = FUIICMovementLineXZ then
  2975. begin
  2976. AssingOpertion(gopMove, gaXZ);
  2977. Actlightobject(FUIMovementPlaneXZ);
  2978. ActlightLine(FUIMovementLineX);
  2979. ActlightLine(FUIMovementLineZ);
  2980. ActlightLine(FUIMovementLineXZ);
  2981. ActlightText(FUIAxisLabelX);
  2982. ActlightText(FUIAxisLabelZ);
  2983. Break;
  2984. end;
  2985. if hit[I] = FUIICMovementLineYZ then
  2986. begin
  2987. AssingOpertion(gopMove, gaYZ);
  2988. Actlightobject(FUIMovementPlaneYZ);
  2989. ActlightLine(FUIMovementLineY);
  2990. ActlightLine(FUIMovementLineZ);
  2991. ActlightLine(FUIMovementLineYZ);
  2992. ActlightText(FUIAxisLabelY);
  2993. ActlightText(FUIAxisLabelZ);
  2994. Break;
  2995. end;
  2996. if hit[I] = FUIICMovementLineX then
  2997. begin
  2998. AssingOpertion(gopMove, gaX);
  2999. ActlightLine(FUIMovementLineX);
  3000. ActlightText(FUIAxisLabelX);
  3001. Break;
  3002. end;
  3003. if hit[I] = FUIICMovementLineY then
  3004. begin
  3005. AssingOpertion(gopMove, gaY);
  3006. ActlightLine(FUIMovementLineY);
  3007. ActlightText(FUIAxisLabelY);
  3008. Break;
  3009. end;
  3010. if hit[I] = FUIICMovementLineZ then
  3011. begin
  3012. AssingOpertion(gopMove, gaZ);
  3013. ActlightLine(FUIMovementLineZ);
  3014. ActlightText(FUIAxisLabelZ);
  3015. Break;
  3016. end;
  3017. end;
  3018. if FUIRootRotate.Visible then
  3019. begin
  3020. if hit[I] = FUIICRotateTorusX then
  3021. begin
  3022. AssingOpertion(gopRotate, gaX);
  3023. ActlightRotateLine(FUIRotateLineX, clrgray50);
  3024. ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
  3025. DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
  3026. Break;
  3027. end;
  3028. if hit[I] = FUIICRotateTorusY then
  3029. begin
  3030. AssingOpertion(gopRotate, gaY);
  3031. ActlightRotateLine(FUIRotateLineY, clrgray50);
  3032. ActlightRotateArrowLine(FUIRotateLineArrowY, clrLime);
  3033. DeActlightTextRotate(FUIRotateAxisLabelY, clrLime);
  3034. Break;
  3035. end;
  3036. if hit[I] = FUIICRotateTorusZ then
  3037. begin
  3038. AssingOpertion(gopRotate, gaZ);
  3039. ActlightRotateLine(FUIRotateLineZ, clrgray50);
  3040. ActlightRotateArrowLine(FUIRotateLineArrowZ, clrBlue);
  3041. DeActlightTextRotate(FUIRotateAxisLabelZ, clrBlue);
  3042. Break;
  3043. end;
  3044. if hit[I] = FUIICRotateSphereXY then
  3045. begin
  3046. AssingOpertion(gopRotate, gaXY);
  3047. ActlightObject(FUIRotateDiskXY);
  3048. DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
  3049. DeActlightTextRotate(FUIRotateAxisLabelY, clrLime);
  3050. ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
  3051. ActlightRotateArrowLine(FUIRotateLineArrowY, clrLime);
  3052. Break;
  3053. end;
  3054. if hit[I] = FUIICRotateTorusXZ then
  3055. begin
  3056. AssingOpertion(gopRotate, gaXZ);
  3057. ActlightLine(FUIRotateLineXZ);
  3058. DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
  3059. DeActlightTextRotate(FUIRotateAxisLabelZ, clrBlue);
  3060. ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
  3061. ActlightRotateArrowLine(FUIRotateLineArrowZ, clrBlue);
  3062. Break;
  3063. end;
  3064. end;
  3065. if FUIRootScale.Visible then
  3066. begin
  3067. if hit[I] = FUIICScaleLineX then
  3068. begin
  3069. AssingOpertion(gopScale, gaX);
  3070. ActlightLine(FUIScaleLineX);
  3071. ActlightText(FUIAxisLabelX);
  3072. Break;
  3073. end;
  3074. if hit[I] = FUIICScaleLineY then
  3075. begin
  3076. AssingOpertion(gopScale, gaY);
  3077. ActlightLine(FUIScaleLineY);
  3078. ActlightText(FUIAxisLabelY);
  3079. Break;
  3080. end;
  3081. if hit[I] = FUIICScaleLineZ then
  3082. begin
  3083. AssingOpertion(gopScale, gaZ);
  3084. ActlightLine(FUIScaleLineZ);
  3085. ActlightText(FUIAxisLabelZ);
  3086. Break;
  3087. end;
  3088. if hit[I] = FUIICScaleLineXY then
  3089. begin
  3090. AssingOpertion(gopScale, gaXY);
  3091. Actlightobject(FUIScalePlaneXY);
  3092. ActlightLine(FUIScaleLineXY);
  3093. ActlightText(FUIAxisLabelX);
  3094. ActlightText(FUIAxisLabelY);
  3095. Break;
  3096. end;
  3097. if hit[I] = FUIICScaleLineXZ then
  3098. begin
  3099. AssingOpertion(gopScale, gaXZ);
  3100. Actlightobject(FUIScalePlaneXZ);
  3101. ActlightLine(FUIScaleLineXZ);
  3102. ActlightText(FUIAxisLabelX);
  3103. ActlightText(FUIAxisLabelZ);
  3104. Break;
  3105. end;
  3106. if hit[I] = FUIICScaleLineYZ then
  3107. begin
  3108. AssingOpertion(gopScale, gaYZ);
  3109. Actlightobject(FUIScalePlaneYZ);
  3110. ActlightLine(FUIScaleLineYZ);
  3111. ActlightText(FUIAxisLabelY);
  3112. ActlightText(FUIAxisLabelZ);
  3113. Break;
  3114. end;
  3115. if hit[I] = FUIICScaleLineXYZ then
  3116. begin
  3117. AssingOpertion(gopScale, gaXYZ);
  3118. Actlightobject(FUIScalePlaneXYZ);
  3119. ActlightText(FUIAxisLabelX);
  3120. ActlightText(FUIAxisLabelY);
  3121. ActlightText(FUIAxisLabelZ);
  3122. Actlightobject(FUIScalePlaneXY);
  3123. ActlightLine(FUIScaleLineXY);
  3124. Actlightobject(FUIScalePlaneYZ);
  3125. ActlightLine(FUIScaleLineYZ);
  3126. Actlightobject(FUIScalePlaneXZ);
  3127. ActlightLine(FUIScaleLineXZ);
  3128. Break;
  3129. end;
  3130. end;
  3131. end;
  3132. end;
  3133. procedure TGLGizmoEx.ViewerMouseMove(const X, Y: Integer);
  3134. var
  3135. pickList: TGLPickList;
  3136. mousePos: TGLVector;
  3137. includeCh: Boolean;
  3138. function FindParent(parent: TGLBaseSceneObject): Boolean;
  3139. begin
  3140. Result := False;
  3141. if assigned(parent) then
  3142. begin
  3143. if parent = rootobjects then
  3144. Exit;
  3145. Result := FSelectedObjects.FindObject(parent) = -1;
  3146. end;
  3147. end;
  3148. procedure OpeMove(mousePos: TGLVector);
  3149. var
  3150. vec1, vec2: TGLVector;
  3151. quantizedMousePos, quantizedMousePos2: TGLVector;
  3152. I: Integer;
  3153. begin
  3154. if VectorNorm(lastMousePos) = 0 then
  3155. Exit;
  3156. for I := 0 to 3 do
  3157. begin
  3158. quantizedMousePos.V[I] := (Round(mousePos.V[I] / MoveCoef)) * MoveCoef;
  3159. quantizedMousePos2.V[I] := (Round(lastMousePos.V[I] / MoveCoef)) * MoveCoef;
  3160. end;
  3161. case SelAxis of
  3162. gaX:
  3163. begin
  3164. MakeVector(vec1, quantizedMousePos.X, 0, 0);
  3165. makeVector(vec2, quantizedMousePos2.X, 0, 0);
  3166. end;
  3167. gaY:
  3168. begin
  3169. MakeVector(vec1, 0, quantizedMousePos.Y, 0);
  3170. makeVector(vec2, 0, quantizedMousePos2.Y, 0);
  3171. end;
  3172. gaZ:
  3173. begin
  3174. MakeVector(vec1, 0, 0, quantizedMousePos.Z);
  3175. makeVector(vec2, 0, 0, quantizedMousePos2.Z);
  3176. end;
  3177. else
  3178. begin
  3179. vec1 := quantizedMousePos;
  3180. vec2 := quantizedMousePos2;
  3181. end;
  3182. end;
  3183. SubtractVector(vec1, vec2);
  3184. //Control of object flying to infinity
  3185. if (VectorLength(Vec1) > 5) then
  3186. Exit;// prevents NAN problems
  3187. case SelAxis of
  3188. gaX: fchangerate.X := fchangerate.X + vec1.X;
  3189. gaY: fchangerate.Y := fchangerate.Y + vec1.Y;
  3190. gaZ: fchangerate.Z := fchangerate.Z + vec1.Z;
  3191. gaXY:
  3192. begin
  3193. fchangerate.X := fchangerate.X + vec1.X;
  3194. fchangerate.Y := fchangerate.Y + vec1.Y;
  3195. end;
  3196. gaYZ:
  3197. begin
  3198. fchangerate.Z := fchangerate.Z + vec1.Z;
  3199. fchangerate.Y := fchangerate.Y + vec1.Y;
  3200. end;
  3201. gaXZ:
  3202. begin
  3203. fchangerate.X := fchangerate.X + vec1.X;
  3204. fchangerate.Z := fchangerate.Z + vec1.Z;
  3205. end;
  3206. end;
  3207. for I := 0 to FSelectedObjects.Count - 1 do
  3208. with TGLBaseSceneObject(FSelectedObjects.Hit[I]) do
  3209. begin
  3210. IncludeCh := True;
  3211. if not CanChangeWithChildren and (parent <> RootObjects) and (FSelectedObjects.Count - 1 > 0) then
  3212. IncludeCh := FindParent(parent);
  3213. if IncludeCh then
  3214. case Ord(ReferenceCoordSystem) of
  3215. 0: AbsolutePosition := VectorAdd(absoluteposition, vec1);
  3216. 1:
  3217. begin
  3218. vec1 := LocalToAbsolute(vec1);
  3219. absoluteposition := VectorAdd(absoluteposition, vec1);
  3220. end;
  3221. end;
  3222. end;
  3223. end;
  3224. procedure OpeRotate(const X, Y: Integer);
  3225. var
  3226. vec1: TGLVector;
  3227. rotV: TAffineVector;
  3228. pmat: TGLMatrix;
  3229. I: Integer;
  3230. IncludeCh: Boolean;
  3231. v: TGLVector;
  3232. begin
  3233. vec1.X := 0;
  3234. vec1.Y := 0;
  3235. if abs(X - mx) >= RotationCoef then
  3236. begin
  3237. if RotationCoef > 1 then
  3238. vec1.X := RotationCoef * (Round((X - mx) / (RotationCoef)))
  3239. else
  3240. vec1.X := RotationCoef * (X - mx);
  3241. mx := X;
  3242. end;
  3243. if abs(Y - my) >= RotationCoef then
  3244. begin
  3245. if RotationCoef > 1 then
  3246. vec1.Y := RotationCoef * (Round((Y - my) / (RotationCoef)))
  3247. else
  3248. vec1.Y := RotationCoef * (Y - my);
  3249. my := Y;
  3250. end;
  3251. vec1.Z := 0;
  3252. vec1.W := 0;
  3253. case SelAxis of
  3254. gaX: fchangerate.Y := fchangerate.Y + vec1.Y;
  3255. gaY: fchangerate.X := fchangerate.X + vec1.X;
  3256. gaZ: fchangerate.Y := fchangerate.Y + vec1.Y;
  3257. end;
  3258. for I := 0 to FSelectedObjects.Count - 1 do
  3259. with FSelectedObjects do
  3260. begin
  3261. case Ord(FReferenceCoordSystem) of
  3262. 0: v := FUIRootHelpers.AbsolutePosition;
  3263. 1: v := TGLBaseSceneObject(Hit[I]).AbsolutePosition;
  3264. end;
  3265. IncludeCh := True;
  3266. if not CanChangeWithChildren
  3267. and (TGLBaseSceneObject(Hit[I]).parent <> RootObjects)
  3268. and (FSelectedObjects.Count - 1 > 0) then
  3269. IncludeCh := FindParent(TGLBaseSceneObject(Hit[I]).parent);
  3270. pmat := TGLBaseSceneObject(Hit[I]).parent.InvAbsoluteMatrix;
  3271. SetVector(pmat.V[3], NullHmgPoint);
  3272. if IncludeCh then
  3273. case SelAxis of
  3274. gaX:
  3275. begin
  3276. rotV := VectorTransform(XVector, pmat);
  3277. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
  3278. end;
  3279. gaY:
  3280. begin
  3281. rotV := VectorTransform(YVector, pmat);
  3282. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
  3283. end;
  3284. gaZ:
  3285. begin
  3286. rotV := VectorTransform(ZVector, pmat);
  3287. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
  3288. end;
  3289. gaXY:
  3290. begin
  3291. rotV := VectorTransform(XVector, pmat);
  3292. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
  3293. rotV := VectorTransform(YVector, pmat);
  3294. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
  3295. end;
  3296. gaXZ:
  3297. begin
  3298. rotV := VectorTransform(XVector, pmat);
  3299. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
  3300. rotV := VectorTransform(ZVector, pmat);
  3301. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
  3302. end;
  3303. gaYZ:
  3304. begin
  3305. rotV := VectorTransform(YVector, pmat);
  3306. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
  3307. rotV := VectorTransform(ZVector, pmat);
  3308. RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
  3309. end;
  3310. end;
  3311. end;
  3312. end;
  3313. procedure OpeScale(const mousePos: TGLVector);
  3314. var
  3315. vec1, vec2: TGLVector;
  3316. quantizedMousePos, quantizedMousePos2: TGLVector;
  3317. t: Integer;
  3318. begin
  3319. if VectorNorm(lastMousePos) = 0 then
  3320. Exit;
  3321. for t := 0 to 3 do
  3322. begin
  3323. quantizedMousePos.V[t] := (Round(mousePos.V[t] / ScaleCoef)) * FScaleCoef;
  3324. quantizedMousePos2.V[t] := (Round(lastMousePos.V[t] / FScaleCoef)) * FScaleCoef;
  3325. end;
  3326. case SelAxis of
  3327. gaX:
  3328. begin
  3329. MakeVector(vec1, quantizedMousePos.X, 0, 0);
  3330. makeVector(vec2, quantizedMousePos2.X, 0, 0);
  3331. end;
  3332. gaY:
  3333. begin
  3334. MakeVector(vec1, 0, quantizedMousePos.Y, 0);
  3335. makeVector(vec2, 0, quantizedMousePos2.Y, 0);
  3336. end;
  3337. gaZ:
  3338. begin
  3339. MakeVector(vec1, 0, 0, quantizedMousePos.Z);
  3340. makeVector(vec2, 0, 0, quantizedMousePos2.Z);
  3341. end;
  3342. gaXY:
  3343. begin
  3344. MakeVector(vec1, quantizedMousePos.X, quantizedMousePos.Y, 0);
  3345. makeVector(vec2, quantizedMousePos2.X, quantizedMousePos2.Y, 0);
  3346. end;
  3347. gaXYZ:
  3348. begin
  3349. MakeVector(vec1, quantizedMousePos.X, quantizedMousePos.Y, quantizedMousePos.Z);
  3350. makeVector(vec2, quantizedMousePos2.X, quantizedMousePos2.Y, quantizedMousePos2.Z);
  3351. end
  3352. else
  3353. begin
  3354. vec1 := quantizedMousePos;
  3355. vec2 := quantizedMousePos2;
  3356. end;
  3357. end;
  3358. SubtractVector(vec1, vec2);
  3359. if (VectorLength(Vec1) > 5) then
  3360. Exit;// prevents NAN problems
  3361. case SelAxis of
  3362. gaX: fchangerate.X := fchangerate.X + vec1.X;
  3363. gaY: fchangerate.Y := fchangerate.Y + vec1.Y;
  3364. gaZ: fchangerate.Z := fchangerate.Z + vec1.Z;
  3365. gaXY:
  3366. begin
  3367. fchangerate.X := fchangerate.X + vec1.X;
  3368. fchangerate.Y := fchangerate.Y + vec1.Y;
  3369. end;
  3370. gaYZ:
  3371. begin
  3372. fchangerate.Z := fchangerate.Z + vec1.Z;
  3373. fchangerate.Y := fchangerate.Y + vec1.Y;
  3374. end;
  3375. gaXZ:
  3376. begin
  3377. fchangerate.X := fchangerate.X + vec1.X;
  3378. fchangerate.Z := fchangerate.Z + vec1.Z;
  3379. end;
  3380. gaXYZ:
  3381. fchangerate := VectorAdd(fchangerate, AffineVectorMake(vec1));
  3382. end;
  3383. for t := 0 to FSelectedObjects.Count - 1 do
  3384. with TGLBaseSceneObject(FSelectedObjects.Hit[t]) do
  3385. begin
  3386. IncludeCh := True;
  3387. if not CanChangeWithChildren and (parent <> RootObjects) and (FSelectedObjects.Count - 1 > 0) then
  3388. IncludeCh := FindParent(parent);
  3389. FUIRootScale.Scale.Translate(vec1);
  3390. if IncludeCh then
  3391. begin
  3392. { case ord(ReferenceCoordSystem) of
  3393. 0:begin
  3394. vec1:=LocalToAbsolute(vec1);
  3395. absoluteScale:=VectorAdd(absolutescale,vec1);
  3396. end;
  3397. 1:Scale.Translate(vec1);
  3398. end; }
  3399. Scale.Translate(vec1);
  3400. end;
  3401. end;
  3402. end;
  3403. procedure LoopCursorMoving(isvector: Boolean = False);
  3404. {$IFDEF MSWINDOWS}
  3405. var
  3406. R, vR: TRect;
  3407. cp: TPoint;
  3408. {$ENDIF}
  3409. begin
  3410. {$IFDEF MSWINDOWS}
  3411. //Ïðîöåäóðà äëÿ ïåðåâîäà êóðñîðà èç íà÷àëà â êîíåö
  3412. //áåç ïîòåðü îïåðàöèé íàä îáüåêòîì
  3413. GetWindowRect(GetDesktopWindow, R);
  3414. GetWindowRect(viewer.Handle, VR);
  3415. GLGetCursorPos(cp);
  3416. if cp.Y = R.Bottom - 1 then
  3417. begin
  3418. SetCursorPos(cp.X, R.Top + 3);
  3419. if not isvector then
  3420. my := r.Top - vr.Top
  3421. else
  3422. begin
  3423. lastMousePos := MouseWorldPos(X, r.Top + 3 - vr.Top);
  3424. //ââåäåíî ÷òî áû îáüåêò íå äåðãàëñÿ
  3425. mousepos := lastMousePos;
  3426. end;
  3427. end;
  3428. if cp.Y = R.Top then
  3429. begin
  3430. SetCursorPos(cp.X, R.Bottom - 3);
  3431. if not isvector then
  3432. my := R.Bottom - 1 - vr.top
  3433. else
  3434. begin
  3435. lastMousePos := MouseWorldPos(X, R.Bottom - 1 - vr.top);
  3436. mousepos := lastMousePos;
  3437. end;
  3438. end;
  3439. if cp.X = R.Right - 1 then
  3440. begin
  3441. SetCursorPos(r.Left + 3, cp.Y);
  3442. if not isvector then
  3443. mx := r.Left - vr.Left
  3444. else
  3445. begin
  3446. lastMousePos := MouseWorldPos(r.Left - vr.Left, Y);
  3447. mousepos := lastMousePos;
  3448. end;
  3449. end;
  3450. if cp.X = R.Left then
  3451. begin
  3452. SetCursorPos(r.Right - 3, cp.Y);
  3453. if not isvector then
  3454. mx := r.Right - 1 - vr.Left
  3455. else
  3456. begin
  3457. lastMousePos := MouseWorldPos(r.Right - 1 - vr.Left, Y);
  3458. mousepos := lastMousePos;
  3459. end;
  3460. end;
  3461. {$ENDIF}
  3462. end;
  3463. begin
  3464. if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
  3465. Exit;
  3466. if not FShowMultiSelecting then
  3467. begin
  3468. if (FSelectedObjects.Count - 1 >= 0) and (SelAxis <> gaNone) and moving then
  3469. begin
  3470. mousePos := MouseWorldPos(X, Y);
  3471. //moving object...
  3472. if Operation = gopMove then
  3473. begin
  3474. OpeMove(MousePos);
  3475. end
  3476. else if Operation = gopRotate then
  3477. begin
  3478. if EnableLoopCursorMoving then
  3479. LoopCursorMoving;
  3480. OpeRotate(X, Y);
  3481. if (SelAxis = gax) or (SelAxis = gaz) then
  3482. SetAngleDisk(fchangerate.Y)
  3483. else
  3484. if SelAxis = gaY then
  3485. SetAngleDisk(fchangerate.X);
  3486. end
  3487. else if Operation = gopScale then
  3488. begin
  3489. if EnableLoopCursorMoving then
  3490. LoopCursorMoving(True);
  3491. OpeScale(MousePos);
  3492. end;
  3493. UpdateGizmo;
  3494. mx := X;
  3495. my := Y;
  3496. lastMousePos := mousePos;
  3497. Exit;
  3498. end;
  3499. Assert(FViewer <> nil, 'Viewer not Assigned to gizmo');
  3500. picklist := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);//Viewer.buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1), 8);
  3501. ActivatingElements(picklist);
  3502. picklist.Free;
  3503. end;
  3504. if EnableMultiSelection and (Operation = gopNone) and (SelAxis = gaNone) then
  3505. MultiSelMouseMove(X, Y);
  3506. mx := X;
  3507. my := Y;
  3508. end;
  3509. procedure TGLGizmoEx.ViewerMouseDown(const X, Y: Integer);
  3510. function SetInitialDiskPostition(aObject, aObject2: TGLCustomSceneObject): TGLVector;
  3511. var
  3512. rayStart, rayVector, iPoint, iNormal: TGLVector;
  3513. begin
  3514. if (Viewer = nil) then
  3515. Exit;
  3516. if (Viewer.Camera = nil) then
  3517. Exit;
  3518. SetVector(rayStart, Viewer.Camera.AbsolutePosition);
  3519. SetVector(rayVector, Viewer.Buffer.ScreenToVector(AffineVectorMake(X, Viewer.Height - Y, 0)));
  3520. NormalizeVector(rayVector);
  3521. if aObject.RayCastIntersect(rayStart, rayVector, @iPoint, @iNormal) then
  3522. aObject2.Up.Setvector(VectorNormalize(VectorSubtract(iPoint, FUIRootHelpers.Position.AsVector)));
  3523. aObject2.StructureChanged;
  3524. Result := iPoint;
  3525. end;
  3526. var
  3527. pick: TGLPickList;
  3528. I: Integer;
  3529. gotPick: Boolean;
  3530. begin
  3531. if not Enabled or
  3532. not Assigned(RootGizmo) or
  3533. not Assigned(RootObjects) or
  3534. not Assigned(Viewer) then
  3535. Exit;
  3536. mx := X;
  3537. my := Y;
  3538. pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1);
  3539. gotPick := False;
  3540. for I := 0 to pick.Count - 1 do
  3541. if (pick.Hit[I] is TGLGizmoExUIDisk) or
  3542. (pick.Hit[I] is TGLGizmoExUISphere) or
  3543. (pick.Hit[I] is TGLGizmoExUIPolyGon) or
  3544. (pick.Hit[I] is TGLGizmoExuITorus) or
  3545. (pick.Hit[I] is TGLGizmoExUIFrustrum) or
  3546. (pick.Hit[I] is TGLGizmoExUIArrowLine) or
  3547. (pick.Hit[I] is TGLGizmoExUIFlatText) or
  3548. (pick.Hit[I] is TGLGizmoExUILines) then
  3549. begin
  3550. gotPick := True;
  3551. case fOperation of
  3552. gopRotate:
  3553. begin
  3554. if (pick.Hit[I] = FUIICRotateTorusX) then
  3555. begin
  3556. SetInitialDiskPostition(FUIICRotateTorusX, FUIRotateDiskx);
  3557. SetInitialDiskPostition(FUIICRotateTorusX, FUIRotateDiskx2);
  3558. end;
  3559. if (pick.Hit[I] = FUIICRotateTorusY) then
  3560. begin
  3561. SetInitialDiskPostition(FUIICRotateTorusY, FUIRotateDiskY);
  3562. SetInitialDiskPostition(FUIICRotateTorusY, FUIRotateDiskY2);
  3563. end;
  3564. if (pick.Hit[I] = FUIICRotateTorusZ) then
  3565. begin
  3566. SetInitialDiskPostition(FUIICRotateTorusZ, FUIRotateDiskZ);
  3567. SetInitialDiskPostition(FUIICRotateTorusZ, FUIRotateDiskZ2);
  3568. end;
  3569. end;
  3570. end;
  3571. end;
  3572. if not FShowMultiSelecting and not gotPick then
  3573. begin
  3574. for I := 0 to pick.Count - 1 do
  3575. if (pick.Hit[I] <> FInterfaceRender) and
  3576. (pick.Hit[I] <> FInternalRender) and not (pick.Hit[I] is TGLGizmoExUISphere)
  3577. and not (pick.Hit[I] is TGLGizmoExUIPolyGon)
  3578. and not (pick.Hit[I] is TGLGizmoExuITorus)
  3579. and not (pick.Hit[I] is TGLGizmoExUIFrustrum)
  3580. and not (pick.Hit[I] is TGLGizmoExUIArrowLine)
  3581. and not (pick.Hit[I] is TGLGizmoExUILines)
  3582. and not (pick.Hit[I] is TGLGizmoExUIFlatText)
  3583. and not (CheckObjectInExcludeList(TGLBaseSceneObject(pick.hit[I])))
  3584. and not (CheckClassNameInExcludeList(TGLBaseSceneObject(pick.hit[I]))) then
  3585. begin
  3586. //Clear list
  3587. if not EnableMultiSelection then
  3588. ClearSelection
  3589. else
  3590. if (pick.Count - 1 >= 0) and
  3591. (FSelectedObjects.FindObject(pick.Hit[I]) = -1) then
  3592. if not FCanAddObjToSelectionList and not FCanRemoveObjFromSelectionList then
  3593. ClearSelection;
  3594. if not FCanRemoveObjFromSelectionList then
  3595. AddObjToSelectionList(TGLBaseSceneObject(pick.Hit[I]))
  3596. else
  3597. RemoveObjFromSelectionList(TGLBaseSceneObject(pick.Hit[I]));
  3598. if Assigned(onSelect) then
  3599. onSelect(self, FSelectedObjects);
  3600. UpdateGizmo();
  3601. Break;
  3602. end;
  3603. end
  3604. else
  3605. UpdateVisibleInfoLabels();
  3606. pick.Free;
  3607. moving := True;
  3608. lastMousePos := MouseWorldPos(X, Y);
  3609. if EnableMultiSelection then
  3610. MultiSelMouseDown(X, Y);
  3611. end;
  3612. procedure TGLGizmoEx.ViewerMouseUp(const X, Y: Integer);
  3613. var
  3614. pick: TGLPickList;
  3615. begin
  3616. if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
  3617. Exit;
  3618. moving := False;
  3619. case fOperation of
  3620. gopRotate: SetAngleDisk(0);
  3621. end;
  3622. fchangerate := NullVector;
  3623. //MassSelection+\-add mass selected obj
  3624. if operation = gopNone then
  3625. begin
  3626. pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);
  3627. //î÷èñòêà ñïèñêà åñëè êëèêíóëè â ïóñòîòó
  3628. if not FCanAddObjToSelectionList and not FCanRemoveObjFromSelectionList and (pick.Count = 0) then
  3629. ClearSelection;
  3630. pick.Free;
  3631. end;
  3632. if EnableMultiSelection and FShowMultiSelecting then
  3633. MultiSelMouseUp(X, Y);
  3634. if not FShowMultiSelecting and EnableActionHistory then
  3635. FHistory.AddObjects(FSelectedObjects);
  3636. Updategizmo;
  3637. end;
  3638. //------------------------------------------------------------------------------
  3639. procedure TGLGizmoEx.UpdateGizmo;
  3640. var
  3641. d: Single;
  3642. v: TGLVector;
  3643. I: Integer;
  3644. begin
  3645. if not Assigned(RootGizmo) or
  3646. not Assigned(RootObjects) or
  3647. not Assigned(Viewer) then
  3648. Exit;
  3649. if FSelectedObjects.Count - 1 < 0 then
  3650. begin
  3651. FUIRootHelpers.Visible := False;
  3652. Exit;
  3653. end
  3654. else
  3655. begin
  3656. FUIRootHelpers.Visible := True;
  3657. if Assigned(onUpdate) then
  3658. OnUpdate(self);
  3659. v := VectorMake(0, 0, 0);
  3660. //óñòàíàâëèâàåì ãèçìî â íóæíóþ ïîçèöèþ!
  3661. for I := 0 to FSelectedObjects.Count - 1 do
  3662. VectorAdd(v, TGLBaseSceneObject(FSelectedObjects.Hit[I]).AbsolutePosition, v);
  3663. if FSelectedObjects.Count = 1 then
  3664. I := 1
  3665. else
  3666. I := FSelectedObjects.Count;
  3667. FUIRootHelpers.Position.AsVector := VectorDivide(v, VectorMake(I, I, I));
  3668. end;
  3669. case Ord(ReferenceCoordSystem) of
  3670. 0:
  3671. begin
  3672. FUIRootHelpers.Direction := FUIBaseGizmo.Direction;
  3673. FUIRootHelpers.Up := FUIBaseGizmo.Up;
  3674. end;
  3675. 1:
  3676. begin
  3677. FUIRootHelpers.AbsoluteDirection := TGLBaseSceneObject(FSelectedObjects.Hit[0]).AbsoluteDirection;
  3678. FUIRootHelpers.AbsoluteUp := TGLBaseSceneObject(FSelectedObjects.Hit[0]).AbsoluteUp;
  3679. end;
  3680. end;
  3681. Assert(Viewer <> nil, 'Viewer not Assigned to gizmo');
  3682. if FAutoZoom then
  3683. d := Viewer.Camera.distanceTo(FUIRootHelpers) / FAutoZoomFactor
  3684. else
  3685. d := FZoomFactor;
  3686. if FUIRootAxisLabel.Visible then
  3687. begin
  3688. FUIAxisLabelX.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3689. FUIAxisLabelX.StructureChanged;
  3690. FUIAxisLabelY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3691. FUIAxisLabelY.StructureChanged;
  3692. FUIAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3693. FUIAxisLabelZ.StructureChanged;
  3694. FUIRootAxisLabel.Scale.AsVector := VectorMake(d, d, d);
  3695. end;
  3696. if FUIRootSelect.Visible then
  3697. FUIRootSelect.Scale.AsVector := VectorMake(d, d, d);
  3698. if FUIRootMovement.Visible then
  3699. FUIRootMovement.Scale.AsVector := VectorMake(d, d, d);
  3700. if FUIRootRotate.Visible then
  3701. begin
  3702. FUIRotateLineXY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3703. FUIRotateLineXY.StructureChanged;
  3704. FUIRotateLineXZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3705. FUIRotateLineXZ.StructureChanged;
  3706. FUIRotateAxisLabelX.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3707. FUIRotateAxisLabelX.StructureChanged;
  3708. FUIRotateAxisLabelY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3709. FUIRotateAxisLabelY.StructureChanged;
  3710. FUIRotateAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3711. FUIRotateAxisLabelZ.StructureChanged;
  3712. FUIRootRotate.Scale.AsVector := VectorMake(d, d, d);
  3713. end;
  3714. if not moving and FUIRootScale.Visible then
  3715. FUIRootScale.Scale.AsVector := VectorMake(d, d, d);
  3716. if FUIRootVisibleInfoLabels.Visible then
  3717. begin
  3718. UpdateVisibleInfoLabels;
  3719. FUIRootVisibleInfoLabels.AbsoluteDirection := FUIBaseGizmo.AbsoluteDirection;
  3720. FUIRootVisibleInfoLabels.AbsoluteUp := FUIBaseGizmo.AbsoluteUp;
  3721. FUIVisibleInfoLabels.ModulateColor.Color := FVisibleInfoLabelsColor.Color;
  3722. FUIVisibleInfoLabels.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
  3723. FUIVisibleInfoLabels.StructureChanged;
  3724. FUIRootVisibleInfoLabels.Scale.AsVector := VectorMake(d, d, d);
  3725. end;
  3726. end;
  3727. procedure TGLGizmoEx.LooseSelection;
  3728. begin
  3729. ClearSelection;
  3730. UpdateGizmo;
  3731. if Assigned(onSelectionLost) then
  3732. OnSelectionLost(self);
  3733. end;
  3734. procedure TGLGizmoEx.ClearSelection;
  3735. begin
  3736. FSelectedObj := nil;
  3737. FSelectedObjects.Clear;
  3738. end;
  3739. procedure TGLGizmoEx.LooseCursorSelection;
  3740. begin
  3741. FShowMultiSelecting := False;
  3742. if high(FSelectionRec) > 0 then
  3743. SetLength(FSelectionRec, 0);
  3744. flastcursorPos := Point(0, 0);
  3745. fcursorPos := point(0, 0);
  3746. end;
  3747. procedure TGLGizmoEx.SetViewer(const Value: TGLSceneViewer);
  3748. begin
  3749. if FViewer <> Value then
  3750. begin
  3751. if FViewer <> nil then
  3752. FViewer.RemoveFreeNotification(Self);
  3753. FViewer := Value;
  3754. if FViewer <> nil then
  3755. FViewer.FreeNotification(Self);
  3756. end;
  3757. end;
  3758. procedure TGLGizmoEx.Notification(AComponent: TComponent; Operation: TOperation);
  3759. begin
  3760. inherited;
  3761. if Operation = opRemove then
  3762. begin
  3763. if AComponent = FViewer then
  3764. FViewer := nil;
  3765. if AComponent = FRootGizmo then
  3766. FRootGizmo := nil;
  3767. if AComponent = FRootObjects then
  3768. FRootObjects := nil;
  3769. if AComponent = FGizmoTmpRoot then
  3770. FGizmoTmpRoot := nil;
  3771. end;
  3772. if FHistory <> nil then
  3773. FHistory.Notification(AComponent, Operation);
  3774. end;
  3775. function TGLGizmoEx.Undo: TGLGizmoExActionHistoryItem;
  3776. var
  3777. I: Integer;
  3778. begin
  3779. Result := FHistory.Undo;
  3780. if Result = nil then
  3781. Exit;
  3782. FSelectedObjects.Clear;
  3783. for I := 0 to Result.GizmoObjectCollection.Count - 1 do
  3784. FSelectedObjects.AddHit(Result.GizmoObjectCollection.Items[I].EffectedObject, nil, 0, 0);
  3785. UpdateGizmo;
  3786. end;
  3787. function TGLGizmoEx.Redo: TGLGizmoExActionHistoryItem;
  3788. var
  3789. I: Integer;
  3790. begin
  3791. Result := FHistory.Redo;
  3792. if Result = nil then
  3793. Exit;
  3794. FSelectedObjects.Clear;
  3795. for I := 0 to Result.GizmoObjectCollection.Count - 1 do
  3796. if not Result.GizmoObjectCollection.Items[I].FReturnObject then
  3797. FSelectedObjects.AddHit(Result.GizmoObjectCollection.Items[I].EffectedObject, nil, 0, 0);
  3798. UpdateGizmo;
  3799. end;
  3800. ////////////////////////////////////////////////////////////
  3801. procedure TGLGizmoExObjectItem.AssignFromObject(const AObject: TGLBaseSceneObject; AssignAndRemoveObj: Boolean = False);
  3802. begin
  3803. if not AssignAndRemoveObj then
  3804. begin
  3805. EffectedObject := AObject;
  3806. SetOldMatrix(AObject.Matrix^);
  3807. if AObject is TGLFreeForm then
  3808. FOldAutoScaling := TGLFreeForm(AObject).AutoScaling.AsVector;
  3809. end
  3810. else
  3811. begin
  3812. EffectedObject := AObject;
  3813. FParentOldObject := EffectedObject.Parent;
  3814. FIndexOldObject := EffectedObject.Index;
  3815. FNameOldObject := EffectedObject.Name;
  3816. FEffectedObject.MoveTo(GizmoTmpRoot);
  3817. FReturnObject := True;
  3818. end;
  3819. end;
  3820. constructor TGLGizmoExObjectItem.Create(AOwner: TCollection);
  3821. begin
  3822. FReturnObject := False;
  3823. inherited;
  3824. end;
  3825. destructor TGLGizmoExObjectItem.Destroy;
  3826. begin
  3827. if FReturnObject then
  3828. if assigned(fEffectedObject) then
  3829. FreeAndNil(fEffectedObject);
  3830. inherited;
  3831. end;
  3832. function TGLGizmoExObjectItem.GetGizmo: TGLGizmoEx;
  3833. begin
  3834. if GetParent <> nil then
  3835. Result := GetPArent.GetParent
  3836. else
  3837. Result := nil;
  3838. end;
  3839. function TGLGizmoExObjectItem.GetParent: TGLGizmoExObjectCollection;
  3840. begin
  3841. Result := TGLGizmoExObjectCollection(GetOwner);
  3842. end;
  3843. procedure TGLGizmoExObjectItem.DoUndo;
  3844. begin
  3845. if FEffectedObject = nil then
  3846. Exit;
  3847. if not FReturnObject then
  3848. begin
  3849. FEffectedObject.SetMatrix(FOldMatrix);
  3850. if FEffectedObject is TGLFreeForm then
  3851. TGLFreeForm(FEffectedObject).AutoScaling.AsVector := FOldAutoScaling;
  3852. end
  3853. else
  3854. begin
  3855. if fEffectedObject.Parent <> GizmoTmpRoot then
  3856. begin
  3857. fEffectedObject.MoveTo(FGizmoTmpRoot);
  3858. Exit;
  3859. end;
  3860. FParentOldObject.Insert(FIndexOldObject, fEffectedObject);
  3861. end;
  3862. end;
  3863. procedure TGLGizmoExObjectItem.Notification(AComponent: TComponent; Operation: TOperation);
  3864. begin
  3865. inherited;
  3866. if Operation = opRemove then
  3867. begin
  3868. if AComponent = FEffectedObject then
  3869. if FReturnObject then
  3870. FreeAndNil(FEffectedObject)
  3871. else
  3872. FEffectedObject := nil;
  3873. GizmoTmpRoot := nil;
  3874. end;
  3875. end;
  3876. procedure TGLGizmoExObjectItem.SetEffectedObject(const Value: TGLBaseSceneObject);
  3877. begin
  3878. FEffectedObject := Value;
  3879. end;
  3880. procedure TGLGizmoExObjectItem.SetOldMatrix(const Value: TGLMatrix);
  3881. begin
  3882. FOldMatrix := Value;
  3883. end;
  3884. { TGLGizmoExUndoCollection }
  3885. function TGLGizmoExObjectCollection.Add: TGLGizmoExObjectItem;
  3886. begin
  3887. Result := TGLGizmoExObjectItem(inherited Add);
  3888. end;
  3889. function TGLGizmoExObjectCollection.GetItems(const Index: Integer): TGLGizmoExObjectItem;
  3890. begin
  3891. Result := TGLGizmoExObjectItem(inherited GetItem(Index));
  3892. end;
  3893. function TGLGizmoExObjectCollection.GetParent: TGLGizmoEx;
  3894. begin
  3895. Result := TGLGizmoEx(GetOwner);
  3896. end;
  3897. procedure TGLGizmoExObjectCollection.Notification(AComponent: TComponent; Operation: TOperation);
  3898. var
  3899. I: Integer;
  3900. begin
  3901. if Count <> 0 then
  3902. for I := 0 to Count - 1 do
  3903. GetItems(I).Notification(AComponent, Operation);
  3904. end;
  3905. procedure TGLGizmoExObjectCollection.RemoveByObject(const AObject: TGLCustomSceneObject);
  3906. var
  3907. I: Integer;
  3908. begin
  3909. for I := Count - 1 downto 0 do
  3910. if GetItems(I).FEffectedObject = AObject then
  3911. GetItems(I).Free;
  3912. end;
  3913. procedure TGLGizmoExObjectCollection.SetItems(const Index: Integer; const Value: TGLGizmoExObjectItem);
  3914. begin
  3915. GetItems(Index).Assign(Value);
  3916. end;
  3917. procedure TGLGizmoExObjectCollection.DoUndo;
  3918. var
  3919. I: Integer;
  3920. begin
  3921. for I := Count - 1 downto 0 do
  3922. GetItems(I).DoUndo;
  3923. end;
  3924. /////////////////////////////////////////////////////////////
  3925. constructor TGLGizmoExActionHistoryItem.Create(AOwner: TCollection);
  3926. begin
  3927. inherited;
  3928. FGizmoObjectCollection := TGLGizmoExObjectCollection.Create(self, TGLGizmoExObjectItem);
  3929. end;
  3930. destructor TGLGizmoExActionHistoryItem.Destroy;
  3931. begin
  3932. FGizmoObjectCollection.Free;
  3933. inherited;
  3934. end;
  3935. procedure TGLGizmoExActionHistoryItem.SetObject(aValue: TObject);
  3936. begin
  3937. if FObject <> AValue then
  3938. FObject := AValue;
  3939. end;
  3940. procedure TGLGizmoExActionHistoryItem.SetGizmoObjectCollection(aValue: TGLGizmoExObjectCollection);
  3941. begin
  3942. if FGizmoObjectCollection <> aValue then
  3943. FGizmoObjectCollection := aValue;
  3944. end;
  3945. { TGLGizmoExUndoCollection }
  3946. constructor TGLGizmoExActionHistoryCollection.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  3947. begin
  3948. MaxCount := 30;
  3949. FItemIndex := -1;
  3950. inherited;
  3951. end;
  3952. function TGLGizmoExActionHistoryCollection.Add: TGLGizmoExActionHistoryItem;
  3953. begin
  3954. Result := nil;
  3955. //If used undo then rewrite previous record
  3956. if FItemIndex = Count - 1 then
  3957. begin
  3958. Result := TGLGizmoExActionHistoryItem(inherited Add);
  3959. FItemIndex := FItemIndex + 1;
  3960. ;
  3961. end
  3962. else
  3963. if (FItemIndex >= 0) or (FItemIndex < Count - 1) then
  3964. begin
  3965. Result := Items[FItemIndex];
  3966. FItemIndex := FItemIndex + 1;
  3967. end;
  3968. // if number of record greater then maxcount then delete elements
  3969. if Count - 1 > MaxCount then
  3970. begin
  3971. Delete(0);
  3972. FItemIndex := Count - 1;
  3973. end;
  3974. end;
  3975. function TGLGizmoExActionHistoryCollection.GetItems(const Index: Integer): TGLGizmoExActionHistoryItem;
  3976. begin
  3977. Result := TGLGizmoExActionHistoryItem(inherited GetItem(Index));
  3978. end;
  3979. procedure TGLGizmoExActionHistoryCollection.Notification(AComponent: TComponent; Operation: TOperation);
  3980. var
  3981. I: Integer;
  3982. begin
  3983. if Count <> 0 then
  3984. for I := 0 to Count - 1 do
  3985. GetItems(I).FGizmoObjectCollection.Notification(AComponent, Operation);
  3986. end;
  3987. procedure TGLGizmoExActionHistoryCollection.SetItems(const Index: Integer; const Value: TGLGizmoExActionHistoryItem);
  3988. begin
  3989. GetItems(Index).Assign(Value);
  3990. end;
  3991. function TGLGizmoExActionHistoryCollection.Undo: TGLGizmoExActionHistoryItem;
  3992. begin
  3993. Result := nil;
  3994. if not (FItemIndex > 0) or not (FItemIndex <= Count - 1) then
  3995. Exit;
  3996. if FItemIndex <> 0 then
  3997. FItemIndex := FItemIndex - 1;
  3998. Result := Items[FItemIndex];
  3999. Result.GizmoObjectCollection.DoUndo;
  4000. end;
  4001. function TGLGizmoExActionHistoryCollection.Redo: TGLGizmoExActionHistoryItem;
  4002. begin
  4003. Result := nil;
  4004. if not (FItemIndex >= 0) or not (FItemIndex < Count - 1) then
  4005. Exit;
  4006. if FItemIndex <> Count - 1 then
  4007. FItemIndex := FItemIndex + 1;
  4008. Result := Items[FItemIndex];
  4009. Result.GizmoObjectCollection.DoUndo;
  4010. end;
  4011. procedure TGLGizmoExActionHistoryCollection.AddObjects(objs: TGLPickList);
  4012. var
  4013. I: Integer;
  4014. begin
  4015. with Add do
  4016. begin
  4017. for I := 0 to objs.Count - 1 do
  4018. GizmoObjectCollection.Add.AssignFromObject(TGLBaseSceneObject(objs.Hit[I]));
  4019. end;
  4020. end;
  4021. procedure TGLGizmoExActionHistoryCollection.AddObject(obj: TObject);
  4022. begin
  4023. if obj = nil then
  4024. Exit;
  4025. Add.FObject := obj;
  4026. end;
  4027. procedure TGLGizmoExActionHistoryCollection.RemoveObjects(objs: TGLPickList);
  4028. var
  4029. I: Integer;
  4030. begin
  4031. if not Assigned(self.GizmoTmpRoot) then
  4032. Exit;
  4033. with Add do
  4034. for I := 0 to objs.Count - 1 do
  4035. if objs.Hit[I] <> nil then
  4036. with GizmoObjectCollection.Add do
  4037. begin
  4038. GizmoTmpRoot := self.GizmoTmpRoot;
  4039. AssignFromObject(TGLBaseSceneObject(objs.Hit[I]), True);
  4040. end;
  4041. objs.Clear;
  4042. end;
  4043. end.