123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521 |
- //
- // The multimedia graphics platform GLScene https://github.com/glscene
- //
- unit GLS.GizmoEx;
- (*
- Invisible component for helping to Move, Rotate and Scale an Object
- under GLScene (usefull for an Editor).
- This is an enhanced version of TGLGizmo
- *)
- interface
- {$I GLScene.inc}
- uses
- Winapi.OpenGL,
- Winapi.Windows,
- System.Classes,
- System.SysUtils,
- System.Types,
- Vcl.StdCtrls,
- GLS.Scene,
- GLS.Color,
- GLS.Objects,
- GLS.VectorGeometry,
- GLS.Material,
- GLS.Strings,
- GLS.GeomObjects,
- GLS.BitmapFont,
- GLS.SceneViewer,
- GLS.VectorFileObjects,
- GLS.Coordinates,
- GLS.RenderContextInfo,
- GLS.GeometryBB,
- GLS.VectorTypes,
- GLS.Canvas,
- GLS.PersistentClasses,
- GLS.Screen,
- GLS.State,
- GLS.Selection;
- type
- TGLGizmoExObjectCollection = class;
- TGLGizmoEx = class;
- TGLGizmoExObjectItem = class(TCollectionItem)
- private
- FOldAutoScaling: TGLVector;
- FEffectedObject: TGLBaseSceneObject;
- FParentOldObject: TGLBaseSceneObject;
- FIndexOldObject: Integer;
- FNameOldObject: string;
- FReturnObject: Boolean;
- FOldMatrix: TGLMatrix;
- FGizmoTmpRoot: TGLBaseSceneObject;
- procedure SetEffectedObject(const Value: TGLBaseSceneObject);
- procedure SetOldMatrix(const Value: TGLMatrix);
- protected
- procedure DoUndo;
- function GetParent: TGLGizmoExObjectCollection;
- function GetGizmo: TGLGizmoEx;
- public
- property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write FGizmoTmpRoot;
- constructor Create(AOwner: TCollection); override;
- destructor Destroy; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); virtual;
- procedure AssignFromObject(const AObject: TGLBaseSceneObject; AssignAndRemoveObj: Boolean = False);
- // TODO: create a special type for Matrix.
- property OldMatrix: TGLMatrix read FOldMatrix write SetOldMatrix;
- published
- property EffectedObject: TGLBaseSceneobject read FEffectedObject write SetEffectedObject;
- end;
- TGLGizmoExObjectCollection = class(TOwnedCollection)
- private
- function GetItems(const Index: Integer): TGLGizmoExObjectItem;
- procedure SetItems(const Index: Integer; const Value: TGLGizmoExObjectItem);
- protected
- function GetParent: TGLGizmoEx;
- procedure DoUndo;
- public
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- procedure RemoveByObject(const AObject: TGLCustomSceneObject);
- function Add: TGLGizmoExObjectItem;
- property Items[const Index: Integer]: TGLGizmoExObjectItem read GetItems write SetItems; default;
- end;
- TGLGizmoExActionHistoryItem = class(TCollectionItem)
- private
- FObject: TObject;
- FGizmoObjectCollection: TGLGizmoExObjectCollection;
- procedure SetObject(aValue: TObject);
- procedure SetGizmoObjectCollection(aValue: TGLGizmoExObjectCollection);
- public
- constructor Create(AOwner: TCollection); override;
- destructor Destroy; override;
- property BaseObject: TObject read FObject write SetObject;
- property GizmoObjectCollection: TGLGizmoExObjectCollection read FGizmoObjectCollection write SetGizmoObjectCollection;
- end;
- TGLGizmoExActionHistoryCollection = class(TOwnedCollection)
- private
- FItemIndex: Integer;
- FItemsMaxCount: Integer;
- FGizmoTmpRoot: TGLBaseSceneObject;
- function GetItems(const Index: Integer): TGLGizmoExActionHistoryItem;
- procedure SetItems(const Index: Integer; const Value: TGLGizmoExActionHistoryItem);
- function Add: TGLGizmoExActionHistoryItem;
- public
- constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- property ItemIndex: Integer read FItemIndex write FItemIndex;
- function Undo: TGLGizmoExActionHistoryItem;
- function Redo: TGLGizmoExActionHistoryItem;
- procedure AddObjects(objs: TGLPickList);
- procedure AddObject(obj: TObject);
- procedure RemoveObjects(objs: TGLPickList);
- property MaxCount: Integer read FItemsMaxCount write FItemsMaxCount;
- property Items[const Index: Integer]: TGLGizmoExActionHistoryItem read GetItems write SetItems; default;
- property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write FGizmoTmpRoot;
- end;
- TGLGizmoExVisibleInfoLabel = (vliName, vliOperation, vliCoords);
- TGLGizmoExVisibleInfoLabels = set of TGLGizmoExVisibleInfoLabel;
- TInfoLabelCoordType = (ilcChanging, ilcChangeRate);
- TGLGizmoExAxis = (gaNone, gaX, gaY, gaZ, gaXY, gaXZ, gaYZ, gaXYZ);
- TGLGizmoExSelectionRegion = (gsrRectangular, gsrCircular, gsrFence,
- gsrLasso);
- TGLGizmoExReferenceCoordinateSystem = (rcsView, rcsLocal);
- TGLGizmoExSelRec = array of TPoint;
- TGLGizmoExOperation = (gopMove, gopRotate, gopScale, gopNone);
- TGLGizmoExOperationMode = (gomNone, gomSelect, gomMove, gomRotate, gomScale);
- TGLGizmoExAcceptEvent = procedure(Sender: TObject; var objs: TGLPickList) of object;
- TGLGizmoExAxisSelected = procedure(Sender: TObject; var Axis: TGLGizmoExAxis) of object;
- TGLGizmoExPickMode = (pmGetPickedObjects, pmRayCast);
- //Gizmo objects
- TGLGizmoExUIFrustrum = class(TGLFrustrum)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUISphere = class(TGLSphere)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUIDisk = class(TGLDisk)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUITorus = class(TGLTorus)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUIPolygon = class(TGLPolygon)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUIArrowLine = class(TGLArrowLine)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUILines = class(TGLLines)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoExUIFlatText = class(TGLFlatText)
- private
- FNoZWrite: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- procedure BuildList(var rci: TGLRenderContextInfo); override;
- property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
- end;
- TGLGizmoEx = class(TComponent)
- private
- FUIBaseGizmo: TGLBaseSceneObject;
- FUIRootHelpers: TGLBaseSceneObject;
- FUIRootSelect: TGLBaseSceneObject; // for None
- FUIRootMovement: TGLBaseSceneObject; // for Move
- FUIRootRotate: TGLBaseSceneObject; //for Rotate
- FUIRootRotateAxisLabel: TGLBaseSceneObject;
- FUIRootScale: TGLBaseSceneObject; // for Scale
- FUIRootAxisLabel: TGLBaseSceneObject;
- FUIRootVisibleInfoLabels: TGLBaseSceneObject;
- FInterfaceRender: TGLDirectOpenGL;
- FInternalRender: TGLDirectOpenGL;
- FUISelectLineX, FUISelectLineY, FUISelectLineZ: TGLGizmoExUILines; // For None (Select)
- //IC- Invisible Control
- //For Move
- FUIICMovementLineX, FUIICMovementLineY, FUIICMovementLineZ, FUIICMovementLineXY, FUIICMovementLineXZ, FUIICMovementLineYZ: TGLGizmoExUIFrustrum;
- FUIMovementArrowX, FUIMovementArrowY, FUIMovementArrowZ: TGLGizmoExUIArrowLine; // For Move
- FUIMovementLineX, FUIMovementLineY, FUIMovementLineZ, FUIMovementLineXY, FUIMovementLineXZ, FUIMovementLineYZ: TGLGizmoExUILines; // For Move
- FUIMovementPlaneXY, FUIMovementPlaneXZ, FUIMovementPlaneYZ: TGLGizmoExUIPolyGon; // For Move
- //ForRotate
- FUIRotateLineX, FUIRotateLineY, FUIRotateLineZ, FUIRotateLineXY, FUIRotateLineXZ: TGLGizmoExUILines;
- FUIICRotateTorusX, FUIICRotateTorusY, FUIICRotateTorusZ, FUIICRotateTorusXZ: TGLGizmoExUITorus; // For Rotate
- FUIRotateDiskXY, FUIRotateDiskX, FUIRotateDiskX2, FUIRotateDiskY, FUIRotateDiskY2, FUIRotateDiskZ, FUIRotateDiskZ2: TGLGizmoExUIDisk;
- FUIRotateLineArrowX, FUIRotateLineArrowY, FUIRotateLineArrowZ: TGLGizmoExUILines;
- FUIICRotateSphereXY: TGLGizmoExUISphere;
- FUIRotateAxisLabelX, FUIRotateAxisLabelY, FUIRotateAxisLabelZ: TGLGizmoExUIFlatText;
- //ForScale
- FUIScaleArrowX, FUIScaleArrowY, FUIScaleArrowZ: TGLGizmoExUISphere; // For Scale
- FUIScaleLineX, FUIScaleLineY, FUIScaleLineZ, FUIScaleLineXY, FUIScaleLineYZ, FUIScaleLineXZ: TGLGizmoExUILines;
- FUIICScaleLineX, FUIICScaleLineY, FUIICScaleLineZ, FUIICScaleLineXY, FUIICScaleLineXZ, FUIICScaleLineYZ, FUIICScaleLineXYZ: TGLGizmoExUIFrustrum;
- FUIScalePlaneXY, FUIScalePlaneXZ, FUIScalePlaneYZ, FUIScalePlaneXYZ: TGLGizmoExUIPolyGon; // For Move
- FUIAxisLabelX, FUIAxisLabelY, FUIAxisLabelZ: TGLGizmoExUIFlatText;
- FUIVisibleInfoLabels: TGLGizmoExUIFlatText;
- FRootGizmo: TGLBaseSceneObject;
- FRootObjects: TGLBaseSceneObject;
- FGizmoTmpRoot: TGLBaseSceneObject;
- FSelectedObj: TGLBaseSceneObject;
- FOperation: TGLGizmoExOperation;
- FOperationMode: TGLGizmoExOperationMode;
- FSelAxis: TGLGizmoExAxis;
- fInfoLabelCoordType: TInfoLabelCoordType;
- FReferenceCoordSystem: TGLGizmoExReferenceCoordinateSystem;
- FBoundingBoxColor: TGLColor;
- FSelectedColor: TGLColor;
- FVisibleInfoLabelsColor: TGLColor;
- FSelectionRegionColor: TGLColor;
- FVisibleInfoLabelsColorChanged: Boolean;
- FAutoZoom: Boolean;
- FExcludeObjects: Boolean;
- FExcludeClassname: Boolean;
- FNoZWrite: Boolean;
- FEnabled: Boolean;
- FAutoZoomFactor: Single;
- FZoomFactor: Single;
- FMoveCoef: Single;
- FRotationCoef: Single;
- FViewer: TGLSceneViewer;
- FVisibleVisibleInfoLabels: TGLGizmoExVisibleInfoLabels;
- FExcludeObjectsList: TStrings;
- FExcludeClassNameList: TStrings;
- FSelectionRegion: TGLGizmoExSelectionRegion;
- FEnableMultiSelection: Boolean;
- FShowMultiSelecting: Boolean;
- FSelectionRec: TGLGizmoExSelRec;
- FCanAddObjToSelectionList: Boolean;
- FCanRemoveObjFromSelectionList: Boolean;
- FSelectedObjects: TGLPickList;
- FAntiAliasedLines: Boolean;
- FShowAxisLabel: Boolean;
- FShowObjectInfos: Boolean;
- FShowBoundingBox: Boolean;
- FCanChangeWithChildren: Boolean;
- moving: Boolean;
- mx, my: Integer;
- fCursorPos: TPoint;
- fLastCursorPos: TPoint;
- fChangeRate: TAffineVector; //total rotate angle
- FEnableLoopCursorMoving: Boolean;
- lastMousePos: TGLVector;
- FOnUpdate: TNotifyEvent;
- FOnSelect: TGLGizmoExAcceptEvent;
- FOnOperationChange: TNotifyEvent;
- FOnOperationModeChange: TNotifyEvent;
- FOnSelectionLost: TNotifyEvent;
- FOnAxisSelected: TGLGizmoExAxisSelected;
- FScaleCoef: Single;
- FGizmoThickness: Single;
- FPickMode: TGLGizmoExPickMode;
- FEnableHistory: Boolean;
- FHistory: TGLGizmoExActionHistoryCollection;
- FHistoryStepsCount: Integer;
- FLabelFont: TGLCustomBitmapFont;
- procedure SetRootGizmo(const AValue: TGLBaseSceneObject);
- procedure SetRootObjects(const AValue: TGLBaseSceneObject);
- procedure SetGizmoTmpRoot(const AValue: TGLBaseSceneObject);
- procedure SeTGLGizmoExVisibleInfoLabels(const AValue: TGLGizmoExVisibleInfoLabels);
- procedure SetBoundingBoxColor(const AValue: TGLColor);
- procedure SetSelectedColor(const AValue: TGLColor);
- procedure SetVisibleInfoLabelsColor(const AValue: TGLColor);
- procedure SetSelectionRegionColor(const AValue: TGLColor);
- procedure SetCanChangeWithChildren(AValue: Boolean);
- procedure SetAALines(aValue: Boolean);
- procedure SetInfoLabelCoordType(aValue: TInfoLabelCoordType);
- procedure SetReferenceCoordSystem(aValue: TGLGizmoExReferenceCoordinateSystem);
- procedure SetHistoryStepsCount(aValue: Integer);
- procedure SetExcludeObjectsList(const AValue: TStrings);
- procedure SetExcludeClassNameList(const AValue: TStrings);
- function MouseWorldPos(const X, Y: Integer): TGLVector;
- function CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
- function CheckClassNameInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
- procedure UpdateVisibleInfoLabels;
- procedure SetGLGizmoExThickness(const Value: Single);
- procedure ActivatingElements(PickList: TGLPickList);
- procedure InterfaceRender(Sender: TObject; var rci: TGLRenderContextInfo);
- procedure InternalRender(Sender: TObject; var rci: TGLRenderContextInfo);
- function InternalGetPickedObjects(const x1, y1, x2, y2: Integer; const guessCount: Integer = 8): TGLPickList;
- procedure SetViewer(const Value: TGLSceneViewer);
- procedure SetLabelFont(const Value: TGLCustomBitmapFont);
- procedure SetSelectedObj(const Value: TGLBaseSceneObject);
- function GetSelectedObj: TGLBaseSceneObject;
- procedure SetNoZWrite(const Value: Boolean);
- procedure SetOperation(const Value: TGLGizmoExOperation);
- procedure SetOperationMode(const Value: TGLGizmoExOperationMode);
- procedure SetAngleDisk(aAngle: Single);
- procedure SetEnableLoopCursorMoving(const AValue: Boolean);
- procedure SetEnableMultiSelection(const AValue: Boolean);
- procedure SetSelectionRegion(const AValue: TGLGizmoExSelectionRegion);
- procedure SetShowAxisLabel(const AValue: Boolean);
- procedure SetShowObjectInfos(const AValue: Boolean);
- procedure SetShowBoundingBox(const AValue: Boolean);
- procedure SetAutoZoomFactor(const AValue: Single);
- procedure SetZoomFactor(const AValue: Single);
- procedure SetSelAxis(aValue: TGLGizmoExAxis);
- procedure SetPickMode(APickMode: TGLGizmoExPickMode);
- procedure AssignPickList(aList: TGLPickList; RemoveObj: Boolean = False);
- procedure AddObjToSelectionList(Obj: TGLBaseSceneObject);
- procedure RemoveObjFromSelectionList(Obj: TGLBaseSceneObject);
- procedure MultiSelMouseDown(X, Y: Integer);
- procedure MultiSelMouseUp(X, Y: Integer);
- procedure MultiSelMouseMove(X, Y: Integer);
- function GetPickList: TGLPickList;
- procedure SetPickList(aValue: TGLPickList);
- property SelAxis: TGLGizmoExAxis read FSelAxis write SetSelAxis;
- property Operation: TGLGizmoExOperation read FOperation write SetOperation;
- procedure ClearSelection;
- procedure SetVisible(const AValue: Boolean);
- function GetVisible: Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Loaded; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure ViewerMouseMove(const X, Y: Integer);
- procedure ViewerMouseDown(const X, Y: Integer);
- procedure ViewerMouseUp(const X, Y: Integer);
- procedure UpdateGizmo; overload;
- procedure LooseSelection; virtual;
- procedure UndoAdd(const AObject: TObject);
- procedure RemoveSelectedObjects;
- function Undo: TGLGizmoExActionHistoryItem;
- function Redo: TGLGizmoExActionHistoryItem;
- property CanAddObjToSelectionList: Boolean read FCanAddObjToSelectionList write FCanAddObjToSelectionList;
- property CanRemoveObjFromSelectionList: Boolean read FCanRemoveObjFromSelectionList write FCanRemoveObjFromSelectionList;
- procedure LooseCursorSelection;
- property CursorSelectingRegion: Boolean read FShowMultiSelecting;
- property RootObjects: TGLBaseSceneObject read FRootObjects write SetRootObjects;
- property RootGizmo: TGLBaseSceneObject read FRootGizmo write SetRootGizmo;
- property GizmoTmpRoot: TGLBaseSceneObject read FGizmoTmpRoot write SetGizmoTmpRoot;
- //--------------------------------------------------------------------
- published
- property Viewer: TGLSceneViewer read FViewer write SetViewer;
- property BoundingBoxColor: TGLColor read FBoundingBoxColor write SetBoundingBoxColor;
- property SelectedColor: TGLColor read FSelectedColor write SetSelectedColor;
- property SelectionRegionColor: TGLColor read FSelectionRegionColor write SetSelectionRegionColor;
- property SelectedObj: TGLBaseSceneObject read GetSelectedObj write SetSelectedObj;
- property SelectedObjects: TGLPickList read GetPickList write SetPickList;
- property OperationMode: TGLGizmoExOperationMode read FOperationMode write SetOperationMode default gomSelect;
- property ExcludeObjects: Boolean read FExcludeObjects write FExcludeObjects;
- property ExcludeObjectsList: TStrings read FExcludeObjectsList write SetExcludeObjectsList;
- property ExcludeClassname: Boolean read FExcludeClassname write FExcludeClassname;
- property ExcludeClassnameList: TStrings read FExcludeClassnameList write SetExcludeClassnameList;
- property VisibleInfoLabels: TGLGizmoExVisibleInfoLabels read FVisibleVisibleInfoLabels write SeTGLGizmoExVisibleInfoLabels;
- property VisibleInfoLabelsColor: TGLColor read FVisibleInfoLabelsColor write SetVisibleInfoLabelsColor;
- property AutoZoom: Boolean read FAutoZoom write FAutoZoom default True;
- property AutoZoomFactor: Single read FAutoZoomFactor write SetAutoZoomFactor;
- property ZoomFactor: Single read FZoomFactor write SetZoomFactor;
- property MoveCoef: Single read FMoveCoef write FMoveCoef;
- property RotationCoef: Single read FRotationCoef write FRotationCoef;
- property ScaleCoef: Single read FScaleCoef write FScaleCoef;
- property NoZWrite: Boolean read FNoZWrite write SetNoZWrite default True;
- property GizmoThickness: Single read FGizmoThickness write SeTGLGizmoExThickness;
- {Indicates whether the gizmo is enabled or not.
- WARNING: When loading/editing (possibly whenever a structureChanged
- call is made) a model, sometimes the gizmo will trigger a
- bug if the mouse is inside the glscene Viewer. To prevent that,
- remember to disable the gizmo before loading, then process windows
- messages (i.e. application.processMessage) and then enable the gizmo
- again. }
- {Warning Enable is ReadOnly property if you set to False, Gizmo is not Hidden
- use Visible instead if you want to Hide, if you want to Hide but keep enabled
- see the VisibleGizmo property }
- {Use the property OperationMode=gomNone to unactivate gizmo and make it invisible}
- property Enabled: Boolean read FEnabled write FEnabled default True;
- property LabelFont: TGLCustomBitmapFont read FLabelFont write SetLabelFont default nil;
- property OnSelectionLost: TNotifyEvent read FOnSelectionLost write FOnSelectionLost;
- property OnOperationChange: TNotifyEvent read FOnOperationChange write FOnOperationChange;
- property OnOperationModeChange: TNotifyEvent read FOnOperationModeChange write FOnOperationModeChange;
- property OnSelect: TGLGizmoExAcceptEvent read FOnSelect write FOnSelect;
- property OnAxisSelected: TGLGizmoExAxisSelected read FOnAxisSelected write FOnAxisSelected;
- property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
- property PickMode: TGLGizmoExPickMode read FPickMode write SetPickMode default pmGetPickedObjects;
- property EnableActionHistory: Boolean read FEnableHistory write FEnableHistory default True;
- property HistoryStepsCount: Integer read FHistoryStepsCount write SetHistoryStepsCount;
- property EnableLoopCursorMoving: Boolean read FEnableLoopCursorMoving write SetEnableLoopCursorMoving default True;
- property EnableMultiSelection: Boolean read FEnableMultiSelection write SetEnableMultiSelection default True;
- property CanChangeWithChildren: Boolean read FCanChangeWithChildren write SetCanChangeWithChildren;
- property AntiAliasedLines: Boolean read FAntiAliasedLines write SetAALines default True;
- property InfoLabelCoordType: TInfoLabelCoordType read fInfoLabelCoordType write SetInfoLabelCoordType default ilcChangeRate;
- property SelectionRegion: TGLGizmoExSelectionRegion read FSelectionRegion write SetSelectionRegion default gsrRectangular;
- property ShowAxisLabel: Boolean read FShowAxisLabel write SetShowAxisLabel default True;
- property ShowObjectInfos: Boolean read FShowObjectInfos write SetShowObjectInfos default True;
- property ShowBoundingBox: Boolean read FShowBoundingBox write SetShowBoundingBox default True;
- property ReferenceCoordSystem: TGLGizmoExReferenceCoordinateSystem read FReferenceCoordSystem write SetReferenceCoordSystem default rcsView;
- property Visible: Boolean read GetVisible write SetVisible;
- end;
- //==================================================================
- implementation
- //==================================================================
- uses
- GLS.Context,
- GLS.PipelineTransformation,
- GLS.OpenGLTokens;
- procedure RotateAroundArbitraryAxis(const anObject: TGLBaseSceneObject; const Axis, Origin: TAffineVector; const angle: Single);
- var
- M, M1, M2, M3: TGLMatrix;
- begin
- M1 := CreateTranslationMatrix(VectorNegate(Origin));
- M2 := CreateRotationMatrix(Axis, Angle * PI / 180);
- M3 := CreateTranslationMatrix(Origin);
- M := MatrixMultiply(M1, M2);
- M := MatrixMultiply(M, M3);
- anObject.AbsoluteMatrix := MatrixMultiply(anObject.AbsoluteMatrix, M);
- //Just a workarround to Update angles...
- anObject.Roll(0);
- anObject.Pitch(0);
- anObject.Turn(0);
- end;
- //-------------------------------------------------------------------
- // Mathematical functions for canvas
- //-------------------------------------------------------------------
- function Det(const a, b, c, d: real): real;
- begin
- Det := a * d - b * c;
- end;
- //Distance between two points
- function Dist(const P1, P2: TPoint): real;
- begin
- Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y));
- end;
- function CrossingPointLine(p: TPoint; p1, p2: TPoint): Boolean;
- begin
- Result := (abs(p1.X - p.X) + abs(p2.X - p.X) = abs(p2.X - p1.X)) and
- (abs(p1.Y - p.Y) + abs(p2.Y - p.Y) = abs(p2.Y - p1.Y));
- end;
- //Intersection between two lines, return true or false
- //converted from http://doc-for-prog.narod.ru/topics/math/crossing.html
- function IsLineIntLine(const p11, p12, p21, p22: TPoint; var p: TPoint): Boolean;
- var
- Z, ca, cb, ua, ub: Single;
- begin
- // demominator
- Z := (p12.Y - p11.Y) * (p21.X - p22.X) - (p21.Y - p22.Y) * (p12.X - p11.X);
- // numerator 1
- Ca := (p12.Y - p11.Y) * (p21.X - p11.X) - (p21.Y - p11.Y) * (p12.X - p11.X);
- // numerator 2
- Cb := (p21.Y - p11.Y) * (p21.X - p22.X) - (p21.Y - p22.Y) * (p21.X - p11.X);
- // if numerator and demominator = 0, then coincide lines
- if (Z = 0) and (Ca = 0) and (Cb = 0) then
- begin
- Result := False;
- Exit;
- end
- else
- // if demominator = 0, then parallel lines
- if Z = 0 then
- begin
- Result := False;
- Exit;
- end;
- Ua := Ca / Z;
- Ub := Cb / Z;
- // if 0<=Ua<=1 and 0<=Ub<=1, then the intersection point is inside intervals
- if (0 <= Ua) and (Ua <= 1) and (0 <= Ub) and (Ub <= 1) then
- begin
- p.X := round(p11.X + (p12.X - p11.X) * Ub);
- p.Y := round(p11.Y + (p12.Y - p11.Y) * Ub);
- Result := True;
- end
- // otherwise the intersection point is outside intervals
- else
- Result := False;
- end;
- //Intersection of line and circle
- function IsLineIntCirlce(CR: Single; CC: TPoint; LP1, LP2: TPoint; var PIL1, PIL2: TPoint): Smallint;
- var
- d, K, b: Single;
- begin
- K := (LP1.Y - LP2.Y) / (LP1.X - LP2.X);
- b := LP1.Y - K * LP1.X;
- //determine decrement of quadratic equation
- 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));
- //if decrement = 0, then no decision and line and circle do not intersect
- if (d < 0) then
- begin
- Result := -1;
- PIL1 := point(0, 0);
- PIL2 := point(0, 0);
- Exit;
- end;
- //otherwise find roots of quadratic equation
- PIL1.X := round((-(2 * K * b - 2 * CC.X - 2 * CC.Y * K) - sqrt(d)) / (2 + 2 * K * K));
- PIL2.X := round((-(2 * K * b - 2 * CC.X - 2 * CC.Y * K) + sqrt(d)) / (2 + 2 * K * K));
- //if abscissas of points are coinside, then the intersection is only in one point
- //and line and circle have a point of contact
- if (PIL1.X = PIL2.X) then
- begin
- Result := 0;
- PIL1.Y := round(K * PIL1.X + b);
- PIL2 := PIL1;
- Exit;
- end;
- //otherwise find ordinates of intersection points
- PIL1.Y := round(K * PIL1.X + b);
- PIL2.Y := round(K * PIL2.X + b);
- Result := 1;
- end;
- constructor TGLGizmoExUIArrowLine.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUIArrowLine.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUIDisk.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUIDisk.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUISphere.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUISphere.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUIPolyGon.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUIPolyGon.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUIFrustrum.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUIFrustrum.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUITorus.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUITorus.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUILines.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUILines.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- constructor TGLGizmoExUIFlatText.Create(AOwner: TComponent);
- begin
- FNoZWrite := True;
- inherited;
- end;
- procedure TGLGizmoExUIFlatText.BuildList(var rci: TGLRenderContextInfo);
- begin
- if FNoZWrite then
- rci.GLStates.Disable(stDepthTest)
- else
- rci.GLStates.Enable(stDepthTest);
- inherited;
- end;
- //------------------------------------------------------------------------------
- constructor TGLGizmoEx.Create(aOwner: TComponent);
- var
- I: Integer;
- begin
- inherited Create(aOwner);
- FHistory := TGLGizmoExActionHistoryCollection.Create(Self, TGLGizmoExActionHistoryItem);
- FPickMode := pmGetPickedObjects;
- FRotationCoef := 1;
- FMoveCoef := 0.1;
- FScaleCoef := 0.1;
- FBoundingBoxColor := TGLColor.Create(Self);
- FBoundingBoxColor.Color := clrWhite;
- FSelectionRegionColor := TGLColor.Create(Self);
- SelectionRegionColor.Color := clrBlack;
- FSelectedColor := TGLColor.Create(Self);
- FSelectedColor.Color := clrYellow;
- FVisibleInfoLabelsColor := TGLColor.Create(Self);
- FVisibleInfoLabelsColor.Color := clrYellow;
- FVisibleInfoLabelsColorChanged := False;
- FUIBaseGizmo := TGLDummyCube.Create(Self);
- //BoundingBoxes...
- FInternalRender := TGLDirectOpenGL(FUIBaseGizmo.AddNewChild(TGLDirectOpenGL));
- FInternalRender.OnRender := InternalRender;
- FUIRootHelpers := TGLDummyCube(FUIBaseGizmo.AddNewChild(TGLDummyCube));
- //Canvas...
- FInterfaceRender := TGLDirectOpenGL(FUIBaseGizmo.AddNewChild(TGLDirectOpenGL));
- FInterfaceRender.OnRender := InterfaceRender;
- FSelectedObjects := TGLPickList.Create(psMinDepth);
- //For None
- FUIRootSelect := FUIRootHelpers.AddNewChild(TGLDummyCube); // for None
- FUIRootMovement := FUIRootHelpers.AddNewChild(TGLDummyCube);
- FUIRootRotate := FUIRootHelpers.AddNewChild(TGLDummyCube);
- FUIRootScale := FUIRootHelpers.AddNewChild(TGLDummyCube);
- FUIRootAxisLabel := FUIRootHelpers.AddNewChild(TGLDummyCube);
- FUIRootVisibleInfoLabels := FUIRootHelpers.AddNewChild(TGLDummyCube);
- FUISelectLineX := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
- with FUISelectLineX do
- begin
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(1, 0, 0);
- AddNode(0.9, 0, -0.1);
- addNode(1, 0, 0);
- addNode(0.9, 0, 0.1);
- end;
- FUISelectLineY := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
- with FUISelectLineY do
- begin
- LineColor.Color := clrLime;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 1, 0);
- AddNode(0.1, 0.9, 0);
- addNode(0, 1, 0);
- addNode(-0.1, 0.9, 0);
- end;
- FUISelectLineZ := TGLGizmoExUILines(FUIRootSelect.addnewChild(TGLGizmoExUILines));
- with FUISelectLineZ do
- begin
- LineColor.Color := clrBlue;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 0, 1);
- AddNode(0.1, 0, 0.9);
- addNode(0, 0, 1);
- addNode(-0.1, 0, 0.9);
- end;
- FUIMovementLineX := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineX do
- begin
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0.2, 0, 0);
- AddNode(1, 0, 0);
- // Raycast pickable object
- FUIICMovementLineX := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineX do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(1, 0, 0);
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.15;
- BaseWidth := 0.15;
- position.SetPoint(0.6, 0, 0);
- end;
- FUIMovementArrowX := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
- with FUIMovementArrowX do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrRed;
- TurnAngle := 90;
- Height := 0.3;
- Position.X := 1;
- Slices := 8;
- Stacks := 2;
- TopRadius := 0;
- TopArrowHeadHeight := 0;
- TopArrowHeadRadius := 0;
- BottomArrowHeadHeight := 0.1;
- BottomRadius := 0.06;
- end;
- end;
- FUIMovementLineY := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineY do
- begin
- LineColor.Color := clrLime;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0.2, 0);
- AddNode(0, 1, 0);
- FUIMovementArrowY := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
- with FUIMovementArrowY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrLime;
- PitchAngle := 90;
- Height := 0.3;
- Position.Y := 1;
- Slices := 8;
- Stacks := 2;
- TopRadius := 0;
- TopArrowHeadHeight := 0;
- TopArrowHeadRadius := 0;
- BottomArrowHeadHeight := 0.1;
- BottomRadius := 0.06;
- end;
- // Raycast pickable object
- FUIICMovementLineY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(0, 1, 0);
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.15;
- BaseWidth := 0.15;
- position.SetPoint(0, 0.6, 0);
- end;
- end;
- FUIMovementLineZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineZ do
- begin
- LineColor.Color := clrBlue;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0.2);
- AddNode(0, 0, 1);
- FUIMovementArrowZ := TGLGizmoExUIArrowLine(addnewChild(TGLGizmoExUIArrowLine));
- with FUIMovementArrowZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrBlue;
- RollAngle := 90;
- Height := 0.3;
- Position.Z := 1;
- Slices := 8;
- Stacks := 2;
- TopRadius := 0;
- TopArrowHeadHeight := 0;
- TopArrowHeadRadius := 0;
- BottomArrowHeadHeight := 0.1;
- BottomRadius := 0.06;
- end;
- // Raycast pickable object
- FUIICMovementLineZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(0, 0, 1);
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.15;
- BaseWidth := 0.15;
- position.SetPoint(0, 0, 0.6);
- end;
- end;
- FUIMovementLineXY := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineXY do
- begin
- LineWidth := 1;
- Options := [loUseNodeColorForLines];
- NodesAspect := lnaInvisible;
- SplineMode := lsmSegments;
- addNode(0, 0.4, 0);
- TGLLinesNode(Nodes[0]).Color.color := clrLime;
- addNode(0.4, 0.4, 0);
- TGLLinesNode(Nodes[1]).Color.color := clrLime;
- addNode(0.4, 0.4, 0);
- TGLLinesNode(Nodes[2]).Color.color := clrRed;
- addNode(0.4, 0, 0);
- TGLLinesNode(Nodes[3]).Color.color := clrRed;
- // Raycast pickable object
- FUIMovementPlaneXY := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIMovementPlaneXY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0.01;
- addNode(0.01, 0.39, 0);
- addNode(0.39, 0.39, 0);
- addNode(0.39, 0.01, 0);
- addNode(0.01, 0.01, 0);
- end;
- FUIICMovementLineXY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineXY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(1, 0, 0);
- Height := 0.35;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.35;
- position.SetPoint(0.25, 0.25, 0);
- end;
- end;
- FUIMovementLineXZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineXZ do
- begin
- LineWidth := 1;
- Options := [loUseNodeColorForLines];
- NodesAspect := lnaInvisible;
- SplineMode := lsmSegments;
- addNode(0.4, 0, 0);
- TGLLinesNode(Nodes[0]).Color.color := clrRed;
- addNode(0.4, 0, 0.4);
- TGLLinesNode(Nodes[1]).Color.color := clrRed;
- addNode(0.4, 0, 0.4);
- TGLLinesNode(Nodes[2]).Color.color := clrBlue;
- addNode(0, 0, 0.4);
- TGLLinesNode(Nodes[3]).Color.color := clrBlue;
- FUIMovementPlaneXZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIMovementPlaneXZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0.01;
- addNode(0.39, 0, 0.01);
- addNode(0.39, 0, 0.39);
- addNode(0.01, 0, 0.39);
- addNode(0, 0, 0.01);
- end;
- // Raycast pickable object
- FUIICMovementLineXZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineXZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Alpha := 0;
- pitchAngle := 90;
- Height := 0.35;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.35;
- position.SetPoint(0.25, 0, 0.25);
- end;
- end;
- FUIMovementLineYZ := TGLGizmoExUILines(FUIRootMovement.addnewChild(TGLGizmoExUILines));
- with FUIMovementLineYZ do
- begin
- LineWidth := 1;
- Options := [loUseNodeColorForLines];
- NodesAspect := lnaInvisible;
- SplineMode := lsmSegments;
- addNode(0, 0, 0.4);
- TGLLinesNode(Nodes[0]).Color.color := clrBlue;
- addNode(0, 0.4, 0.4);
- TGLLinesNode(Nodes[1]).Color.color := clrBlue;
- addNode(0, 0.4, 0.4);
- TGLLinesNode(Nodes[2]).Color.color := clrLime;
- addNode(0, 0.4, 0);
- TGLLinesNode(Nodes[3]).Color.color := clrLime;
- FUIMovementPlaneYZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIMovementPlaneYZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0.01;
- addNode(0, 0.01, 0.39);
- addNode(0, 0.39, 0.39);
- addNode(0, 0.39, 0);
- addNode(0, 0.01, 0);
- end;
- // Raycast pickable object
- FUIICMovementLineYZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICMovementLineYZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(0, 0, 1);
- Height := 0.35;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.35;
- position.SetPoint(0, 0.25, 0.25);
- end;
- end;
- //Rotate
- FUIRotateLineXY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineXY do
- begin
- LineColor.Color := clrGray50;
- SplineMode := lsmCubicSpline;
- NodesAspect := lnaInvisible;
- LineWidth := 1;
- Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
- FUIRotateDiskXY := TGLGizmoExUIDisk(addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskXY do
- begin
- OuterRadius := 1;
- Slices := 18;
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrGray50;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIICRotateSphereXY := TGLGizmoExUISphere(addnewChild(TGLGizmoExUISphere));
- with FUIICRotateSphereXY do
- begin
- Radius := 1;
- Stop := 180;
- Slices := 18;
- TurnAngle := -90;
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clryellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- end;
- FUIRotateLineXZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineXZ do
- begin
- LineColor.Color := clrGray75;
- SplineMode := lsmCubicSpline;
- NodesAspect := lnaInvisible;
- LineWidth := 1;
- Nodes.AddXYArc(1.3, 1.3, 0, 360, 24, AffineVectorMake(0, 0, 0));
- FUIICRotateTorusXZ := TGLGizmoExUITorus(addnewChild(TGLGizmoExUITorus));
- with FUIICRotateTorusXZ do
- begin
- Rings := 18;
- Sides := 0;
- MajorRadius := 1.3;
- MinorRadius := 0.07;
- with material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- end;
- FUIRotateLineX := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineX do
- begin
- Options := [loUseNodeColorForLines];
- //Äëÿ èñïðàâëåíèÿ ïðîáëåì ñ ïðîçðà÷íîñòüþ
- lineColor.Alpha := 0.1;
- Nodecolor.Color := clrred;
- Nodecolor.Alpha := 0.1;
- TurnAngle := 90;
- SplineMode := lsmCubicSpline;
- NodesAspect := lnaInvisible;
- LineWidth := 1;
- Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
- for I := 0 to 24 do
- begin
- TGLLinesNode(Nodes[I]).Color.color := clrred;
- end;
- end;
- FUIRotateLineArrowX := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineArrowX do
- begin
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0.4, 0, 0);
- end;
- FUIRotateDiskX := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskX do
- begin
- OuterRadius := 1.01;
- Slices := 18;
- sweepangle := 10;
- StartAngle := 0;
- TurnAngle := 90;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrred;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRotateDiskX2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskX2 do
- begin
- OuterRadius := 1.01;
- Slices := 18;
- sweepangle := 10;
- StartAngle := 0;
- TurnAngle := 90;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrred;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIICRotateTorusX := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
- with FUIICRotateTorusX do
- begin
- Rings := 18;
- Sides := 0;
- MajorRadius := 1;
- MinorRadius := 0.07;
- TurnAngle := 90;
- with material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRotateLineY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineY do
- begin
- Options := [loUseNodeColorForLines];
- //Äëÿ èñïðàâëåíèÿ ïðîáëåì ñ ïðîçðà÷íîñòüþ
- lineColor.Alpha := 0.1;
- Nodecolor.Color := clrLime;
- Nodecolor.Alpha := 0.1;
- SplineMode := lsmCubicSpline;
- NodesAspect := lnaInvisible;
- LineWidth := 1;
- Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
- PitchAngle := 90;
- for I := 0 to 24 do
- begin
- TGLLinesNode(Nodes[I]).Color.color := clrLime;
- end;
- end;
- FUIRotateLineArrowY := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineArrowY do
- begin
- LineColor.Color := clrLime;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 0.4, 0);
- end;
- FUIRotateDiskY := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskY do
- begin
- OuterRadius := 1;
- Slices := 18;
- sweepangle := 20;
- startangle := 0;
- PitchAngle := 90;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrLime;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRotateDiskY2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskY2 do
- begin
- OuterRadius := 1;
- Slices := 18;
- sweepangle := 20;
- startangle := 0;
- PitchAngle := 90;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrLime;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIICRotateTorusY := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
- with FUIICRotateTorusY do
- begin
- Rings := 18;
- Sides := 0;
- MajorRadius := 1;
- MinorRadius := 0.07;
- PitchAngle := 90;
- with material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRotateLineZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineZ do
- begin
- Options := [loUseNodeColorForLines];
- //to correct transparency problem
- lineColor.Alpha := 0.1;
- Nodecolor.Color := clrBlue;
- Nodecolor.Alpha := 0.1;
- SplineMode := lsmCubicSpline;
- NodesAspect := lnaInvisible;
- LineWidth := 1;
- Nodes.AddXYArc(1, 1, 0, 360, 24, AffineVectorMake(0, 0, 0));
- for I := 0 to 24 do
- begin
- TGLLinesNode(Nodes[I]).Color.color := clrBlue;
- end;
- end;
- FUIRotateLineArrowZ := TGLGizmoExUILines(FUIRootRotate.addnewChild(TGLGizmoExUILines));
- with FUIRotateLineArrowZ do
- begin
- LineColor.Color := clrBlue;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 0, 0.4);
- end;
- FUIRotateDiskZ := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskZ do
- begin
- OuterRadius := 1;
- Slices := 18;
- SweepAngle := 10;
- StartAngle := 0;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrBlue;
- BackProperties.Diffuse.Color := clrBlue;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRotateDiskZ2 := TGLGizmoExUIDisk(FUIRootRotate.addnewChild(TGLGizmoExUIDisk));
- with FUIRotateDiskZ2 do
- begin
- OuterRadius := 1;
- Slices := 18;
- SweepAngle := 10;
- StartAngle := 0;
- with Material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrBlue;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIICRotateTorusZ := TGLGizmoExUITorus(FUIRootRotate.addnewChild(TGLGizmoExUITorus));
- with FUIICRotateTorusZ do
- begin
- Rings := 18;
- Sides := 0;
- MajorRadius := 1;
- MinorRadius := 0.07;
- with material do
- begin
- FaceCulling := fcNoCull;
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- end;
- FUIRootRotateAxisLabel := FUIRootRotate.AddNewChild(TGLDummyCube);
- FUIRotateAxisLabelX := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIRotateAxisLabelX do
- begin
- ModulateColor.Color := clrRed;
- Alignment := taCenter;
- Layout := TTextLayout.tlCenter;
- Options := Options + [ftoTwoSided];
- Position.X := 0.5;
- Scale.X := 0.010;
- Scale.Y := 0.010;
- Text := 'X';
- end;
- FUIRotateAxisLabelY := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIRotateAxisLabelY do
- begin
- ModulateColor.Color := clrLime;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.Y := 0.5;
- Scale.X := 0.010;
- Scale.Y := 0.010;
- Text := 'Y';
- end;
- FUIRotateAxisLabelZ := TGLGizmoExUIFlatText(FUIRootRotateAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIRotateAxisLabelZ do
- begin
- ModulateColor.Color := clrBlue;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.Z := 0.5;
- Scale.X := 0.010;
- Scale.Y := 0.010;
- Text := 'Z';
- end;
- //for Scale
- FUIScaleLineX := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineX do
- begin
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(1, 0, 0);
- // Raycast pickable object
- FUIICScaleLineX := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineX do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(1, 0, 0);
- Height := 0.5;
- ApexHeight := 8;
- BaseDepth := 0.15;
- BaseWidth := 0.15;
- position.SetPoint(0.8, 0, 0);
- end;
- end;
- FUIScaleLineY := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineY do
- begin
- LineColor.Color := clrLime;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 1, 0);
- // Raycast pickable object
- FUIICScaleLineY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(0, 1, 0);
- Height := 0.5;
- ApexHeight := 8;
- BaseDepth := 0.15;
- BaseWidth := 0.15;
- position.SetPoint(0, 0.8, 0);
- end;
- end;
- FUIScaleLineZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineZ do
- begin
- LineColor.Color := clrBlue;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0, 0);
- AddNode(0, 0, 1);
- // Raycast pickable object
- FUIICScaleLineZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- Up.SetVector(0, 0, 1);
- Height := 0.5;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.1;
- position.SetPoint(0, 0, 0.8);
- end;
- end;
- FUIScaleLineXY := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineXY do
- begin
- Options := [loUseNodeColorForLines];
- SplineMode := lsmSegments;
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0.7, 0);
- AddNode(0.35, 0.35, 0);
- TGLLinesNode(Nodes[0]).Color.color := clrLime;
- TGLLinesNode(Nodes[1]).Color.color := clrLime;
- AddNode(0.35, 0.35, 0);
- AddNode(0.7, 0, 0);
- TGLLinesNode(Nodes[2]).Color.color := clrRed;
- TGLLinesNode(Nodes[3]).Color.color := clrRed;
- AddNode(0.5, 0, 0);
- AddNode(0.25, 0.25, 0);
- TGLLinesNode(Nodes[4]).Color.color := clrRed;
- TGLLinesNode(Nodes[5]).Color.color := clrRed;
- AddNode(0.25, 0.25, 0);
- AddNode(0, 0.5, 0);
- TGLLinesNode(Nodes[6]).Color.color := clrLime;
- TGLLinesNode(Nodes[7]).Color.color := clrLime;
- FUIScalePlaneXY := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIScalePlaneXY do
- begin
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0.01;
- end;
- AddNode(0, 0.7, 0);
- AddNode(0.35, 0.35, 0);
- AddNode(0.7, 0, 0);
- AddNode(0.5, 0, 0);
- AddNode(0.25, 0.25, 0);
- AddNode(0, 0.5, 0);
- end;
- // Raycast pickable object
- FUIICScaleLineXY := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineXY do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- rollAngle := 45;
- turnAngle := 45;
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.1;
- position.SetPoint(0.3, 0.3, 0);
- end;
- end;
- FUIScaleLineXZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineXZ do
- begin
- Options := [loUseNodeColorForLines];
- SplineMode := lsmSegments;
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0.7, 0, 0);
- AddNode(0.35, 0, 0.35);
- TGLLinesNode(Nodes[0]).Color.color := clrRed;
- TGLLinesNode(Nodes[1]).Color.color := clrRed;
- AddNode(0.35, 0, 0.35);
- AddNode(0, 0, 0.7);
- TGLLinesNode(Nodes[2]).Color.color := clrBlue;
- TGLLinesNode(Nodes[3]).Color.color := clrBlue;
- AddNode(0, 0, 0.5);
- AddNode(0.25, 0, 0.25);
- TGLLinesNode(Nodes[4]).Color.color := clrBlue;
- TGLLinesNode(Nodes[5]).Color.color := clrBlue;
- AddNode(0.25, 0, 0.25);
- AddNode(0.5, 0, 0);
- TGLLinesNode(Nodes[6]).Color.color := clrRed;
- TGLLinesNode(Nodes[7]).Color.color := clrRed;
- FUIScalePlaneXZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIScalePlaneXZ do
- begin
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- AddNode(0.7, 0, 0);
- AddNode(0.35, 0, 0.35);
- AddNode(0, 0, 0.7);
- AddNode(0, 0, 0.5);
- AddNode(0.25, 0, 0.25);
- AddNode(0.5, 0, 0);
- end;
- // Raycast pickable object
- FUIICScaleLineXZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineXZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- turnAngle := -45;
- pitchAngle := 90;
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.1;
- position.SetPoint(0.3, 0, 0.3);
- end;
- end;
- FUIScaleLineYZ := TGLGizmoExUILines(FUIRootScale.addnewChild(TGLGizmoExUILines));
- with FUIScaleLineYZ do
- begin
- Options := [loUseNodeColorForLines];
- SplineMode := lsmSegments;
- LineColor.Color := clrRed;
- LineWidth := 1;
- NodesAspect := lnaInvisible;
- AddNode(0, 0.7, 0);
- AddNode(0, 0.35, 0.35);
- TGLLinesNode(Nodes[0]).Color.color := clrLime;
- TGLLinesNode(Nodes[1]).Color.color := clrLime;
- AddNode(0, 0.35, 0.35);
- AddNode(0, 0, 0.7);
- TGLLinesNode(Nodes[2]).Color.color := clrBlue;
- TGLLinesNode(Nodes[3]).Color.color := clrBlue;
- AddNode(0, 0, 0.5);
- AddNode(0, 0.25, 0.25);
- TGLLinesNode(Nodes[4]).Color.color := clrBlue;
- TGLLinesNode(Nodes[5]).Color.color := clrBlue;
- AddNode(0, 0.25, 0.25);
- AddNode(0, 0.5, 0);
- TGLLinesNode(Nodes[6]).Color.color := clrLime;
- TGLLinesNode(Nodes[7]).Color.color := clrLime;
- FUIScalePlaneYZ := TGLGizmoExUIPolyGon(addnewChild(TGLGizmoExUIPolyGon));
- with FUIScalePlaneYZ do
- begin
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- AddNode(0, 0.7, 0);
- AddNode(0, 0.35, 0.35);
- AddNode(0, 0, 0.7);
- AddNode(0, 0, 0.5);
- AddNode(0, 0.25, 0.25);
- AddNode(0, 0.5, 0);
- end;
- // Raycast pickable object
- FUIICScaleLineYZ := TGLGizmoExUIFrustrum(AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineYZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- pitchAngle := 45;
- Height := 0.8;
- ApexHeight := 8;
- BaseDepth := 0.1;
- BaseWidth := 0.1;
- position.SetPoint(0, 0.3, 0.3);
- end;
- end;
- FUIScalePlaneXYZ := TGLGizmoExUIPolyGon(FUIRootScale.addnewChild(TGLGizmoExUIPolyGon));
- with FUIScalePlaneXYZ do
- begin
- with Material do
- begin
- MaterialOptions := [moNoLighting];
- BlendingMode := bmTransparency;
- FrontProperties.Diffuse.Color := clrYellow;
- FrontProperties.Diffuse.Alpha := 0;
- end;
- AddNode(0.5, 0, 0);
- AddNode(0, 0.5, 0);
- AddNode(0, 0, 0.5);
- AddNode(0.5, 0, 0);
- // Raycast pickable object
- FUIICScaleLineXYZ := TGLGizmoExUIFrustrum(FUIRootScale.AddNewChild(TGLGizmoExUIFrustrum));
- with FUIICScaleLineXYZ do
- begin
- Material.MaterialOptions := [moNoLighting];
- Material.BlendingMode := bmTransparency;
- Material.FrontProperties.Diffuse.Color := clrYellow;
- Material.FrontProperties.Diffuse.Alpha := 0;
- turnAngle := -45;
- rollAngle := 35;
- Height := 0.5;
- ApexHeight := 0.6;
- BaseDepth := 0.6;
- BaseWidth := 0.05;
- position.SetPoint(0.15, 0.2, 0.15);
- end;
- end;
- FUIScaleArrowX := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
- with FUIScaleArrowX do
- begin
- Slices := 8;
- Stacks := 2;
- Radius := 0.04;
- Position.X := 1;
- with material do
- begin
- MaterialOptions := [moNoLighting];
- FrontProperties.Diffuse.Color := clrRed;
- end;
- end;
- FUIScaleArrowY := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
- with FUIScaleArrowY do
- begin
- Slices := 8;
- Stacks := 2;
- Radius := 0.04;
- Position.Y := 1;
- with material do
- begin
- //FaceCulling := fcNoCull;
- // FrontProperties.PolygonMode := pmFill;
- // BackProperties.PolygonMode := pmFill;
- MaterialOptions := [moNoLighting];
- FrontProperties.Diffuse.Color := clrLime;
- //FrontProperties.Emission.Color := clrLime;
- end;
- end;
- FUIScaleArrowZ := TGLGizmoExUISphere(FUIRootScale.addnewChild(TGLGizmoExUISphere));
- with FUIScaleArrowZ do
- begin
- Slices := 8;
- Stacks := 2;
- Radius := 0.04;
- Position.Z := 1;
- with material do
- begin
- // FaceCulling := fcNoCull;
- //FrontProperties.PolygonMode := pmFill;
- //BackProperties.PolygonMode := pmFill;
- MaterialOptions := [moNoLighting];
- FrontProperties.Diffuse.Color := clrBlue;
- //FrontProperties.Emission.Color := clrBlue;
- end;
- end;
- //For Axis
- FUIAxisLabelX := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIAxisLabelX do
- begin
- ModulateColor.Color := clrRed;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.X := 1.3;
- Scale.X := 0.015;
- Scale.Y := 0.015;
- Text := 'X';
- end;
- FUIAxisLabelY := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIAxisLabelY do
- begin
- ModulateColor.Color := clrLime;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.Y := 1.3;
- Scale.X := 0.015;
- Scale.Y := 0.015;
- Text := 'Y';
- end;
- FUIAxisLabelZ := TGLGizmoExUIFlatText(FUIRootAxisLabel.AddNewChild(TGLGizmoExUIFlatText));
- with FUIAxisLabelZ do
- begin
- ModulateColor.Color := clrBlue;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.Z := 1.3;
- Scale.X := 0.015;
- Scale.Y := 0.015;
- Text := 'Z';
- end;
- FUIVisibleInfoLabels := TGLGizmoExUIFlatText(FUIRootVisibleInfoLabels.AddNewChild(TGLGizmoExUIFlatText));
- with FUIVisibleInfoLabels do
- begin
- ModulateColor.Color := clrYellow;
- Alignment := taCenter;
- Layout := tlCenter;
- Options := Options + [ftoTwoSided];
- Position.Y := 1.8;
- Position.X := 0;
- Scale.X := 0.01;
- Scale.Y := 0.01;
- Text := '';
- end;
- HistoryStepsCount := 30;
- BoundingBoxColor.Color := clrWhite;
- VisibleInfoLabelsColor.Color := clrYellow;
- SelectedColor.Color := clrYellow;
- SelectionRegionColor.Color := clrBlack;
- ShowAxisLabel := True;
- ShowObjectInfos := True;
- ShowBoundingBox := True;
- FReferenceCoordSystem := rcsView;
- FEnableHistory := True;
- FinfoLabelCoordType := ilcChangeRate;
- AntiAliasedLines := True;
- FOperation := gopNone;
- FSelAxis := gaNone;
- EnableMultiSelection := True;
- FSelectionRegion := gsrRectangular;
- EnableLoopCursorMoving := True;
- FUIRootHelpers.Visible := False;
- OperationMode := gomSelect;
- FVisibleVisibleInfoLabels := FVisibleVisibleInfoLabels + [vliName, vliOperation, vliCoords];
- GizmoThickness := 1;
- AutoZoom := True;
- AutoZoomFactor := 5.0;
- ZoomFactor := 0.35;
- Enabled := True;
- FNoZWrite := True;
- FExcludeObjectsList := TStringList.Create;
- FExcludeClassNameList := TStringList.Create;
- end;
- destructor TGLGizmoEx.Destroy;
- begin
- if Assigned(FRootGizmo) then
- FRootGizmo.DeleteChildren
- else
- begin
- FUIBaseGizmo.DeleteChildren;
- FUIBaseGizmo.Free;
- end;
- FRootObjects := nil;
- FGizmoTmpRoot := nil;
- FBoundingBoxColor.Free;
- SelectionRegionColor.Free;
- FSelectedObjects.Free;
- FSelectedColor.Free;
- FVisibleInfoLabelsColor.Free;
- FExcludeObjectsList.Free;
- FExcludeClassNameList.Free;
- // FUndoHistory has to be nil before Notification() is called.
- FreeAndNil(FHistory);
- inherited Destroy;
- end;
- procedure TGLGizmoEx.SetVisible(const AValue: Boolean);
- begin
- FUIBaseGizmo.Visible := AValue;
- end;
- function TGLGizmoEx.GetVisible: Boolean;
- begin
- Result := FUIBaseGizmo.Visible;
- end;
- procedure TGLGizmoEx.SetSelectionRegion(const AValue: TGLGizmoExSelectionRegion);
- begin
- if FSelectionRegion <> AValue then
- FSelectionRegion := AValue;
- end;
- procedure TGLGizmoEx.SetShowAxisLabel(const AValue: Boolean);
- begin
- if FShowAxisLabel <> AValue then
- begin
- FShowAxisLabel := AValue;
- FUIRootRotateAxisLabel.Visible := AValue;
- if FOperationMode <> gomRotate then
- FUIRootAxisLabel.Visible := AValue;
- end;
- end;
- procedure TGLGizmoEx.SetSelAxis(aValue: TGLGizmoExAxis);
- begin
- if FSelAxis <> aValue then
- begin
- FSelAxis := aValue;
- if Assigned(OnAxisSelected) then
- OnAxisSelected(self, FSelAxis);
- end;
- end;
- procedure TGLGizmoEx.SetPickMode(APickMode: TGLGizmoExPickMode);
- begin
- if APickMode <> FPickMode then
- FPickMode := APickMode;
- end;
- procedure TGLGizmoEx.SetAutoZoomFactor(const AValue: Single);
- begin
- if (FAutoZoomFactor <> AValue) and (AValue > 0) then
- begin
- FAutoZoomFactor := AValue;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetZoomFactor(const AValue: Single);
- begin
- if (FZoomFactor <> AValue) and (AValue > 0) then
- begin
- FZoomFactor := AValue;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetShowObjectInfos(const AValue: Boolean);
- begin
- if FShowObjectInfos <> AValue then
- begin
- FShowObjectInfos := AValue;
- FUIRootVisibleInfoLabels.Visible := FShowObjectInfos;
- end;
- end;
- procedure TGLGizmoEx.SetShowBoundingBox(const AValue: Boolean);
- begin
- if FShowBoundingBox <> AValue then
- FShowBoundingBox := AValue;
- end;
- function TGLGizmoEx.GetPickList: TGLPickList;
- begin
- Result := FSelectedObjects;
- end;
- procedure TGLGizmoEx.SetPickList(aValue: TGLPickList);
- var
- I: Integer;
- begin
- if FSelectedObjects <> aValue then
- if aValue.Count - 1 >= 0 then
- begin
- FSelectedObjects.Clear;
- for I := 0 to aValue.Count - 1 do
- with aValue do
- FSelectedObjects.AddHit(hit[I], SubObjects[I], NearDistance[I], FarDistance[I]);
- UpdateGizmo();
- end
- else
- LooseSelection();
- end;
- procedure TGLGizmoEx.SetSelectedObj(const Value: TGLBaseSceneObject);
- begin
- if FSelectedObjects.FindObject(Value) <> -1 then
- Exit;
- if (FSelectedObjects.Count - 1 >= 0) or (Value = nil) then
- ClearSelection;
- if Value <> nil then
- FSelectedObjects.AddHit(Value, nil, 0, 0);
- UpdateGizmo();
- end;
- function TGLGizmoEx.GetSelectedObj: TGLBaseSceneObject;
- begin
- Result := nil;
- if FSelectedObjects.Count - 1 = -1 then
- Result := nil
- else
- if FSelectedObjects.Count - 1 >= 0 then
- Result := TGLBaseSceneObject(FSelectedObjects.Hit[0]);
- end;
- procedure TGLGizmoEx.AddObjToSelectionList(Obj: TGLBaseSceneObject);
- begin
- if (Obj <> nil) and (FSelectedObjects.FindObject(Obj) = -1) then
- FSelectedObjects.AddHit(Obj, nil, 0, 0);
- end;
- procedure TGLGizmoEx.RemoveObjFromSelectionList(Obj: TGLBaseSceneObject);
- var
- I: Integer;
- begin
- I := FSelectedObjects.FindObject(Obj);
- if I <> -1 then
- FSelectedObjects.Delete(I);
- end;
- procedure TGLGizmoEx.AssignPickList(aList: TGLPickList; RemoveObj: Boolean = False);
- function WithOutGizmoElements(obj: TGLBasesceneobject): Boolean;
- begin
- if (obj <> FInterfaceRender) and
- (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
- Result := True
- else
- Result := False;
- end;
- var
- I: Integer;
- begin
- for I := 0 to aList.Count - 1 do
- with aList do
- if WithOutGizmoElements(TGLBaseSceneObject(Hit[I])) then
- if not RemoveObj then
- begin
- if (Hit[I] <> nil) and (FSelectedObjects.FindObject(Hit[I]) = -1) then
- FSelectedObjects.AddHit(Hit[I], SubObjects[I], NearDistance[I], FarDistance[I]);
- end
- else
- if (Hit[I] <> nil) and (FSelectedObjects.FindObject(Hit[I]) <> -1) then
- FSelectedObjects.Delete(FSelectedObjects.FindObject(Hit[I]));
- end;
- procedure TGLGizmoEx.InterfaceRender(Sender: TObject; var rci: TGLRenderContextInfo);
- procedure cLine(glc: TGLCanvas; p1, p2: TPoint);
- begin
- glc.Line(p1.X, p1.Y, p2.X, p2.Y);
- end;
- var
- glc: TGLCanvas;
- I: Integer;
- LastCurPosX, LastCurPosY, CurPosX, CurPosY: Single;
- begin
- if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
- Exit;
- //here takes place rendering of lines and circles on canvas
- //according to modes, it's a pity that canvas has restrictions
- if FShowMultiSelecting then
- begin
- glc := TGLCanvas.Create(Viewer.Width, Viewer.Height);
- glc.PenColor := FSelectionRegionColor.AsWinColor;
- glc.PenWidth := 1;
- LastCurPosX := fLastCursorPos.X;
- LastCurPosY := fLastCursorPos.Y;
- CurPosX := fCursorPos.X;
- CurPosY := fCursorPos.Y;
- with glc do
- case FSelectionRegion of
- gsrRectangular: FrameRect(LastCurPosX, LastCurPosY, CurPosX, CurPosY);
- gsrCircular: Ellipse(LastCurPosX, LastCurPosY,
- MaxFloat(abs(CurPosX - LastCurPosX),
- abs(CurPosY - LastCurPosY)));
- gsrFence:
- begin
- for I := Low(FSelectionRec) to High(FSelectionRec) do
- if I <> High(FSelectionRec) then
- cLine(glc, FSelectionRec[I], FSelectionRec[I + 1])
- else
- cLine(glc, FSelectionRec[I], fcursorPos);
- //glc.PenWidth thickness of rectangle
- //it's necessary to show that the begining and the end
- // of a figure are joining and when cursor is near begining of array
- // then appears square, that show to user that he picked right object
- if High(FSelectionRec) > 0 then
- with FSelectionRec[Low(FSelectionRec)] do
- if IsInRange(CurPosX, X + 2, X - 2) and IsInRange(CurPosY, Y + 2, Y - 2) then
- FillRect(CurPosX - PenWidth - 2, CurPosY - PenWidth - 2,
- CurPosX + PenWidth + 2, CurPosY + PenWidth + 2);
- end;
- gsrLasso:
- begin
- //here showing arrays of lines
- //when additional line formed by begining and and of array
- for I := Low(FSelectionRec) to High(FSelectionRec) do
- if I <> High(FSelectionRec) then
- cLine(glc, FSelectionRec[I], FSelectionRec[I + 1])
- else
- cLine(glc, FSelectionRec[I], FSelectionRec[Low(FSelectionRec)]);
- end;
- end;
- glc.Destroy;
- end;
- end;
- procedure TGLGizmoEx.InternalRender(Sender: TObject; var rci: TGLRenderContextInfo);
- procedure ShowBoundingBox(aObject: TGLBaseSceneObject);
- const
- ACorners: array [0..7, 0..2] of Byte = ((1, 3, 4),
- (0, 2, 5),
- (1, 6, 3),
- (0, 2, 7),
- (0, 5, 7),
- (1, 4, 6),
- (2, 5, 7),
- (3, 4, 6));
- var
- I, J: Byte;
- BB: THmgBoundingBox;
- AVector: TGLVector;
- begin
- if aObject = nil then
- Exit;
- BB := aObject.BoundingBoxAbsolute(False);
- for I := 0 to 7 do
- begin
- for J := 0 to 2 do
- begin
- AVector := VectorSubtract(BB.BBox[ACorners[I][J]], BB.BBox[I]);
- AVector := VectorScale(AVector, 0.25);
- AVector := VectorAdd(AVector, BB.BBox[I]);
- gl.Begin_(GL_LINES);
- gl.Vertex3f(BB.BBox[I].X, BB.BBox[I].Y, BB.BBox[I].Z);
- gl.Vertex3f(AVector.X, AVector.Y, AVector.Z);
- gl.End_;
- end;
- end;
- end;
- //test#12 result is positive, but only for 2d
- //
- procedure ShowText(const Text: UnicodeString; Position: TGLVector; Scale: TGLVector; Color: TGLVector);
- var
- FLayout: TTextLayout;
- FAlignment: TAlignment;
- wm: TGLMatrix;
- I, J: Integer;
- begin
- if not Assigned(FLabelFont) and (Text = '') then
- Exit;
- rci.GLStates.Enable(stDepthTest);
- FLayout := TTextLayout.tlCenter;
- FAlignment := taCenter;
- gl.MatrixMode(GL_MODELVIEW);
- gl.PushMatrix;
- wm := rci.PipelineTransformation.ViewMatrix^;
- TransposeMatrix(wm);
- for I := 0 to 2 do
- for J := 0 to 2 do
- if I = J then
- wm.V[I].V[J] := 1
- else
- wm.V[I].V[J] := 0;
- gl.LoadMatrixf(@wm);
- rci.GLStates.PolygonMode := pmFill;
- gl.Scalef(Scale.X, Scale.Y, Scale.Z);
- gl.Translatef(Position.X, Position.Y, Position.Z);
- if Color.W <> 1 then
- begin
- rci.GLStates.Enable(stBlend);
- rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
- end;
- rci.GLStates.Disable(stDepthTest);
- rci.GLStates.Disable(stCullFace);
- FLabelFont.RenderString(rci, Text, FAlignment, FLayout, Color);
- gl.PopMatrix;
- end;
- var
- I: Integer;
- begin
- if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
- Exit;
- if FShowBoundingBox and (FSelectedObjects.Count - 1 >= 0) then
- begin
- rci.GLStates.Disable(stLighting);
- if FAntiAliasedLines then
- rci.GLStates.Enable(stLineSmooth);
- if (FGizmoThickness >= 0.5) and (FGizmoThickness <= 7) then
- rci.GLStates.LineWidth := FGizmoThickness
- else
- rci.GLStates.LineWidth := 1;
- gl.ColorMaterial(GL_FRONT, GL_EMISSION);
- rci.GLStates.Enable(stColorMaterial);
- gl.Color4fv(@FBoundingBoxColor.Color);
- for I := 0 to FSelectedObjects.Count - 1 do
- ShowBoundingBox(TGLBaseSceneObject(FSelectedObjects.Hit[I]));
- end;
- rci.GLStates.Disable(stColorMaterial);
- end;
- procedure TGLGizmoEx.SetReferenceCoordSystem(aValue: TGLGizmoExReferenceCoordinateSystem);
- begin
- if FReferenceCoordSystem <> aValue then
- begin
- FReferenceCoordSystem := aValue;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetHistoryStepsCount(aValue: Integer);
- begin
- if (FHistoryStepsCount <> aValue) and (aValue > 5) then
- begin
- FHistoryStepsCount := aValue;
- FHistory.FItemsMaxCount := aValue;
- end;
- end;
- procedure TGLGizmoEx.SetCanChangeWithChildren(AValue: Boolean);
- begin
- if FCanChangeWithChildren <> AValue then
- FCanChangeWithChildren := AValue;
- end;
- procedure TGLGizmoEx.SetAALines(aValue: Boolean);
- begin
- if FAntiAliasedLines <> aValue then
- begin
- FAntiAliasedLines := aValue;
- FUISelectLineX.AntiAliased := aValue;
- FUISelectLineY.AntiAliased := aValue;
- FUISelectLineZ.AntiAliased := aValue;
- FUIMovementLineX.AntiAliased := aValue;
- FUIMovementLineY.AntiAliased := aValue;
- FUIMovementLineZ.AntiAliased := aValue;
- FUIMovementLineXY.AntiAliased := aValue;
- FUIMovementLineXZ.AntiAliased := aValue;
- FUIMovementLineYZ.AntiAliased := aValue;
- FUIRotateLineX.AntiAliased := aValue;
- FUIRotateLineY.AntiAliased := aValue;
- FUIRotateLineZ.AntiAliased := aValue;
- FUIrotateLineXY.AntiAliased := aValue;
- FUIRotateLineXZ.AntiAliased := aValue;
- FUIRotateLineArrowX.AntiAliased := aValue;
- FUIRotateLineArrowY.AntiAliased := aValue;
- FUIRotateLineArrowZ.AntiAliased := aValue;
- FUIScaleLineX.AntiAliased := aValue;
- FUIScaleLineY.AntiAliased := aValue;
- FUIScaleLineZ.AntiAliased := aValue;
- FUIScaleLineXY.AntiAliased := aValue;
- FUIScaleLineXZ.AntiAliased := aValue;
- FUIScaleLineYZ.AntiAliased := aValue;
- end;
- end;
- procedure TGLGizmoEx.SetInfoLabelCoordType(aValue: TInfoLabelCoordType);
- begin
- if fInfoLabelCoordType <> aValue then
- begin
- fInfoLabelCoordType := aValue;
- UpdateVisibleInfoLabels;
- end;
- end;
- procedure TGLGizmoEx.SetAngleDisk(aAngle: Single);
- var
- Disk1alpha, Disk2alpha, Disk1Angle, Disk2Angle: Single;
- begin
- Disk1alpha := 0;
- Disk2alpha := 0;
- Disk1Angle := 0;
- Disk2Angle := 0;
- if aAngle = 0 then
- begin
- fchangerate := NullVector;
- FUIRotateDiskX.SweepAngle := 0;
- FUIRotateDiskY.SweepAngle := 0;
- FUIRotateDiskZ.SweepAngle := 0;
- FUIRotateDiskX.Material.FrontProperties.Diffuse.Alpha := 0;
- FUIRotateDiskY.Material.FrontProperties.Diffuse.Alpha := 0;
- FUIRotateDiskZ.Material.FrontProperties.Diffuse.Alpha := 0;
- FUIRotateDiskX2.SweepAngle := 0;
- FUIRotateDiskY2.SweepAngle := 0;
- FUIRotateDiskZ2.SweepAngle := 0;
- FUIRotateDiskX2.Material.FrontProperties.Diffuse.Alpha := 0;
- FUIRotateDiskY2.Material.FrontProperties.Diffuse.Alpha := 0;
- FUIRotateDiskZ2.Material.FrontProperties.Diffuse.Alpha := 0;
- end
- else
- if (abs(aAngle) > 0) and (abs(aAngle) <= 360) then
- begin
- Disk1alpha := 0.3;
- Disk2alpha := 0;
- Disk1Angle := aAngle;
- Disk2Angle := 0;
- end
- else
- if (abs(aAngle) > 360) and (abs(aAngle) <= 720) then
- begin
- Disk1alpha := 0.3;
- Disk2alpha := 0.3;
- Disk1Angle := 360;
- if aAngle > 0 then
- Disk2Angle := aAngle - 360
- else
- Disk2Angle := aAngle + 360;
- end
- else
- if (abs(aAngle) > 720) and (abs(aAngle) <= 1080) then
- begin
- Disk1alpha := 0.5;
- Disk2alpha := 0.3;
- Disk1Angle := 360;
- if aAngle > 0 then
- Disk2Angle := aAngle - 720
- else
- Disk2Angle := aAngle + 720;
- end
- else
- if (abs(aAngle) > 1080) and (abs(aAngle) <= 1440) then
- begin
- Disk1alpha := 0.6;
- Disk2alpha := 0.3;
- Disk1Angle := 360;
- if aAngle > 0 then
- Disk2Angle := aAngle - 1080
- else
- Disk2Angle := aAngle + 1080;
- end
- else
- if (abs(aAngle) > 1440) then
- begin
- Disk1alpha := 0.6;
- Disk2alpha := 0.3;
- Disk1Angle := 360;
- Disk2Angle := 360;
- end;
- case SelAxis of
- gaX:
- begin
- FUIRotateDiskX.SweepAngle := Disk1Angle;
- FUIRotateDiskX.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
- FUIRotateDiskX2.SweepAngle := Disk2Angle;
- FUIRotateDiskX2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
- end;
- gaY:
- begin
- FUIRotateDiskY.SweepAngle := Disk1Angle;
- FUIRotateDiskY.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
- FUIRotateDiskY2.SweepAngle := Disk2Angle;
- FUIRotateDiskY2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
- end;
- gaZ:
- begin
- FUIRotateDiskZ.SweepAngle := Disk1Angle;
- FUIRotateDiskZ.Material.FrontProperties.Diffuse.Alpha := Disk1alpha;
- FUIRotateDiskZ2.SweepAngle := Disk2Angle;
- FUIRotateDiskZ2.Material.FrontProperties.Diffuse.Alpha := Disk2alpha;
- end;
- end;
- end;
- procedure TGLGizmoEx.SetBoundingBoxColor(const AValue: TGLColor);
- begin
- if AValue <> FBoundingBoxColor then
- begin
- FBoundingBoxColor.Color := AValue.Color;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetSelectedColor(const AValue: TGLColor);
- begin
- if AValue <> FSelectedColor then
- begin
- FSelectedColor.Color := AValue.Color;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetOperation(const Value: TGLGizmoExOperation);
- begin
- if FOperation <> Value then
- begin
- FOperation := Value;
- if Assigned(OnOperationChange) then
- OnOperationChange(self);
- end;
- end;
- procedure TGLGizmoEx.SetOperationMode(const Value: TGLGizmoExOperationMode);
- begin
- if FOperationMode <> Value then
- begin
- FOperationMode := Value;
- if Value = gomNone then
- begin
- Visible := False;
- Enabled := False;
- end
- else
- begin
- Visible := True;
- Enabled := True;
- end;
- if Value = gomSelect then
- FUIRootSelect.Visible := True
- else
- FUIRootSelect.Visible := False;
- if Value = gomMove then
- FUIRootMovement.Visible := True
- else
- FUIRootMovement.Visible := False;
- if Value = gomrotate then
- begin
- FUIRootAxisLabel.Visible := False;
- FUIRootRotate.Visible := True;
- end
- else
- begin
- FUIRootRotate.Visible := False;
- FUIRootAxisLabel.Visible := ShowAxisLabel;
- end;
- if Value = gomscale then
- FUIRootScale.Visible := True
- else
- FUIRootScale.Visible := False;
- if Assigned(OnOperationModeChange) then
- OnOperationModeChange(self);
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetNoZWrite(const Value: Boolean);
- begin
- if fNoZWrite <> Value then
- begin
- fNoZWrite := Value;
- //For Select
- FUISelectLineX.NoZWrite := Value;
- FUISelectLineY.NoZWrite := Value;
- FUISelectLineZ.NoZWrite := Value;
- //For Move
- FUIMovementLineX.NoZWrite := Value;
- FUIMovementLineY.NoZWrite := Value;
- FUIMovementLineZ.NoZWrite := Value;
- FUIMovementLineXY.NoZWrite := Value;
- FUIMovementLineXZ.NoZWrite := Value;
- FUIMovementLineYZ.NoZWrite := Value;
- FUIMovementArrowX.NoZWrite := Value;
- FUIMovementArrowY.NoZWrite := Value;
- FUIMovementArrowZ.NoZWrite := Value;
- FUIMovementPlaneXY.NoZWrite := Value;
- FUIMovementPlaneXZ.NoZWrite := Value;
- FUIMovementPlaneYZ.NoZWrite := Value;
- FUIICMovementLineX.NoZWrite := Value;
- FUIICMovementLineY.NoZWrite := Value;
- FUIICMovementLineZ.NoZWrite := Value;
- FUIICMovementLineXY.NoZWrite := Value;
- FUIICMovementLineXZ.NoZWrite := Value;
- FUIICMovementLineYZ.NoZWrite := Value;
- //ForRotate
- FUIRotateLineX.NoZWrite := Value;
- FUIRotateLineY.NoZWrite := Value;
- FUIRotateLineZ.NoZWrite := Value;
- FUIRotateLineXY.NoZWrite := Value;
- FUIRotateLineXZ.NoZWrite := Value;
- FUIICRotateTorusX.NoZWrite := Value;
- FUIICRotateTorusY.NoZWrite := Value;
- FUIICRotateTorusZ.NoZWrite := Value;
- FUIICRotateTorusXZ.NoZWrite := Value;
- FUIRotateDiskXY.NoZWrite := Value;
- FUIRotateDiskX.NoZWrite := Value;
- FUIRotateDiskY.NoZWrite := Value;
- FUIRotateDiskZ.NoZWrite := Value;
- FUIRotateDiskX2.NoZWrite := Value;
- FUIRotateDiskY2.NoZWrite := Value;
- FUIRotateDiskZ2.NoZWrite := Value;
- FUIICRotateSphereXY.NoZWrite := Value;
- FUIRotateLineArrowX.NoZWrite := Value;
- FUIRotateLineArrowY.NoZWrite := Value;
- FUIRotateLineArrowZ.NoZWrite := Value;
- FUIRotateAxisLabelX.NoZWrite := Value;
- FUIRotateAxisLabelY.NoZWrite := Value;
- FUIRotateAxisLabelZ.NoZWrite := Value;
- //ForScale
- FUIScaleArrowX.NoZWrite := Value;
- FUIScaleArrowY.NoZWrite := Value;
- FUIScaleArrowZ.NoZWrite := Value;
- FUIScaleLineX.NoZWrite := Value;
- FUIScaleLineY.NoZWrite := Value;
- FUIScaleLineZ.NoZWrite := Value;
- FUIScaleLineXY.NoZWrite := Value;
- FUIScaleLineYZ.NoZWrite := Value;
- FUIScaleLineXZ.NoZWrite := Value;
- FUIICScaleLineX.NoZWrite := Value;
- FUIICScaleLineY.NoZWrite := Value;
- FUIICScaleLineZ.NoZWrite := Value;
- FUIICScaleLineXY.NoZWrite := Value;
- FUIICScaleLineXZ.NoZWrite := Value;
- FUIICScaleLineYZ.NoZWrite := Value;
- FUIICScaleLineXYZ.NoZWrite := Value;
- FUIScalePlaneXY.NoZWrite := Value;
- FUIScalePlaneXZ.NoZWrite := Value;
- FUIScalePlaneYZ.NoZWrite := Value;
- FUIScalePlaneXYZ.NoZWrite := Value;
- FUIAxisLabelX.NoZWrite := Value;
- FUIAxisLabelY.NoZWrite := Value;
- FUIAxisLabelZ.NoZWrite := Value;
- FUIVisibleInfoLabels.NoZWrite := Value;
- end;
- end;
- procedure TGLGizmoEx.SetEnableLoopCursorMoving(const AValue: Boolean);
- begin
- if FEnableLoopCursorMoving <> AValue then
- FEnableLoopCursorMoving := AValue;
- end;
- procedure TGLGizmoEx.SetEnableMultiSelection(const AValue: Boolean);
- begin
- if FEnableMultiSelection <> AValue then
- begin
- FEnableMultiSelection := AValue;
- FInterfaceRender.Visible := AValue;
- end;
- end;
- procedure TGLGizmoEx.MultiSelMouseDown(X, Y: Integer);
- begin
- flastcursorPos := Point(X, Y);
- fcursorPos := point(X, Y);
- if (fSelectionRegion = gsrFence) and FShowMultiSelecting then
- begin
- SetLength(FSelectionRec, Length(FSelectionRec) + 1);
- FSelectionRec[high(FSelectionRec)] := point(X, Y);
- end;
- end;
- procedure TGLGizmoEx.MultiSelMouseMove(X, Y: Integer);
- begin
- //calculation starts when the mouse button is down
- //ans distance from pick pisition is not more then 10
- if Moving and not FShowMultiSelecting and
- (Dist(point(X, Y), flastcursorPos) > 10) then
- begin
- FShowMultiSelecting := True;
- if fSelectionRegion = gsrFence then
- begin
- SetLength(FSelectionRec, Length(FSelectionRec) + 1);
- FSelectionRec[high(FSelectionRec)] := point(X, Y);
- end;
- end;
- if FShowMultiSelecting then
- begin
- fcursorPos := point(X, Y);
- //creating lines when moving mouse
- if (fSelectionRegion = gsrLasso) and
- //clculate distance between two points to view as in 3D Max
- (Dist(point(X, Y), flastcursorPos) > 20) then
- begin
- flastcursorPos := point(X, Y);
- SetLength(FSelectionRec, Length(FSelectionRec) + 1);
- FSelectionRec[high(FSelectionRec)] := point(X, Y);
- end;
- end;
- end;
- procedure TGLGizmoEx.MultiSelMouseUp(X, Y: Integer);
- procedure SelectAssignMode(pick: TGLPickList);
- begin
- if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
- AssignPickList(pick)
- else
- if FCanRemoveObjFromSelectionList then
- AssignPickList(pick, FCanRemoveObjFromSelectionList)
- else
- if FCanAddObjtoSelectionList then
- AssignPickList(pick);
- end;
- var
- I, J: Integer;
- pick: TGLPickList;
- p1, p2: TPoint;
- Line: TGLGizmoExSelRec;
- LastCurPosX, LastCurPosY, CurPosX, CurPosY: Single;
- begin
- LastCurPosX := flastcursorPos.X;
- LastCurPosY := flastcursorPos.Y;
- CurPosX := fcursorPos.X;
- CurPosY := fcursorPos.Y;
- if (fSelectionRegion = gsrRectangular) then
- begin
- pick := InternalGetPickedObjects(X - 1, Y - 1, flastcursorPos.X + 1, flastcursorPos.Y + 1, 8);
- if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
- FSelectedObjects.Clear;
- SelectAssignMode(pick);
- pick.Free;
- if Assigned(onSelect) then
- onSelect(self, FSelectedObjects);
- FShowMultiSelecting := False;
- end;
- if (fSelectionRegion = gsrCircular) then
- begin
- FShowMultiSelecting := False;
- if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
- FSelectedObjects.Clear;
- for I := 0 to viewer.Height - 1 do
- if IsLineIntCirlce(Maxfloat(abs(CurPosX - LastCurPosX),
- abs(CurPosY - LastCurPosY)),
- flastcursorPos, point(0, I), point(viewer.Width, I), p1, p2) >= 0 then
- if (I mod 2 = 0) then
- begin
- pick := InternalGetPickedObjects(p2.X - 1, p2.Y - 1, p1.X + 1, p1.Y + 1, 8);
- SelectAssignMode(pick);
- pick.Free;
- end;
- if Assigned(onSelect) then
- onSelect(self, FSelectedObjects);
- end;
- if (fSelectionRegion = gsrFence) and (high(FSelectionRec) > 0) then
- with FSelectionRec[Low(FSelectionRec)] do
- //verify if a pick is near point, not to seek a centre
- if IsInRange(CurPosX, X + 2, X - 2) and IsInRange(CurPosY, Y + 2, Y - 2) then
- begin
- FShowMultiSelecting := False;
- //connect the begining and end
- SetLength(FSelectionRec, Length(FSelectionRec) + 1);
- FSelectionRec[high(FSelectionRec)] := point(X, Y);
- if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
- FSelectedObjects.Clear;
- for J := 0 to viewer.Height - 1 do
- for I := 0 to viewer.Width - 1 do
- begin
- if IsPointInPolygon(FSelectionRec, point(I, J)) then
- begin
- if not IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
- begin
- SetLength(line, Length(line) + 1);
- line[high(line)] := point(I, J);
- end;
- end
- else
- if IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
- begin
- SetLength(line, Length(line) + 1);
- line[high(line)] := point(I, J);
- end;
- end;
- for I := 0 to High(line) do
- if (I mod 2 = 0) then
- begin
- pick := InternalGetPickedObjects(line[I].X - 1, line[I].Y - 1, line[I + 1].X + 1, line[I + 1].Y + 1, 8);
- SelectAssignMode(pick);
- pick.Free;
- end;
- if Assigned(onSelect) then
- onSelect(self, FSelectedObjects);
- //nulling of array
- SetLength(line, 0);
- SetLength(FSelectionRec, 0);
- end;
- if (fSelectionRegion = gsrLasso) then
- begin
- FShowMultiSelecting := False;
- SetLength(FSelectionRec, Length(FSelectionRec) + 1);
- FSelectionRec[high(FSelectionRec)] := FSelectionRec[Low(FSelectionRec)];
- if not FCanRemoveObjFromSelectionList and not FCanAddObjtoSelectionList then
- FSelectedObjects.Clear;
- for J := 0 to viewer.Height - 1 do
- for I := 0 to viewer.Width - 1 do
- begin
- if IsPointInPolygon(FSelectionRec, point(I, J)) then
- begin
- if not IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
- begin
- SetLength(line, Length(line) + 1);
- line[high(line)] := point(I, J);
- end;
- end
- else
- if IsPointInPolygon(FSelectionRec, point(I + 1, J)) then
- begin
- SetLength(line, Length(line) + 1);
- line[high(line)] := point(I, J);
- end;
- end;
- for I := 0 to High(line) do
- if (I mod 2 = 0) then
- begin
- pick := InternalGetPickedObjects(line[I].X - 1, line[I].Y - 1, line[I + 1].X + 1, line[I + 1].Y + 1, 8);
- SelectAssignMode(pick);
- pick.Free;
- end;
- SetLength(line, 0);
- SetLength(FSelectionRec, 0);
- if Assigned(onSelect) then
- onSelect(self, FSelectedObjects);
- end;
- end;
- procedure TGLGizmoEx.SetVisibleInfoLabelsColor(const AValue: TGLColor);
- begin
- if AValue <> FSelectedColor then
- begin
- FVisibleInfoLabelsColor.Color := AValue.Color;
- FUIVisibleInfoLabels.ModulateColor.Color := AValue.Color;
- FVisibleInfoLabelsColorChanged := True;
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.SetSelectionRegionColor(const AValue: TGLColor);
- begin
- if AValue <> FSelectionRegionColor then
- begin
- FSelectionRegionColor.Color := AValue.Color;
- end;
- end;
- procedure TGLGizmoEx.SeTGLGizmoExVisibleInfoLabels(const AValue: TGLGizmoExVisibleInfoLabels);
- begin
- if AValue <> FVisibleVisibleInfoLabels then
- begin
- FVisibleVisibleInfoLabels := AValue;
- if not (csDesigning in ComponentState) then
- UpdateGizmo;
- end;
- end;
- procedure TGLGizmoEx.UndoAdd(const AObject: TObject);
- begin
- if AObject <> nil then
- FHistory.AddObject(AObject);
- end;
- procedure TGLGizmoEx.RemoveSelectedObjects;
- begin
- if not Assigned(FHistory.FGizmoTmpRoot) then
- Exit;
- FHistory.RemoveObjects(SelectedObjects);
- FHistory.AddObjects(SelectedObjects);
- UpdateGizmo();
- end;
- procedure TGLGizmoEx.SetRootGizmo(const AValue: TGLBaseSceneObject);
- begin
- if FRootGizmo <> AValue then
- begin
- if FRootGizmo <> nil then
- FRootGizmo.RemoveFreeNotification(Self);
- FRootGizmo := AValue;
- if FRootGizmo <> nil then
- FRootGizmo.FreeNotification(Self);
- FUIBaseGizmo.MoveTo(AValue);
- end;
- end;
- procedure TGLGizmoEx.SetGizmoTmpRoot(const AValue: TGLBaseSceneObject);
- begin
- if FGizmoTmpRoot <> AValue then
- begin
- if FGizmoTmpRoot <> nil then
- FGizmoTmpRoot.RemoveFreeNotification(Self);
- FGizmoTmpRoot := AValue;
- FGizmoTmpRoot.Visible := False;
- FHistory.GizmoTmpRoot := FGizmoTmpRoot;
- end;
- end;
- procedure TGLGizmoEx.SetRootObjects(const AValue: TGLBaseSceneObject);
- begin
- if fRootObjects <> AValue then
- begin
- if fRootObjects <> nil then
- fRootObjects.RemoveFreeNotification(Self);
- fRootObjects := AValue;
- end;
- end;
- procedure TGLGizmoEx.SetExcludeObjectsList(const AValue: TStrings);
- begin
- FExcludeObjectsList.Clear;
- FExcludeObjectsList.AddStrings(AValue);
- end;
- procedure TGLGizmoEx.SetExcludeClassNameList(const AValue: TStrings);
- begin
- FExcludeClassNameList.Clear;
- FExcludeClassNameList.AddStrings(AValue);
- end;
- procedure TGLGizmoEx.SetGLGizmoExThickness(const Value: Single);
- begin
- if (FGizmoThickness <> Value) and (Value > 0.2) then
- begin
- FGizmoThickness := Value;
- FUISelectLineX.LineWidth := 1 * Value;
- FUISelectLineY.LineWidth := 1 * Value;
- FUISelectLineZ.LineWidth := 1 * Value;
- FUIMovementLineX.LineWidth := 1 * Value;
- FUIMovementLineY.LineWidth := 1 * Value;
- FUIMovementLineZ.LineWidth := 1 * Value;
- FUIMovementLineXY.LineWidth := 1 * Value;
- FUIMovementLineXZ.LineWidth := 1 * Value;
- FUIMovementLineYZ.LineWidth := 1 * Value;
- FUIRotateLineX.LineWidth := 1 * Value;
- FUIRotateLineY.LineWidth := 1 * Value;
- FUIRotateLineZ.LineWidth := 1 * Value;
- FUIrotateLineXY.LineWidth := 1 * Value;
- FUIRotateLineXZ.LineWidth := 1 * Value;
- FUIRotateLineArrowX.LineWidth := 1 * Value;
- FUIRotateLineArrowY.LineWidth := 1 * Value;
- FUIRotateLineArrowZ.LineWidth := 1 * Value;
- FUIScaleLineX.LineWidth := 1 * Value;
- FUIScaleLineY.LineWidth := 1 * Value;
- FUIScaleLineZ.LineWidth := 1 * Value;
- FUIScaleLineXY.LineWidth := 1 * Value;
- FUIScaleLineXZ.LineWidth := 1 * Value;
- FUIScaleLineYZ.LineWidth := 1 * Value;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TGLGizmoEx.SetLabelFont(const Value: TGLCustomBitmapFont);
- begin
- if FLabelFont <> Value then
- begin
- if FLabelFont <> nil then
- FLabelFont.RemoveFreeNotification(Self);
- FLabelFont := Value;
- if FLabelFont <> nil then
- FLabelFont.FreeNotification(Self);
- FUIAxisLabelX.BitmapFont := Value;
- FUIAxisLabelY.BitmapFont := Value;
- FUIAxisLabelZ.BitmapFont := Value;
- FUIRotateAxisLabelX.BitmapFont := Value;
- FUIRotateAxisLabelY.BitmapFont := Value;
- FUIRotateAxisLabelZ.BitmapFont := Value;
- FUIVisibleInfoLabels.BitmapFont := Value;
- end;
- end;
- function TGLGizmoEx.InternalGetPickedObjects(const x1, y1, x2, y2: Integer; const guessCount: Integer): TGLPickList;
- procedure AddObjectToPicklList(const root: TGLBaseSceneObject; PickList: TGLPickList; X, Y: Integer);
- var
- t: Integer;
- dist: Single;
- rayStart, rayVector, iPoint, iNormal: TGLVector;
- begin
- SetVector(rayStart, Viewer.Camera.AbsolutePosition);
- SetVector(rayVector, Viewer.Buffer.ScreenToVector(AffineVectorMake(X, Viewer.Height - Y, 0)));
- NormalizeVector(rayVector);
- for t := 0 to root.Count - 1 do
- if root[t].Visible then
- begin
- if (root[t].RayCastIntersect(rayStart, rayVector, @iPoint, @iNormal)) and
- (VectorDotProduct(rayVector, iNormal) < 0) then
- if PickList.FindObject(root[t]) = -1 then
- begin
- dist := VectorLength(VectorSubtract(iPoint, rayStart));
- PickList.AddHit(root[t], nil, dist, 0);
- end;
- AddObjectToPicklList(root[t], PickList, X, Y);
- end;
- end;
- var
- I, J: Integer;
- minx, miny, maxx, maxy: Integer;
- begin
- case FPickMode of
- pmGetPickedObjects:
- begin
- Result := Viewer.Buffer.GetPickedObjects(rect(x1, y1, x2, y2), guessCount);
- end;
- pmRayCast:
- begin
- Result := TGLPickList.Create(psMinDepth);
- maxX := MaxInteger(x1, x2);
- maxY := MaxInteger(Y1, Y2);
- minX := MinInteger(x1, x2);
- minY := MinInteger(Y1, Y2);
- for J := minY to maxY do
- for I := minX to maxX do
- //uploading to exclude hanging of application :)
- if (I mod 4 = 0) or (J mod 4 = 0) then
- AddObjectToPicklList(RootObjects, Result, I, J);
- AddObjectToPicklList(RootGizmo, Result, round((x1 + x2) * 0.5), round((y1 + y2) * 0.5));
- end;
- else
- begin
- Result := nil;
- Assert(False, strUnknownType);
- end;
- end;
- end;
- procedure TGLGizmoEx.Loaded;
- begin
- inherited;
- SeTGLGizmoExThickness(GizmoThickness);
- end;
- //------------------------------------------------------------------------------
- procedure TGLGizmoEx.UpdateVisibleInfoLabels;
- var
- T: string;
- X, Y, Z: Single;
- obj: TGLBaseSceneObject;
- begin
- t := '';
- X := 0;
- Y := 0;
- Z := 0;
- if FSelectedObjects.Count - 1 < 0 then
- Exit;
- if (FSelectedObjects.Count - 1 = 0) and (vliName in FVisibleVisibleInfoLabels) then
- t := TGLBaseSceneObject(FSelectedObjects[0]).Name;
- if vliOperation in FVisibleVisibleInfoLabels then
- begin
- begin
- if Length(t) > 0 then
- T := T + ' - ';
- case Operation of
- gopNone: T := T + 'Selected';
- gopMove: T := T + 'Move';
- gopRotate: T := T + 'Rotate';
- gopScale: T := T + 'Scale';
- end;
- end;
- end;
- if vliCoords in FVisibleVisibleInfoLabels then
- begin
- if (Operation <> gopNone) then
- begin
- if Length(t) > 0 then
- T := T + ' - ';
- if FinfoLabelCoordType = ilcChanging then
- begin
- obj := TGLBaseSceneObject(FSelectedObjects[0]);
- case Operation of
- gopMove:
- begin
- X := obj.Position.X;
- Y := obj.Position.Y;
- Z := obj.Position.Z;
- end;
- gopRotate:
- begin
- X := obj.Rotation.X;
- Y := obj.Rotation.Y;
- Z := obj.Rotation.Z;
- end;
- gopScale:
- begin
- X := obj.Scale.X;
- Y := obj.Scale.Y;
- Z := obj.Scale.Z;
- end;
- end;
- T := T + '[' + Format('%2.2f', [X]);
- T := T + ' ' + Format('%2.2f', [Y]);
- T := T + ' ' + Format('%2.2f', [Z]) + ']';
- end
- else
- begin
- T := T + '[' + Format('%2.2f', [FChangeRate.X]);
- T := T + ' ' + Format('%2.2f', [FChangeRate.Y]);
- T := T + ' ' + Format('%2.2f', [FChangeRate.Z]) + ']';
- end;
- end;
- end;
- FUIVisibleInfoLabels.Text := T;
- FUIVisibleInfoLabels.StructureChanged;
- end;
- //------------------------------------------------------------------------------
- function TGLGizmoEx.CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- if FExcludeObjects then
- begin
- for I := 0 to FExcludeObjectsList.Count - 1 do
- begin
- if UpperCase(obj.Name) = UpperCase(FExcludeObjectsList[I]) then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- function TGLGizmoEx.CheckClassNameInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- if FExcludeClassName then
- begin
- for I := 0 to FExcludeClassNameList.Count - 1 do
- begin
- if UpperCase(obj.ClassName) = UpperCase(FExcludeClassNameList[I]) then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- function TGLGizmoEx.MouseWorldPos(const X, Y: Integer): TGLVector;
- var
- v: TGLVector;
- InvertedY: Integer;
- begin
- InvertedY := Viewer.Height - Y;
- SetVector(v, X, InvertedY, 0);
- case selAxis of
- gaX: Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
- gaY: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
- gaZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
- gaXY: Viewer.Buffer.ScreenVectorIntersectWithPlaneXY(v, FUIRootHelpers.AbsolutePosition.Z, Result);
- gaYZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(v, FUIRootHelpers.AbsolutePosition.X, Result);
- gaXZ: Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
- gaXYZ:
- begin
- Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FUIRootHelpers.AbsolutePosition.Y, Result);
- MakeVector(Result, InvertedY / 25, InvertedY / 25, InvertedY / 25);
- end;
- end;
- end;
- procedure TGLGizmoEx.ActivatingElements(PickList: TGLPickList);
- procedure ActlightRotateLine(const line: TGLLines; const dark: TGLVector);
- var
- v: TVector4f;
- I: Integer;
- begin
- line.options := [loUseNodeColorForLines];
- for I := 0 to line.Nodes.Count - 1 do
- begin
- v := FUIRotateLineXY.AbsoluteToLocal((line.LocalToAbsolute(line.Nodes[I].AsVector)));
- if v.Z >= 0 then
- begin
- TGLLinesNode(line.Nodes[I]).Color.Color := FSelectedColor.Color;
- TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
- end
- else
- begin
- TGLLinesNode(line.Nodes[I]).Color.Color := dark;
- TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
- end;
- end;
- end;
- procedure DeActlightRotateLine(const line: TGLLines; const dark: TGLVector);
- var
- v: TVector4f;
- I: Integer;
- begin
- line.options := [loUseNodeColorForLines];
- for I := 0 to line.Nodes.Count - 1 do
- begin
- v := FUIRotateLineXY.AbsoluteToLocal((line.LocalToAbsolute(line.Nodes[I].AsVector)));
- if v.Z >= 0 then
- begin
- TGLLinesNode(line.Nodes[I]).Color.Color := dark;
- TGLLinesNode(line.Nodes[I]).Color.Alpha := 1;
- end
- else
- begin
- TGLLinesNode(line.Nodes[I]).Color.Color := dark;
- TGLLinesNode(line.Nodes[I]).Color.Alpha := 0;
- end;
- end;
- end;
- procedure ActlightLine(const line: TGLLines);
- begin
- line.LineColor.color := FSelectedColor.Color;
- line.Options := [];
- end;
- procedure DeActlightLine(const line: TGLLines; const dark: TGLVector; alterStyle: Boolean = False);
- begin
- with line.LineColor do
- if (AsWinColor = FSelectedColor.AsWinColor) then
- begin
- color := dark;
- line.Options := [];
- if alterStyle then
- line.options := [loUseNodeColorForLines];
- end;
- end;
- procedure ActlightRotateArrowLine(const line: TGLLines; Color: TGLVector);
- begin
- line.LineColor.color := Color;
- line.Options := [];
- end;
- procedure DeActlightRotateArrowLine(const line: TGLLines; const dark: TGLVector);
- begin
- if not VectorEquals(line.LineColor.Color, dark) then
- begin
- line.LineColor.Color := dark;
- line.Options := [];
- end;
- end;
- procedure Actlightobject(const aObject: TGLCustomSceneObject);
- begin
- aObject.Material.FrontProperties.Diffuse.Alpha := 0.4;
- aObject.Visible := True;
- end;
- procedure DeActlightObject(const aObject: TGLCustomSceneObject);
- begin
- aObject.Visible := False;
- end;
- procedure ActlightText(const FlatText: TGLFlatText);
- begin
- FlatText.ModulateColor.Color := FSelectedColor.Color;
- end;
- procedure DeActlightText(const FlatText: TGLFlatText; const dark: TGLVector);
- begin
- with FlatText.ModulateColor do
- if AsWinColor = FSelectedColor.AsWinColor then
- Color := dark;
- end;
- procedure ActlightTextRotate(const FlatText: TGLFlatText; Color: TGLVector);
- begin
- FlatText.ModulateColor.Color := Color;
- end;
- procedure DeActlightTextRotate(const FlatText: TGLFlatText; const dark: TGLVector);
- begin
- with FlatText.ModulateColor do
- if not VectorEquals(Color, dark) then
- Color := dark;
- end;
- procedure AssingOpertion(const aOperation: TGLGizmoExOperation; const axis: TGLGizmoExAxis);
- begin
- if Operation <> aOperation then
- Operation := aOperation;
- if SelAxis <> axis then
- SelAxis := axis;
- end;
- var
- I: Integer;
- begin
- AssingOpertion(gopNone, gaNone);
- if FUIRootMovement.Visible then
- begin
- DeActlightObject(FUIMovementPlaneXY);
- DeActlightObject(FUIMovementPlaneXZ);
- DeActlightObject(FUIMovementPlaneYZ);
- DeActlightLine(FUIMovementLineX, clrRed);
- DeActlightLine(FUIMovementLineY, clrLime);
- DeActlightLine(FUIMovementLineZ, clrBlue);
- DeActlightLine(FUIMovementLineXY, clrWhite, True);
- DeActlightLine(FUIMovementLineXZ, clrWhite, True);
- DeActlightLine(FUIMovementLineYZ, clrWhite, True);
- end;
- if FUIRootRotate.Visible then
- begin
- DeActlightObject(FUIRotateDiskXY);
- DeActlightLine(FUIRotateLineXZ, clrgray70);
- DeActlightRotateArrowLine(FUIRotateLineArrowX, clrgray70);
- DeActlightRotateArrowLine(FUIRotateLineArrowY, clrgray70);
- DeActlightRotateArrowLine(FUIRotateLineArrowZ, clrgray70);
- DeActlightRotateLine(FUIRotateLineX, clrRed);
- DeActlightRotateLine(FUIRotateLineY, clrLime);
- DeActlightRotateLine(FUIRotateLineZ, clrBlue);
- DeActlightTextRotate(FUIRotateAxisLabelX, clrgray70);
- DeActlightTextRotate(FUIRotateAxisLabelY, clrgray70);
- DeActlightTextRotate(FUIRotateAxisLabelZ, clrgray70);
- end;
- if FUIRootScale.Visible then
- begin
- DeActlightLine(FUIScaleLineX, clrRed);
- DeActlightLine(FUIScaleLineY, clrLime);
- DeActlightLine(FUIScaleLineZ, clrBlue);
- DeActlightLine(FUIScaleLineXY, clrWhite, True);
- DeActlightLine(FUIScaleLineYZ, clrWhite, True);
- DeActlightLine(FUIScaleLineXZ, clrWhite, True);
- DeActlightObject(FUIScalePlaneXY);
- DeActlightObject(FUIScalePlaneXZ);
- DeActlightObject(FUIScalePlaneYZ);
- DeActlightObject(FUIScalePlaneXYZ);
- end;
- DeActlightText(FUIAxisLabelX, clrRed);
- DeActlightText(FUIAxisLabelY, clrLime);
- DeActlightText(FUIAxisLabelZ, clrBlue);
- for I := 0 to pickList.Count - 1 do
- with pickList do
- begin
- if FUIRootMovement.Visible then
- begin
- if hit[I] = FUIICMovementLineXY then
- begin
- AssingOpertion(gopMove, gaXY);
- ActlightObject(FUIMovementPlaneXY);
- ActlightLine(FUIMovementLineX);
- ActlightLine(FUIMovementLineY);
- ActlightLine(FUIMovementLineXY);
- ActlightText(FUIAxisLabelX);
- ActlightText(FUIAxisLabelY);
- Break;
- end;
- if hit[I] = FUIICMovementLineXZ then
- begin
- AssingOpertion(gopMove, gaXZ);
- Actlightobject(FUIMovementPlaneXZ);
- ActlightLine(FUIMovementLineX);
- ActlightLine(FUIMovementLineZ);
- ActlightLine(FUIMovementLineXZ);
- ActlightText(FUIAxisLabelX);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- if hit[I] = FUIICMovementLineYZ then
- begin
- AssingOpertion(gopMove, gaYZ);
- Actlightobject(FUIMovementPlaneYZ);
- ActlightLine(FUIMovementLineY);
- ActlightLine(FUIMovementLineZ);
- ActlightLine(FUIMovementLineYZ);
- ActlightText(FUIAxisLabelY);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- if hit[I] = FUIICMovementLineX then
- begin
- AssingOpertion(gopMove, gaX);
- ActlightLine(FUIMovementLineX);
- ActlightText(FUIAxisLabelX);
- Break;
- end;
- if hit[I] = FUIICMovementLineY then
- begin
- AssingOpertion(gopMove, gaY);
- ActlightLine(FUIMovementLineY);
- ActlightText(FUIAxisLabelY);
- Break;
- end;
- if hit[I] = FUIICMovementLineZ then
- begin
- AssingOpertion(gopMove, gaZ);
- ActlightLine(FUIMovementLineZ);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- end;
- if FUIRootRotate.Visible then
- begin
- if hit[I] = FUIICRotateTorusX then
- begin
- AssingOpertion(gopRotate, gaX);
- ActlightRotateLine(FUIRotateLineX, clrgray50);
- ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
- DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
- Break;
- end;
- if hit[I] = FUIICRotateTorusY then
- begin
- AssingOpertion(gopRotate, gaY);
- ActlightRotateLine(FUIRotateLineY, clrgray50);
- ActlightRotateArrowLine(FUIRotateLineArrowY, clrLime);
- DeActlightTextRotate(FUIRotateAxisLabelY, clrLime);
- Break;
- end;
- if hit[I] = FUIICRotateTorusZ then
- begin
- AssingOpertion(gopRotate, gaZ);
- ActlightRotateLine(FUIRotateLineZ, clrgray50);
- ActlightRotateArrowLine(FUIRotateLineArrowZ, clrBlue);
- DeActlightTextRotate(FUIRotateAxisLabelZ, clrBlue);
- Break;
- end;
- if hit[I] = FUIICRotateSphereXY then
- begin
- AssingOpertion(gopRotate, gaXY);
- ActlightObject(FUIRotateDiskXY);
- DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
- DeActlightTextRotate(FUIRotateAxisLabelY, clrLime);
- ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
- ActlightRotateArrowLine(FUIRotateLineArrowY, clrLime);
- Break;
- end;
- if hit[I] = FUIICRotateTorusXZ then
- begin
- AssingOpertion(gopRotate, gaXZ);
- ActlightLine(FUIRotateLineXZ);
- DeActlightTextRotate(FUIRotateAxisLabelX, clrRed);
- DeActlightTextRotate(FUIRotateAxisLabelZ, clrBlue);
- ActlightRotateArrowLine(FUIRotateLineArrowX, clrRed);
- ActlightRotateArrowLine(FUIRotateLineArrowZ, clrBlue);
- Break;
- end;
- end;
- if FUIRootScale.Visible then
- begin
- if hit[I] = FUIICScaleLineX then
- begin
- AssingOpertion(gopScale, gaX);
- ActlightLine(FUIScaleLineX);
- ActlightText(FUIAxisLabelX);
- Break;
- end;
- if hit[I] = FUIICScaleLineY then
- begin
- AssingOpertion(gopScale, gaY);
- ActlightLine(FUIScaleLineY);
- ActlightText(FUIAxisLabelY);
- Break;
- end;
- if hit[I] = FUIICScaleLineZ then
- begin
- AssingOpertion(gopScale, gaZ);
- ActlightLine(FUIScaleLineZ);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- if hit[I] = FUIICScaleLineXY then
- begin
- AssingOpertion(gopScale, gaXY);
- Actlightobject(FUIScalePlaneXY);
- ActlightLine(FUIScaleLineXY);
- ActlightText(FUIAxisLabelX);
- ActlightText(FUIAxisLabelY);
- Break;
- end;
- if hit[I] = FUIICScaleLineXZ then
- begin
- AssingOpertion(gopScale, gaXZ);
- Actlightobject(FUIScalePlaneXZ);
- ActlightLine(FUIScaleLineXZ);
- ActlightText(FUIAxisLabelX);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- if hit[I] = FUIICScaleLineYZ then
- begin
- AssingOpertion(gopScale, gaYZ);
- Actlightobject(FUIScalePlaneYZ);
- ActlightLine(FUIScaleLineYZ);
- ActlightText(FUIAxisLabelY);
- ActlightText(FUIAxisLabelZ);
- Break;
- end;
- if hit[I] = FUIICScaleLineXYZ then
- begin
- AssingOpertion(gopScale, gaXYZ);
- Actlightobject(FUIScalePlaneXYZ);
- ActlightText(FUIAxisLabelX);
- ActlightText(FUIAxisLabelY);
- ActlightText(FUIAxisLabelZ);
- Actlightobject(FUIScalePlaneXY);
- ActlightLine(FUIScaleLineXY);
- Actlightobject(FUIScalePlaneYZ);
- ActlightLine(FUIScaleLineYZ);
- Actlightobject(FUIScalePlaneXZ);
- ActlightLine(FUIScaleLineXZ);
- Break;
- end;
- end;
- end;
- end;
- procedure TGLGizmoEx.ViewerMouseMove(const X, Y: Integer);
- var
- pickList: TGLPickList;
- mousePos: TGLVector;
- includeCh: Boolean;
- function FindParent(parent: TGLBaseSceneObject): Boolean;
- begin
- Result := False;
- if assigned(parent) then
- begin
- if parent = rootobjects then
- Exit;
- Result := FSelectedObjects.FindObject(parent) = -1;
- end;
- end;
- procedure OpeMove(mousePos: TGLVector);
- var
- vec1, vec2: TGLVector;
- quantizedMousePos, quantizedMousePos2: TGLVector;
- I: Integer;
- begin
- if VectorNorm(lastMousePos) = 0 then
- Exit;
- for I := 0 to 3 do
- begin
- quantizedMousePos.V[I] := (Round(mousePos.V[I] / MoveCoef)) * MoveCoef;
- quantizedMousePos2.V[I] := (Round(lastMousePos.V[I] / MoveCoef)) * MoveCoef;
- end;
- case SelAxis of
- gaX:
- begin
- MakeVector(vec1, quantizedMousePos.X, 0, 0);
- makeVector(vec2, quantizedMousePos2.X, 0, 0);
- end;
- gaY:
- begin
- MakeVector(vec1, 0, quantizedMousePos.Y, 0);
- makeVector(vec2, 0, quantizedMousePos2.Y, 0);
- end;
- gaZ:
- begin
- MakeVector(vec1, 0, 0, quantizedMousePos.Z);
- makeVector(vec2, 0, 0, quantizedMousePos2.Z);
- end;
- else
- begin
- vec1 := quantizedMousePos;
- vec2 := quantizedMousePos2;
- end;
- end;
- SubtractVector(vec1, vec2);
- //Control of object flying to infinity
- if (VectorLength(Vec1) > 5) then
- Exit;// prevents NAN problems
- case SelAxis of
- gaX: fchangerate.X := fchangerate.X + vec1.X;
- gaY: fchangerate.Y := fchangerate.Y + vec1.Y;
- gaZ: fchangerate.Z := fchangerate.Z + vec1.Z;
- gaXY:
- begin
- fchangerate.X := fchangerate.X + vec1.X;
- fchangerate.Y := fchangerate.Y + vec1.Y;
- end;
- gaYZ:
- begin
- fchangerate.Z := fchangerate.Z + vec1.Z;
- fchangerate.Y := fchangerate.Y + vec1.Y;
- end;
- gaXZ:
- begin
- fchangerate.X := fchangerate.X + vec1.X;
- fchangerate.Z := fchangerate.Z + vec1.Z;
- end;
- end;
- for I := 0 to FSelectedObjects.Count - 1 do
- with TGLBaseSceneObject(FSelectedObjects.Hit[I]) do
- begin
- IncludeCh := True;
- if not CanChangeWithChildren and (parent <> RootObjects) and (FSelectedObjects.Count - 1 > 0) then
- IncludeCh := FindParent(parent);
- if IncludeCh then
- case Ord(ReferenceCoordSystem) of
- 0: AbsolutePosition := VectorAdd(absoluteposition, vec1);
- 1:
- begin
- vec1 := LocalToAbsolute(vec1);
- absoluteposition := VectorAdd(absoluteposition, vec1);
- end;
- end;
- end;
- end;
- procedure OpeRotate(const X, Y: Integer);
- var
- vec1: TGLVector;
- rotV: TAffineVector;
- pmat: TGLMatrix;
- I: Integer;
- IncludeCh: Boolean;
- v: TGLVector;
- begin
- vec1.X := 0;
- vec1.Y := 0;
- if abs(X - mx) >= RotationCoef then
- begin
- if RotationCoef > 1 then
- vec1.X := RotationCoef * (Round((X - mx) / (RotationCoef)))
- else
- vec1.X := RotationCoef * (X - mx);
- mx := X;
- end;
- if abs(Y - my) >= RotationCoef then
- begin
- if RotationCoef > 1 then
- vec1.Y := RotationCoef * (Round((Y - my) / (RotationCoef)))
- else
- vec1.Y := RotationCoef * (Y - my);
- my := Y;
- end;
- vec1.Z := 0;
- vec1.W := 0;
- case SelAxis of
- gaX: fchangerate.Y := fchangerate.Y + vec1.Y;
- gaY: fchangerate.X := fchangerate.X + vec1.X;
- gaZ: fchangerate.Y := fchangerate.Y + vec1.Y;
- end;
- for I := 0 to FSelectedObjects.Count - 1 do
- with FSelectedObjects do
- begin
- case Ord(FReferenceCoordSystem) of
- 0: v := FUIRootHelpers.AbsolutePosition;
- 1: v := TGLBaseSceneObject(Hit[I]).AbsolutePosition;
- end;
- IncludeCh := True;
- if not CanChangeWithChildren
- and (TGLBaseSceneObject(Hit[I]).parent <> RootObjects)
- and (FSelectedObjects.Count - 1 > 0) then
- IncludeCh := FindParent(TGLBaseSceneObject(Hit[I]).parent);
- pmat := TGLBaseSceneObject(Hit[I]).parent.InvAbsoluteMatrix;
- SetVector(pmat.V[3], NullHmgPoint);
- if IncludeCh then
- case SelAxis of
- gaX:
- begin
- rotV := VectorTransform(XVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
- end;
- gaY:
- begin
- rotV := VectorTransform(YVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
- end;
- gaZ:
- begin
- rotV := VectorTransform(ZVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
- end;
- gaXY:
- begin
- rotV := VectorTransform(XVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
- rotV := VectorTransform(YVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
- end;
- gaXZ:
- begin
- rotV := VectorTransform(XVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
- rotV := VectorTransform(ZVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
- end;
- gaYZ:
- begin
- rotV := VectorTransform(YVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.Y);
- rotV := VectorTransform(ZVector, pmat);
- RotateAroundArbitraryAxis(TGLBaseSceneObject(Hit[I]), rotV, AffineVectorMake(v), vec1.X);
- end;
- end;
- end;
- end;
- procedure OpeScale(const mousePos: TGLVector);
- var
- vec1, vec2: TGLVector;
- quantizedMousePos, quantizedMousePos2: TGLVector;
- t: Integer;
- begin
- if VectorNorm(lastMousePos) = 0 then
- Exit;
- for t := 0 to 3 do
- begin
- quantizedMousePos.V[t] := (Round(mousePos.V[t] / ScaleCoef)) * FScaleCoef;
- quantizedMousePos2.V[t] := (Round(lastMousePos.V[t] / FScaleCoef)) * FScaleCoef;
- end;
- case SelAxis of
- gaX:
- begin
- MakeVector(vec1, quantizedMousePos.X, 0, 0);
- makeVector(vec2, quantizedMousePos2.X, 0, 0);
- end;
- gaY:
- begin
- MakeVector(vec1, 0, quantizedMousePos.Y, 0);
- makeVector(vec2, 0, quantizedMousePos2.Y, 0);
- end;
- gaZ:
- begin
- MakeVector(vec1, 0, 0, quantizedMousePos.Z);
- makeVector(vec2, 0, 0, quantizedMousePos2.Z);
- end;
- gaXY:
- begin
- MakeVector(vec1, quantizedMousePos.X, quantizedMousePos.Y, 0);
- makeVector(vec2, quantizedMousePos2.X, quantizedMousePos2.Y, 0);
- end;
- gaXYZ:
- begin
- MakeVector(vec1, quantizedMousePos.X, quantizedMousePos.Y, quantizedMousePos.Z);
- makeVector(vec2, quantizedMousePos2.X, quantizedMousePos2.Y, quantizedMousePos2.Z);
- end
- else
- begin
- vec1 := quantizedMousePos;
- vec2 := quantizedMousePos2;
- end;
- end;
- SubtractVector(vec1, vec2);
- if (VectorLength(Vec1) > 5) then
- Exit;// prevents NAN problems
- case SelAxis of
- gaX: fchangerate.X := fchangerate.X + vec1.X;
- gaY: fchangerate.Y := fchangerate.Y + vec1.Y;
- gaZ: fchangerate.Z := fchangerate.Z + vec1.Z;
- gaXY:
- begin
- fchangerate.X := fchangerate.X + vec1.X;
- fchangerate.Y := fchangerate.Y + vec1.Y;
- end;
- gaYZ:
- begin
- fchangerate.Z := fchangerate.Z + vec1.Z;
- fchangerate.Y := fchangerate.Y + vec1.Y;
- end;
- gaXZ:
- begin
- fchangerate.X := fchangerate.X + vec1.X;
- fchangerate.Z := fchangerate.Z + vec1.Z;
- end;
- gaXYZ:
- fchangerate := VectorAdd(fchangerate, AffineVectorMake(vec1));
- end;
- for t := 0 to FSelectedObjects.Count - 1 do
- with TGLBaseSceneObject(FSelectedObjects.Hit[t]) do
- begin
- IncludeCh := True;
- if not CanChangeWithChildren and (parent <> RootObjects) and (FSelectedObjects.Count - 1 > 0) then
- IncludeCh := FindParent(parent);
- FUIRootScale.Scale.Translate(vec1);
- if IncludeCh then
- begin
- { case ord(ReferenceCoordSystem) of
- 0:begin
- vec1:=LocalToAbsolute(vec1);
- absoluteScale:=VectorAdd(absolutescale,vec1);
- end;
- 1:Scale.Translate(vec1);
- end; }
- Scale.Translate(vec1);
- end;
- end;
- end;
- procedure LoopCursorMoving(isvector: Boolean = False);
- {$IFDEF MSWINDOWS}
- var
- R, vR: TRect;
- cp: TPoint;
- {$ENDIF}
- begin
- {$IFDEF MSWINDOWS}
- //Ïðîöåäóðà äëÿ ïåðåâîäà êóðñîðà èç íà÷àëà â êîíåö
- //áåç ïîòåðü îïåðàöèé íàä îáüåêòîì
- GetWindowRect(GetDesktopWindow, R);
- GetWindowRect(viewer.Handle, VR);
- GLGetCursorPos(cp);
- if cp.Y = R.Bottom - 1 then
- begin
- SetCursorPos(cp.X, R.Top + 3);
- if not isvector then
- my := r.Top - vr.Top
- else
- begin
- lastMousePos := MouseWorldPos(X, r.Top + 3 - vr.Top);
- //ââåäåíî ÷òî áû îáüåêò íå äåðãàëñÿ
- mousepos := lastMousePos;
- end;
- end;
- if cp.Y = R.Top then
- begin
- SetCursorPos(cp.X, R.Bottom - 3);
- if not isvector then
- my := R.Bottom - 1 - vr.top
- else
- begin
- lastMousePos := MouseWorldPos(X, R.Bottom - 1 - vr.top);
- mousepos := lastMousePos;
- end;
- end;
- if cp.X = R.Right - 1 then
- begin
- SetCursorPos(r.Left + 3, cp.Y);
- if not isvector then
- mx := r.Left - vr.Left
- else
- begin
- lastMousePos := MouseWorldPos(r.Left - vr.Left, Y);
- mousepos := lastMousePos;
- end;
- end;
- if cp.X = R.Left then
- begin
- SetCursorPos(r.Right - 3, cp.Y);
- if not isvector then
- mx := r.Right - 1 - vr.Left
- else
- begin
- lastMousePos := MouseWorldPos(r.Right - 1 - vr.Left, Y);
- mousepos := lastMousePos;
- end;
- end;
- {$ENDIF}
- end;
- begin
- if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
- Exit;
- if not FShowMultiSelecting then
- begin
- if (FSelectedObjects.Count - 1 >= 0) and (SelAxis <> gaNone) and moving then
- begin
- mousePos := MouseWorldPos(X, Y);
- //moving object...
- if Operation = gopMove then
- begin
- OpeMove(MousePos);
- end
- else if Operation = gopRotate then
- begin
- if EnableLoopCursorMoving then
- LoopCursorMoving;
- OpeRotate(X, Y);
- if (SelAxis = gax) or (SelAxis = gaz) then
- SetAngleDisk(fchangerate.Y)
- else
- if SelAxis = gaY then
- SetAngleDisk(fchangerate.X);
- end
- else if Operation = gopScale then
- begin
- if EnableLoopCursorMoving then
- LoopCursorMoving(True);
- OpeScale(MousePos);
- end;
- UpdateGizmo;
- mx := X;
- my := Y;
- lastMousePos := mousePos;
- Exit;
- end;
- Assert(FViewer <> nil, 'Viewer not Assigned to gizmo');
- picklist := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);//Viewer.buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1), 8);
- ActivatingElements(picklist);
- picklist.Free;
- end;
- if EnableMultiSelection and (Operation = gopNone) and (SelAxis = gaNone) then
- MultiSelMouseMove(X, Y);
- mx := X;
- my := Y;
- end;
- procedure TGLGizmoEx.ViewerMouseDown(const X, Y: Integer);
- function SetInitialDiskPostition(aObject, aObject2: TGLCustomSceneObject): TGLVector;
- var
- rayStart, rayVector, iPoint, iNormal: TGLVector;
- begin
- if (Viewer = nil) then
- Exit;
- if (Viewer.Camera = nil) then
- Exit;
- SetVector(rayStart, Viewer.Camera.AbsolutePosition);
- SetVector(rayVector, Viewer.Buffer.ScreenToVector(AffineVectorMake(X, Viewer.Height - Y, 0)));
- NormalizeVector(rayVector);
- if aObject.RayCastIntersect(rayStart, rayVector, @iPoint, @iNormal) then
- aObject2.Up.Setvector(VectorNormalize(VectorSubtract(iPoint, FUIRootHelpers.Position.AsVector)));
- aObject2.StructureChanged;
- Result := iPoint;
- end;
- var
- pick: TGLPickList;
- I: Integer;
- gotPick: Boolean;
- begin
- if not Enabled or
- not Assigned(RootGizmo) or
- not Assigned(RootObjects) or
- not Assigned(Viewer) then
- Exit;
- mx := X;
- my := Y;
- pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1);
- gotPick := False;
- for I := 0 to pick.Count - 1 do
- if (pick.Hit[I] is TGLGizmoExUIDisk) or
- (pick.Hit[I] is TGLGizmoExUISphere) or
- (pick.Hit[I] is TGLGizmoExUIPolyGon) or
- (pick.Hit[I] is TGLGizmoExuITorus) or
- (pick.Hit[I] is TGLGizmoExUIFrustrum) or
- (pick.Hit[I] is TGLGizmoExUIArrowLine) or
- (pick.Hit[I] is TGLGizmoExUIFlatText) or
- (pick.Hit[I] is TGLGizmoExUILines) then
- begin
- gotPick := True;
- case fOperation of
- gopRotate:
- begin
- if (pick.Hit[I] = FUIICRotateTorusX) then
- begin
- SetInitialDiskPostition(FUIICRotateTorusX, FUIRotateDiskx);
- SetInitialDiskPostition(FUIICRotateTorusX, FUIRotateDiskx2);
- end;
- if (pick.Hit[I] = FUIICRotateTorusY) then
- begin
- SetInitialDiskPostition(FUIICRotateTorusY, FUIRotateDiskY);
- SetInitialDiskPostition(FUIICRotateTorusY, FUIRotateDiskY2);
- end;
- if (pick.Hit[I] = FUIICRotateTorusZ) then
- begin
- SetInitialDiskPostition(FUIICRotateTorusZ, FUIRotateDiskZ);
- SetInitialDiskPostition(FUIICRotateTorusZ, FUIRotateDiskZ2);
- end;
- end;
- end;
- end;
- if not FShowMultiSelecting and not gotPick then
- begin
- for I := 0 to pick.Count - 1 do
- if (pick.Hit[I] <> FInterfaceRender) and
- (pick.Hit[I] <> FInternalRender) and not (pick.Hit[I] is TGLGizmoExUISphere)
- and not (pick.Hit[I] is TGLGizmoExUIPolyGon)
- and not (pick.Hit[I] is TGLGizmoExuITorus)
- and not (pick.Hit[I] is TGLGizmoExUIFrustrum)
- and not (pick.Hit[I] is TGLGizmoExUIArrowLine)
- and not (pick.Hit[I] is TGLGizmoExUILines)
- and not (pick.Hit[I] is TGLGizmoExUIFlatText)
- and not (CheckObjectInExcludeList(TGLBaseSceneObject(pick.hit[I])))
- and not (CheckClassNameInExcludeList(TGLBaseSceneObject(pick.hit[I]))) then
- begin
- //Clear list
- if not EnableMultiSelection then
- ClearSelection
- else
- if (pick.Count - 1 >= 0) and
- (FSelectedObjects.FindObject(pick.Hit[I]) = -1) then
- if not FCanAddObjToSelectionList and not FCanRemoveObjFromSelectionList then
- ClearSelection;
- if not FCanRemoveObjFromSelectionList then
- AddObjToSelectionList(TGLBaseSceneObject(pick.Hit[I]))
- else
- RemoveObjFromSelectionList(TGLBaseSceneObject(pick.Hit[I]));
- if Assigned(onSelect) then
- onSelect(self, FSelectedObjects);
- UpdateGizmo();
- Break;
- end;
- end
- else
- UpdateVisibleInfoLabels();
- pick.Free;
- moving := True;
- lastMousePos := MouseWorldPos(X, Y);
- if EnableMultiSelection then
- MultiSelMouseDown(X, Y);
- end;
- procedure TGLGizmoEx.ViewerMouseUp(const X, Y: Integer);
- var
- pick: TGLPickList;
- begin
- if (not Enabled) or (RootGizmo = nil) or (RootObjects = nil) then
- Exit;
- moving := False;
- case fOperation of
- gopRotate: SetAngleDisk(0);
- end;
- fchangerate := NullVector;
- //MassSelection+\-add mass selected obj
- if operation = gopNone then
- begin
- pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);
- //î÷èñòêà ñïèñêà åñëè êëèêíóëè â ïóñòîòó
- if not FCanAddObjToSelectionList and not FCanRemoveObjFromSelectionList and (pick.Count = 0) then
- ClearSelection;
- pick.Free;
- end;
- if EnableMultiSelection and FShowMultiSelecting then
- MultiSelMouseUp(X, Y);
- if not FShowMultiSelecting and EnableActionHistory then
- FHistory.AddObjects(FSelectedObjects);
- Updategizmo;
- end;
- //------------------------------------------------------------------------------
- procedure TGLGizmoEx.UpdateGizmo;
- var
- d: Single;
- v: TGLVector;
- I: Integer;
- begin
- if not Assigned(RootGizmo) or
- not Assigned(RootObjects) or
- not Assigned(Viewer) then
- Exit;
-
- if FSelectedObjects.Count - 1 < 0 then
- begin
- FUIRootHelpers.Visible := False;
- Exit;
- end
- else
- begin
- FUIRootHelpers.Visible := True;
- if Assigned(onUpdate) then
- OnUpdate(self);
- v := VectorMake(0, 0, 0);
- //óñòàíàâëèâàåì ãèçìî â íóæíóþ ïîçèöèþ!
- for I := 0 to FSelectedObjects.Count - 1 do
- VectorAdd(v, TGLBaseSceneObject(FSelectedObjects.Hit[I]).AbsolutePosition, v);
- if FSelectedObjects.Count = 1 then
- I := 1
- else
- I := FSelectedObjects.Count;
- FUIRootHelpers.Position.AsVector := VectorDivide(v, VectorMake(I, I, I));
- end;
- case Ord(ReferenceCoordSystem) of
- 0:
- begin
- FUIRootHelpers.Direction := FUIBaseGizmo.Direction;
- FUIRootHelpers.Up := FUIBaseGizmo.Up;
- end;
- 1:
- begin
- FUIRootHelpers.AbsoluteDirection := TGLBaseSceneObject(FSelectedObjects.Hit[0]).AbsoluteDirection;
- FUIRootHelpers.AbsoluteUp := TGLBaseSceneObject(FSelectedObjects.Hit[0]).AbsoluteUp;
- end;
- end;
- Assert(Viewer <> nil, 'Viewer not Assigned to gizmo');
- if FAutoZoom then
- d := Viewer.Camera.distanceTo(FUIRootHelpers) / FAutoZoomFactor
- else
- d := FZoomFactor;
- if FUIRootAxisLabel.Visible then
- begin
- FUIAxisLabelX.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIAxisLabelX.StructureChanged;
- FUIAxisLabelY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIAxisLabelY.StructureChanged;
- FUIAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIAxisLabelZ.StructureChanged;
- FUIRootAxisLabel.Scale.AsVector := VectorMake(d, d, d);
- end;
- if FUIRootSelect.Visible then
- FUIRootSelect.Scale.AsVector := VectorMake(d, d, d);
- if FUIRootMovement.Visible then
- FUIRootMovement.Scale.AsVector := VectorMake(d, d, d);
- if FUIRootRotate.Visible then
- begin
- FUIRotateLineXY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIRotateLineXY.StructureChanged;
- FUIRotateLineXZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIRotateLineXZ.StructureChanged;
- FUIRotateAxisLabelX.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIRotateAxisLabelX.StructureChanged;
- FUIRotateAxisLabelY.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIRotateAxisLabelY.StructureChanged;
- FUIRotateAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIRotateAxisLabelZ.StructureChanged;
- FUIRootRotate.Scale.AsVector := VectorMake(d, d, d);
- end;
- if not moving and FUIRootScale.Visible then
- FUIRootScale.Scale.AsVector := VectorMake(d, d, d);
- if FUIRootVisibleInfoLabels.Visible then
- begin
- UpdateVisibleInfoLabels;
- FUIRootVisibleInfoLabels.AbsoluteDirection := FUIBaseGizmo.AbsoluteDirection;
- FUIRootVisibleInfoLabels.AbsoluteUp := FUIBaseGizmo.AbsoluteUp;
- FUIVisibleInfoLabels.ModulateColor.Color := FVisibleInfoLabelsColor.Color;
- FUIVisibleInfoLabels.PointTo(Viewer.Camera.Position.AsVector, Viewer.Camera.Up.AsVector);
- FUIVisibleInfoLabels.StructureChanged;
- FUIRootVisibleInfoLabels.Scale.AsVector := VectorMake(d, d, d);
- end;
- end;
- procedure TGLGizmoEx.LooseSelection;
- begin
- ClearSelection;
- UpdateGizmo;
- if Assigned(onSelectionLost) then
- OnSelectionLost(self);
- end;
- procedure TGLGizmoEx.ClearSelection;
- begin
- FSelectedObj := nil;
- FSelectedObjects.Clear;
- end;
- procedure TGLGizmoEx.LooseCursorSelection;
- begin
- FShowMultiSelecting := False;
- if high(FSelectionRec) > 0 then
- SetLength(FSelectionRec, 0);
- flastcursorPos := Point(0, 0);
- fcursorPos := point(0, 0);
- end;
- procedure TGLGizmoEx.SetViewer(const Value: TGLSceneViewer);
- begin
- if FViewer <> Value then
- begin
- if FViewer <> nil then
- FViewer.RemoveFreeNotification(Self);
- FViewer := Value;
- if FViewer <> nil then
- FViewer.FreeNotification(Self);
- end;
- end;
- procedure TGLGizmoEx.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- begin
- if AComponent = FViewer then
- FViewer := nil;
- if AComponent = FRootGizmo then
- FRootGizmo := nil;
- if AComponent = FRootObjects then
- FRootObjects := nil;
- if AComponent = FGizmoTmpRoot then
- FGizmoTmpRoot := nil;
- end;
- if FHistory <> nil then
- FHistory.Notification(AComponent, Operation);
- end;
- function TGLGizmoEx.Undo: TGLGizmoExActionHistoryItem;
- var
- I: Integer;
- begin
- Result := FHistory.Undo;
- if Result = nil then
- Exit;
- FSelectedObjects.Clear;
- for I := 0 to Result.GizmoObjectCollection.Count - 1 do
- FSelectedObjects.AddHit(Result.GizmoObjectCollection.Items[I].EffectedObject, nil, 0, 0);
- UpdateGizmo;
- end;
- function TGLGizmoEx.Redo: TGLGizmoExActionHistoryItem;
- var
- I: Integer;
- begin
- Result := FHistory.Redo;
- if Result = nil then
- Exit;
- FSelectedObjects.Clear;
- for I := 0 to Result.GizmoObjectCollection.Count - 1 do
- if not Result.GizmoObjectCollection.Items[I].FReturnObject then
- FSelectedObjects.AddHit(Result.GizmoObjectCollection.Items[I].EffectedObject, nil, 0, 0);
- UpdateGizmo;
- end;
- ////////////////////////////////////////////////////////////
- procedure TGLGizmoExObjectItem.AssignFromObject(const AObject: TGLBaseSceneObject; AssignAndRemoveObj: Boolean = False);
- begin
- if not AssignAndRemoveObj then
- begin
- EffectedObject := AObject;
- SetOldMatrix(AObject.Matrix^);
- if AObject is TGLFreeForm then
- FOldAutoScaling := TGLFreeForm(AObject).AutoScaling.AsVector;
- end
- else
- begin
- EffectedObject := AObject;
- FParentOldObject := EffectedObject.Parent;
- FIndexOldObject := EffectedObject.Index;
- FNameOldObject := EffectedObject.Name;
- FEffectedObject.MoveTo(GizmoTmpRoot);
- FReturnObject := True;
- end;
- end;
- constructor TGLGizmoExObjectItem.Create(AOwner: TCollection);
- begin
- FReturnObject := False;
- inherited;
- end;
- destructor TGLGizmoExObjectItem.Destroy;
- begin
- if FReturnObject then
- if assigned(fEffectedObject) then
- FreeAndNil(fEffectedObject);
- inherited;
- end;
- function TGLGizmoExObjectItem.GetGizmo: TGLGizmoEx;
- begin
- if GetParent <> nil then
- Result := GetPArent.GetParent
- else
- Result := nil;
- end;
- function TGLGizmoExObjectItem.GetParent: TGLGizmoExObjectCollection;
- begin
- Result := TGLGizmoExObjectCollection(GetOwner);
- end;
- procedure TGLGizmoExObjectItem.DoUndo;
- begin
- if FEffectedObject = nil then
- Exit;
- if not FReturnObject then
- begin
- FEffectedObject.SetMatrix(FOldMatrix);
- if FEffectedObject is TGLFreeForm then
- TGLFreeForm(FEffectedObject).AutoScaling.AsVector := FOldAutoScaling;
- end
- else
- begin
- if fEffectedObject.Parent <> GizmoTmpRoot then
- begin
- fEffectedObject.MoveTo(FGizmoTmpRoot);
- Exit;
- end;
- FParentOldObject.Insert(FIndexOldObject, fEffectedObject);
- end;
- end;
- procedure TGLGizmoExObjectItem.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- begin
- if AComponent = FEffectedObject then
- if FReturnObject then
- FreeAndNil(FEffectedObject)
- else
- FEffectedObject := nil;
- GizmoTmpRoot := nil;
- end;
- end;
- procedure TGLGizmoExObjectItem.SetEffectedObject(const Value: TGLBaseSceneObject);
- begin
- FEffectedObject := Value;
- end;
- procedure TGLGizmoExObjectItem.SetOldMatrix(const Value: TGLMatrix);
- begin
- FOldMatrix := Value;
- end;
- { TGLGizmoExUndoCollection }
- function TGLGizmoExObjectCollection.Add: TGLGizmoExObjectItem;
- begin
- Result := TGLGizmoExObjectItem(inherited Add);
- end;
- function TGLGizmoExObjectCollection.GetItems(const Index: Integer): TGLGizmoExObjectItem;
- begin
- Result := TGLGizmoExObjectItem(inherited GetItem(Index));
- end;
- function TGLGizmoExObjectCollection.GetParent: TGLGizmoEx;
- begin
- Result := TGLGizmoEx(GetOwner);
- end;
- procedure TGLGizmoExObjectCollection.Notification(AComponent: TComponent; Operation: TOperation);
- var
- I: Integer;
- begin
- if Count <> 0 then
- for I := 0 to Count - 1 do
- GetItems(I).Notification(AComponent, Operation);
- end;
- procedure TGLGizmoExObjectCollection.RemoveByObject(const AObject: TGLCustomSceneObject);
- var
- I: Integer;
- begin
- for I := Count - 1 downto 0 do
- if GetItems(I).FEffectedObject = AObject then
- GetItems(I).Free;
- end;
- procedure TGLGizmoExObjectCollection.SetItems(const Index: Integer; const Value: TGLGizmoExObjectItem);
- begin
- GetItems(Index).Assign(Value);
- end;
- procedure TGLGizmoExObjectCollection.DoUndo;
- var
- I: Integer;
- begin
- for I := Count - 1 downto 0 do
- GetItems(I).DoUndo;
- end;
- /////////////////////////////////////////////////////////////
- constructor TGLGizmoExActionHistoryItem.Create(AOwner: TCollection);
- begin
- inherited;
- FGizmoObjectCollection := TGLGizmoExObjectCollection.Create(self, TGLGizmoExObjectItem);
- end;
- destructor TGLGizmoExActionHistoryItem.Destroy;
- begin
- FGizmoObjectCollection.Free;
- inherited;
- end;
- procedure TGLGizmoExActionHistoryItem.SetObject(aValue: TObject);
- begin
- if FObject <> AValue then
- FObject := AValue;
- end;
- procedure TGLGizmoExActionHistoryItem.SetGizmoObjectCollection(aValue: TGLGizmoExObjectCollection);
- begin
- if FGizmoObjectCollection <> aValue then
- FGizmoObjectCollection := aValue;
- end;
- { TGLGizmoExUndoCollection }
- constructor TGLGizmoExActionHistoryCollection.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
- begin
- MaxCount := 30;
- FItemIndex := -1;
- inherited;
- end;
- function TGLGizmoExActionHistoryCollection.Add: TGLGizmoExActionHistoryItem;
- begin
- Result := nil;
- //If used undo then rewrite previous record
- if FItemIndex = Count - 1 then
- begin
- Result := TGLGizmoExActionHistoryItem(inherited Add);
- FItemIndex := FItemIndex + 1;
- ;
- end
- else
- if (FItemIndex >= 0) or (FItemIndex < Count - 1) then
- begin
- Result := Items[FItemIndex];
- FItemIndex := FItemIndex + 1;
- end;
- // if number of record greater then maxcount then delete elements
- if Count - 1 > MaxCount then
- begin
- Delete(0);
- FItemIndex := Count - 1;
- end;
- end;
- function TGLGizmoExActionHistoryCollection.GetItems(const Index: Integer): TGLGizmoExActionHistoryItem;
- begin
- Result := TGLGizmoExActionHistoryItem(inherited GetItem(Index));
- end;
- procedure TGLGizmoExActionHistoryCollection.Notification(AComponent: TComponent; Operation: TOperation);
- var
- I: Integer;
- begin
- if Count <> 0 then
- for I := 0 to Count - 1 do
- GetItems(I).FGizmoObjectCollection.Notification(AComponent, Operation);
- end;
- procedure TGLGizmoExActionHistoryCollection.SetItems(const Index: Integer; const Value: TGLGizmoExActionHistoryItem);
- begin
- GetItems(Index).Assign(Value);
- end;
- function TGLGizmoExActionHistoryCollection.Undo: TGLGizmoExActionHistoryItem;
- begin
- Result := nil;
- if not (FItemIndex > 0) or not (FItemIndex <= Count - 1) then
- Exit;
- if FItemIndex <> 0 then
- FItemIndex := FItemIndex - 1;
- Result := Items[FItemIndex];
- Result.GizmoObjectCollection.DoUndo;
- end;
- function TGLGizmoExActionHistoryCollection.Redo: TGLGizmoExActionHistoryItem;
- begin
- Result := nil;
- if not (FItemIndex >= 0) or not (FItemIndex < Count - 1) then
- Exit;
- if FItemIndex <> Count - 1 then
- FItemIndex := FItemIndex + 1;
- Result := Items[FItemIndex];
- Result.GizmoObjectCollection.DoUndo;
- end;
- procedure TGLGizmoExActionHistoryCollection.AddObjects(objs: TGLPickList);
- var
- I: Integer;
- begin
- with Add do
- begin
- for I := 0 to objs.Count - 1 do
- GizmoObjectCollection.Add.AssignFromObject(TGLBaseSceneObject(objs.Hit[I]));
- end;
- end;
- procedure TGLGizmoExActionHistoryCollection.AddObject(obj: TObject);
- begin
- if obj = nil then
- Exit;
- Add.FObject := obj;
- end;
- procedure TGLGizmoExActionHistoryCollection.RemoveObjects(objs: TGLPickList);
- var
- I: Integer;
- begin
- if not Assigned(self.GizmoTmpRoot) then
- Exit;
- with Add do
- for I := 0 to objs.Count - 1 do
- if objs.Hit[I] <> nil then
- with GizmoObjectCollection.Add do
- begin
- GizmoTmpRoot := self.GizmoTmpRoot;
- AssignFromObject(TGLBaseSceneObject(objs.Hit[I]), True);
- end;
- objs.Clear;
- end;
- end.
|