GLS.GizmoEx.pas 134 KB

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