GLS.ImageUtils.pas 140 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.ImageUtils;
  5. (* Main purpose is as a fallback in cases where there is no other way to process images *)
  6. // TODO: Complite InfToXXX
  7. // TODO: BPTC decompression
  8. // TODO: S3TC compression
  9. // TODO: LATC compression
  10. // TODO: RGTC compression
  11. // TODO: BPTC compression
  12. // TODO: Build3DMipmap
  13. interface
  14. {$I Stage.Defines.inc}
  15. uses
  16. Winapi.Windows,
  17. Winapi.OpenGL,
  18. Winapi.OpenGLext,
  19. System.SysUtils,
  20. System.UITypes,
  21. System.Classes,
  22. System.Math,
  23. Vcl.Forms,
  24. Vcl.Dialogs,
  25. Vcl.ExtDlgs,
  26. Vcl.Graphics,
  27. Stage.OpenGLTokens,
  28. Stage.Strings,
  29. Stage.VectorGeometry,
  30. Stage.Utils,
  31. Stage.TextureFormat;
  32. var
  33. vImageScaleFilterWidth: Integer = 5; // Relative sample radius for filtering
  34. type
  35. TIntermediateFormat = record
  36. R, G, B, A: Single;
  37. end;
  38. TPointerArray = array of Pointer;
  39. PRGBA32F = ^TIntermediateFormat;
  40. TIntermediateFormatArray = array
  41. [0 .. MaxInt div (2 * SizeOf(TIntermediateFormat))] of TIntermediateFormat;
  42. PIntermediateFormatArray = ^TIntermediateFormatArray;
  43. TU48BitBlock = array [0 .. 3, 0 .. 3] of Byte;
  44. T48BitBlock = array [0 .. 3, 0 .. 3] of SmallInt;
  45. EGLImageUtils = class(Exception);
  46. TImageFilterFunction = function(Value: Single): Single;
  47. TImageAlphaProc = procedure(var AColor: TIntermediateFormat);
  48. function ImageBoxFilter(Value: Single): Single;
  49. function ImageTriangleFilter(Value: Single): Single;
  50. function ImageHermiteFilter(Value: Single): Single;
  51. function ImageBellFilter(Value: Single): Single;
  52. function ImageSplineFilter(Value: Single): Single;
  53. function ImageLanczos3Filter(Value: Single): Single;
  54. function ImageMitchellFilter(Value: Single): Single;
  55. procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
  56. procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
  57. procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
  58. procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
  59. procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
  60. procedure ImageAlphaTopLeftPointColorTransparent
  61. (var AColor: TIntermediateFormat);
  62. procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
  63. procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
  64. procedure ImageAlphaBottomRightPointColorTransparent
  65. (var AColor: TIntermediateFormat);
  66. procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer;
  67. ASrcColorFormat, ADstColorFormat: Cardinal;
  68. ASrcDataType, ADstDataType: Cardinal; AWidth, AHeight: Integer);
  69. procedure RescaleImage(const ASrc: Pointer; const ADst: Pointer;
  70. AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
  71. ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
  72. procedure Build2DMipmap(const ASrc: Pointer; const ADst: TPointerArray;
  73. AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
  74. ASrcWidth, ASrcHeight: Integer);
  75. procedure AlphaGammaBrightCorrection(const ASrc: Pointer;
  76. AColorFormat: Cardinal; ADataType: Cardinal; ASrcWidth, ASrcHeight: Integer;
  77. anAlphaProc: TImageAlphaProc; ABrightness: Single; AGamma: Single);
  78. // Converts a string into color
  79. function StringToColorAdvancedSafe(const Str: string;
  80. const Default: TColor): TColor;
  81. // Converts a string into color
  82. function TryStringToColorAdvanced(const Str: string;
  83. var OutColor: TColor): Boolean;
  84. // Converts a string into color
  85. function StringToColorAdvanced(const Str: string): TColor;
  86. (* Number of pixels per logical inch along the screen width for the device.
  87. Under Win32 awaits a HDC and returns its LOGPIXELSX. *)
  88. function GetDeviceLogicalPixelsX(device: HDC): Integer;
  89. // Number of bits per pixel for the current desktop resolution.
  90. function GetCurrentColorDepth: Integer;
  91. // Returns the number of color bits associated to the given pixel format.
  92. function PixelFormatToColorBits(aPixelFormat: TPixelFormat): Integer;
  93. // Returns the number of CPU cycles since startup. Use the similarly named CPU instruction.
  94. function GLOKMessageBox(const Text, Caption: string): Integer;
  95. procedure GLLoadBitmapFromInstance(Instance: LongInt; ABitmap: TBitmap;
  96. const AName: string);
  97. // Pops up a simple dialog with msg and an Ok button.
  98. procedure InformationDlg(const msg: string);
  99. (* Pops up a simple question dialog with msg and yes/no buttons.
  100. Returns True if answer was "yes". *)
  101. function QuestionDlg(const msg: string): Boolean;
  102. // Posp a simple dialog with a string input.
  103. function InputDlg(const aCaption, aPrompt, aDefault: string): string;
  104. // Pops up a simple save picture dialog.
  105. function SavePictureDialog(var aFileName: string;
  106. const aTitle: string = ''): Boolean;
  107. // Pops up a simple open picture dialog.
  108. function OpenPictureDialog(var aFileName: string;
  109. const aTitle: string = ''): Boolean;
  110. implementation // -------------------------------------------------------------
  111. const
  112. cSuperBlack: TIntermediateFormat = (R: 0.0; G: 0.0; B: 0.0; A: 0.0);
  113. type
  114. TConvertToImfProc = procedure(ASource: Pointer;
  115. ADest: PIntermediateFormatArray; AColorFormat: Cardinal;
  116. AWidth, AHeight: Integer);
  117. TConvertFromInfProc = procedure(ASource: PIntermediateFormatArray;
  118. ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
  119. TDeviceCapabilities = record
  120. Xdpi, Ydpi: Integer; // Number of pixels per logical inch.
  121. Depth: Integer; // The bit depth.
  122. NumColors: Integer; // Number of entries in the device's color table.
  123. end;
  124. //----------------------------------------------------------------------------
  125. function GLOKMessageBox(const Text, Caption: string): Integer;
  126. begin
  127. Result := Application.MessageBox(PChar(Text), PChar(Caption), MB_OK);
  128. end;
  129. procedure GLLoadBitmapFromInstance(Instance: LongInt; ABitmap: TBitmap;
  130. const AName: string);
  131. begin
  132. ABitmap.Handle := LoadBitmap(Instance, PChar(AName));
  133. end;
  134. procedure Swap(var A, B: Integer); inline;
  135. var
  136. C: Integer;
  137. begin
  138. C := A;
  139. A := B;
  140. B := C;
  141. end;
  142. // ------------------------------ OpenGL format image to RGBA Float
  143. procedure UnsupportedToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  144. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  145. begin
  146. raise EGLImageUtils.Create('Unimplemented type of conversion');
  147. end;
  148. procedure UbyteToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  149. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  150. var
  151. pSource: PByte;
  152. n: Integer;
  153. c0: Single;
  154. function GetChannel: Single;
  155. begin
  156. Result := pSource^;
  157. Inc(pSource);
  158. end;
  159. begin
  160. pSource := PByte(ASource);
  161. case AColorFormat of
  162. // {$I ImgUtilCaseGL2Imf.inc}
  163. GL_RGB, GL_RGB_INTEGER:
  164. for n := 0 to AWidth * AHeight - 1 do
  165. begin
  166. ADest[n].R := GetChannel;
  167. ADest[n].G := GetChannel;
  168. ADest[n].B := GetChannel;
  169. ADest[n].A := 255.0;
  170. end;
  171. GL_BGR, GL_BGR_INTEGER:
  172. for n := 0 to AWidth * AHeight - 1 do
  173. begin
  174. ADest[n].B := GetChannel;
  175. ADest[n].G := GetChannel;
  176. ADest[n].R := GetChannel;
  177. ADest[n].A := 255.0;
  178. end;
  179. GL_RGBA, GL_RGBA_INTEGER:
  180. for n := 0 to AWidth * AHeight - 1 do
  181. begin
  182. ADest[n].R := GetChannel;
  183. ADest[n].G := GetChannel;
  184. ADest[n].B := GetChannel;
  185. ADest[n].A := GetChannel;
  186. end;
  187. GL_BGRA, GL_BGRA_INTEGER:
  188. for n := 0 to AWidth * AHeight - 1 do
  189. begin
  190. ADest[n].B := GetChannel;
  191. ADest[n].G := GetChannel;
  192. ADest[n].R := GetChannel;
  193. ADest[n].A := GetChannel;
  194. end;
  195. GL_ALPHA, GL_ALPHA_INTEGER:
  196. for n := 0 to AWidth * AHeight - 1 do
  197. begin
  198. ADest[n].R := 0;
  199. ADest[n].G := 0;
  200. ADest[n].B := 0;
  201. ADest[n].A := GetChannel;
  202. end;
  203. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  204. for n := 0 to AWidth * AHeight - 1 do
  205. begin
  206. c0 := GetChannel;
  207. ADest[n].R := c0;
  208. ADest[n].G := c0;
  209. ADest[n].B := c0;
  210. ADest[n].A := 255.0;
  211. end;
  212. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  213. for n := 0 to AWidth * AHeight - 1 do
  214. begin
  215. c0 := GetChannel;
  216. ADest[n].R := c0;
  217. ADest[n].G := c0;
  218. ADest[n].B := c0;
  219. ADest[n].A := GetChannel;
  220. end;
  221. GL_INTENSITY:
  222. for n := 0 to AWidth * AHeight - 1 do
  223. begin
  224. c0 := GetChannel;
  225. ADest[n].R := c0;
  226. ADest[n].G := c0;
  227. ADest[n].B := c0;
  228. ADest[n].A := c0;
  229. end;
  230. GL_RED, GL_RED_INTEGER:
  231. for n := 0 to AWidth * AHeight - 1 do
  232. begin
  233. ADest[n].R := GetChannel;
  234. ADest[n].G := 0;
  235. ADest[n].B := 0;
  236. ADest[n].A := 255;
  237. end;
  238. GL_GREEN, GL_GREEN_INTEGER:
  239. for n := 0 to AWidth * AHeight - 1 do
  240. begin
  241. ADest[n].R := 0;
  242. ADest[n].G := GetChannel;
  243. ADest[n].B := 0;
  244. ADest[n].A := 255;
  245. end;
  246. GL_BLUE, GL_BLUE_INTEGER:
  247. for n := 0 to AWidth * AHeight - 1 do
  248. begin
  249. ADest[n].R := 0;
  250. ADest[n].G := 0;
  251. ADest[n].B := GetChannel;
  252. ADest[n].A := 255;
  253. end;
  254. GL_RG, GL_RG_INTEGER:
  255. for n := 0 to AWidth * AHeight - 1 do
  256. begin
  257. ADest[n].R := GetChannel;
  258. ADest[n].G := GetChannel;
  259. ADest[n].B := 0;
  260. ADest[n].A := 255;
  261. end;
  262. else
  263. raise EGLImageUtils.Create(strInvalidType);
  264. end;
  265. end;
  266. procedure Ubyte332ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  267. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  268. var
  269. pSource: PByte;
  270. c0, c1, c2, c3: Byte;
  271. n: Integer;
  272. procedure GetChannel;
  273. begin
  274. c0 := pSource^;
  275. c1 := $E0 and c0;
  276. c2 := $E0 and (c0 shl 3);
  277. c3 := $C0 and (c0 shl 6);
  278. Inc(pSource);
  279. end;
  280. begin
  281. pSource := PByte(ASource);
  282. case AColorFormat of
  283. GL_RGB:
  284. for n := 0 to AWidth * AHeight - 1 do
  285. begin
  286. GetChannel;
  287. ADest[n].R := c1;
  288. ADest[n].G := c2;
  289. ADest[n].B := c3;
  290. end;
  291. GL_BGR:
  292. for n := 0 to AWidth * AHeight - 1 do
  293. begin
  294. GetChannel;
  295. ADest[n].B := c1;
  296. ADest[n].G := c2;
  297. ADest[n].R := c3;
  298. end;
  299. else
  300. raise EGLImageUtils.Create(strInvalidType);
  301. end;
  302. end;
  303. procedure Ubyte233RToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  304. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  305. var
  306. pSource: PByte;
  307. c0, c1, c2, c3: Byte;
  308. n: Integer;
  309. procedure GetChannel;
  310. begin
  311. c0 := pSource^;
  312. c3 := $E0 and c0;
  313. c2 := $E0 and (c0 shl 3);
  314. c1 := $C0 and (c0 shl 6);
  315. Inc(pSource);
  316. end;
  317. begin
  318. pSource := PByte(ASource);
  319. case AColorFormat of
  320. GL_RGB:
  321. for n := 0 to AWidth * AHeight - 1 do
  322. begin
  323. GetChannel;
  324. ADest[n].R := c1;
  325. ADest[n].G := c2;
  326. ADest[n].B := c3;
  327. end;
  328. GL_BGR:
  329. for n := 0 to AWidth * AHeight - 1 do
  330. begin
  331. GetChannel;
  332. ADest[n].B := c1;
  333. ADest[n].G := c2;
  334. ADest[n].R := c3;
  335. end;
  336. else
  337. raise EGLImageUtils.Create(strInvalidType);
  338. end;
  339. end;
  340. procedure ByteToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  341. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  342. var
  343. pSource: PShortInt;
  344. n: Integer;
  345. c0: Single;
  346. function GetChannel: Single;
  347. begin
  348. Result := pSource^;
  349. Inc(pSource);
  350. end;
  351. begin
  352. pSource := PShortInt(ASource);
  353. case AColorFormat of
  354. // {$I ImgUtilCaseGL2Imf.inc}
  355. GL_RGB, GL_RGB_INTEGER:
  356. for n := 0 to AWidth * AHeight - 1 do
  357. begin
  358. ADest[n].R := GetChannel;
  359. ADest[n].G := GetChannel;
  360. ADest[n].B := GetChannel;
  361. ADest[n].A := 255.0;
  362. end;
  363. GL_BGR, GL_BGR_INTEGER:
  364. for n := 0 to AWidth * AHeight - 1 do
  365. begin
  366. ADest[n].B := GetChannel;
  367. ADest[n].G := GetChannel;
  368. ADest[n].R := GetChannel;
  369. ADest[n].A := 255.0;
  370. end;
  371. GL_RGBA, GL_RGBA_INTEGER:
  372. for n := 0 to AWidth * AHeight - 1 do
  373. begin
  374. ADest[n].R := GetChannel;
  375. ADest[n].G := GetChannel;
  376. ADest[n].B := GetChannel;
  377. ADest[n].A := GetChannel;
  378. end;
  379. GL_BGRA, GL_BGRA_INTEGER:
  380. for n := 0 to AWidth * AHeight - 1 do
  381. begin
  382. ADest[n].B := GetChannel;
  383. ADest[n].G := GetChannel;
  384. ADest[n].R := GetChannel;
  385. ADest[n].A := GetChannel;
  386. end;
  387. GL_ALPHA, GL_ALPHA_INTEGER:
  388. for n := 0 to AWidth * AHeight - 1 do
  389. begin
  390. ADest[n].R := 0;
  391. ADest[n].G := 0;
  392. ADest[n].B := 0;
  393. ADest[n].A := GetChannel;
  394. end;
  395. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  396. for n := 0 to AWidth * AHeight - 1 do
  397. begin
  398. c0 := GetChannel;
  399. ADest[n].R := c0;
  400. ADest[n].G := c0;
  401. ADest[n].B := c0;
  402. ADest[n].A := 255.0;
  403. end;
  404. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  405. for n := 0 to AWidth * AHeight - 1 do
  406. begin
  407. c0 := GetChannel;
  408. ADest[n].R := c0;
  409. ADest[n].G := c0;
  410. ADest[n].B := c0;
  411. ADest[n].A := GetChannel;
  412. end;
  413. GL_INTENSITY:
  414. for n := 0 to AWidth * AHeight - 1 do
  415. begin
  416. c0 := GetChannel;
  417. ADest[n].R := c0;
  418. ADest[n].G := c0;
  419. ADest[n].B := c0;
  420. ADest[n].A := c0;
  421. end;
  422. GL_RED, GL_RED_INTEGER:
  423. for n := 0 to AWidth * AHeight - 1 do
  424. begin
  425. ADest[n].R := GetChannel;
  426. ADest[n].G := 0;
  427. ADest[n].B := 0;
  428. ADest[n].A := 255;
  429. end;
  430. GL_GREEN, GL_GREEN_INTEGER:
  431. for n := 0 to AWidth * AHeight - 1 do
  432. begin
  433. ADest[n].R := 0;
  434. ADest[n].G := GetChannel;
  435. ADest[n].B := 0;
  436. ADest[n].A := 255;
  437. end;
  438. GL_BLUE, GL_BLUE_INTEGER:
  439. for n := 0 to AWidth * AHeight - 1 do
  440. begin
  441. ADest[n].R := 0;
  442. ADest[n].G := 0;
  443. ADest[n].B := GetChannel;
  444. ADest[n].A := 255;
  445. end;
  446. GL_RG, GL_RG_INTEGER:
  447. for n := 0 to AWidth * AHeight - 1 do
  448. begin
  449. ADest[n].R := GetChannel;
  450. ADest[n].G := GetChannel;
  451. ADest[n].B := 0;
  452. ADest[n].A := 255;
  453. end;
  454. else
  455. raise EGLImageUtils.Create(strInvalidType);
  456. end;
  457. end;
  458. procedure UShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  459. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  460. var
  461. pSource: PWord;
  462. n: Integer;
  463. c0: Single;
  464. function GetChannel: Single;
  465. begin
  466. Result := pSource^ / $100;
  467. Inc(pSource);
  468. end;
  469. begin
  470. pSource := PWord(ASource);
  471. case AColorFormat of
  472. GL_RGB, GL_RGB_INTEGER:
  473. for n := 0 to AWidth * AHeight - 1 do
  474. begin
  475. ADest[n].R := GetChannel;
  476. ADest[n].G := GetChannel;
  477. ADest[n].B := GetChannel;
  478. ADest[n].A := 255.0;
  479. end;
  480. GL_BGR, GL_BGR_INTEGER:
  481. for n := 0 to AWidth * AHeight - 1 do
  482. begin
  483. ADest[n].B := GetChannel;
  484. ADest[n].G := GetChannel;
  485. ADest[n].R := GetChannel;
  486. ADest[n].A := 255.0;
  487. end;
  488. GL_RGBA, GL_RGBA_INTEGER:
  489. for n := 0 to AWidth * AHeight - 1 do
  490. begin
  491. ADest[n].R := GetChannel;
  492. ADest[n].G := GetChannel;
  493. ADest[n].B := GetChannel;
  494. ADest[n].A := GetChannel;
  495. end;
  496. GL_BGRA, GL_BGRA_INTEGER:
  497. for n := 0 to AWidth * AHeight - 1 do
  498. begin
  499. ADest[n].B := GetChannel;
  500. ADest[n].G := GetChannel;
  501. ADest[n].R := GetChannel;
  502. ADest[n].A := GetChannel;
  503. end;
  504. GL_ALPHA, GL_ALPHA_INTEGER:
  505. for n := 0 to AWidth * AHeight - 1 do
  506. begin
  507. ADest[n].R := 0;
  508. ADest[n].G := 0;
  509. ADest[n].B := 0;
  510. ADest[n].A := GetChannel;
  511. end;
  512. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  513. for n := 0 to AWidth * AHeight - 1 do
  514. begin
  515. c0 := GetChannel;
  516. ADest[n].R := c0;
  517. ADest[n].G := c0;
  518. ADest[n].B := c0;
  519. ADest[n].A := 255.0;
  520. end;
  521. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  522. for n := 0 to AWidth * AHeight - 1 do
  523. begin
  524. c0 := GetChannel;
  525. ADest[n].R := c0;
  526. ADest[n].G := c0;
  527. ADest[n].B := c0;
  528. ADest[n].A := GetChannel;
  529. end;
  530. GL_INTENSITY:
  531. for n := 0 to AWidth * AHeight - 1 do
  532. begin
  533. c0 := GetChannel;
  534. ADest[n].R := c0;
  535. ADest[n].G := c0;
  536. ADest[n].B := c0;
  537. ADest[n].A := c0;
  538. end;
  539. GL_RED, GL_RED_INTEGER:
  540. for n := 0 to AWidth * AHeight - 1 do
  541. begin
  542. ADest[n].R := GetChannel;
  543. ADest[n].G := 0;
  544. ADest[n].B := 0;
  545. ADest[n].A := 255;
  546. end;
  547. GL_GREEN, GL_GREEN_INTEGER:
  548. for n := 0 to AWidth * AHeight - 1 do
  549. begin
  550. ADest[n].R := 0;
  551. ADest[n].G := GetChannel;
  552. ADest[n].B := 0;
  553. ADest[n].A := 255;
  554. end;
  555. GL_BLUE, GL_BLUE_INTEGER:
  556. for n := 0 to AWidth * AHeight - 1 do
  557. begin
  558. ADest[n].R := 0;
  559. ADest[n].G := 0;
  560. ADest[n].B := GetChannel;
  561. ADest[n].A := 255;
  562. end;
  563. GL_RG, GL_RG_INTEGER:
  564. for n := 0 to AWidth * AHeight - 1 do
  565. begin
  566. ADest[n].R := GetChannel;
  567. ADest[n].G := GetChannel;
  568. ADest[n].B := 0;
  569. ADest[n].A := 255;
  570. end;
  571. else
  572. raise EGLImageUtils.Create(strInvalidType);
  573. end;
  574. end;
  575. procedure ShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  576. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  577. var
  578. pSource: PSmallInt;
  579. n: Integer;
  580. c0: Single;
  581. function GetChannel: Single;
  582. begin
  583. Result := pSource^ / $100;
  584. Inc(pSource);
  585. end;
  586. begin
  587. pSource := PSmallInt(ASource);
  588. case AColorFormat of
  589. GL_RGB, GL_RGB_INTEGER:
  590. for n := 0 to AWidth * AHeight - 1 do
  591. begin
  592. ADest[n].R := GetChannel;
  593. ADest[n].G := GetChannel;
  594. ADest[n].B := GetChannel;
  595. ADest[n].A := 255.0;
  596. end;
  597. GL_BGR, GL_BGR_INTEGER:
  598. for n := 0 to AWidth * AHeight - 1 do
  599. begin
  600. ADest[n].B := GetChannel;
  601. ADest[n].G := GetChannel;
  602. ADest[n].R := GetChannel;
  603. ADest[n].A := 255.0;
  604. end;
  605. GL_RGBA, GL_RGBA_INTEGER:
  606. for n := 0 to AWidth * AHeight - 1 do
  607. begin
  608. ADest[n].R := GetChannel;
  609. ADest[n].G := GetChannel;
  610. ADest[n].B := GetChannel;
  611. ADest[n].A := GetChannel;
  612. end;
  613. GL_BGRA, GL_BGRA_INTEGER:
  614. for n := 0 to AWidth * AHeight - 1 do
  615. begin
  616. ADest[n].B := GetChannel;
  617. ADest[n].G := GetChannel;
  618. ADest[n].R := GetChannel;
  619. ADest[n].A := GetChannel;
  620. end;
  621. GL_ALPHA, GL_ALPHA_INTEGER:
  622. for n := 0 to AWidth * AHeight - 1 do
  623. begin
  624. ADest[n].R := 0;
  625. ADest[n].G := 0;
  626. ADest[n].B := 0;
  627. ADest[n].A := GetChannel;
  628. end;
  629. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  630. for n := 0 to AWidth * AHeight - 1 do
  631. begin
  632. c0 := GetChannel;
  633. ADest[n].R := c0;
  634. ADest[n].G := c0;
  635. ADest[n].B := c0;
  636. ADest[n].A := 255.0;
  637. end;
  638. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  639. for n := 0 to AWidth * AHeight - 1 do
  640. begin
  641. c0 := GetChannel;
  642. ADest[n].R := c0;
  643. ADest[n].G := c0;
  644. ADest[n].B := c0;
  645. ADest[n].A := GetChannel;
  646. end;
  647. GL_INTENSITY:
  648. for n := 0 to AWidth * AHeight - 1 do
  649. begin
  650. c0 := GetChannel;
  651. ADest[n].R := c0;
  652. ADest[n].G := c0;
  653. ADest[n].B := c0;
  654. ADest[n].A := c0;
  655. end;
  656. GL_RED, GL_RED_INTEGER:
  657. for n := 0 to AWidth * AHeight - 1 do
  658. begin
  659. ADest[n].R := GetChannel;
  660. ADest[n].G := 0;
  661. ADest[n].B := 0;
  662. ADest[n].A := 255;
  663. end;
  664. GL_GREEN, GL_GREEN_INTEGER:
  665. for n := 0 to AWidth * AHeight - 1 do
  666. begin
  667. ADest[n].R := 0;
  668. ADest[n].G := GetChannel;
  669. ADest[n].B := 0;
  670. ADest[n].A := 255;
  671. end;
  672. GL_BLUE, GL_BLUE_INTEGER:
  673. for n := 0 to AWidth * AHeight - 1 do
  674. begin
  675. ADest[n].R := 0;
  676. ADest[n].G := 0;
  677. ADest[n].B := GetChannel;
  678. ADest[n].A := 255;
  679. end;
  680. GL_RG, GL_RG_INTEGER:
  681. for n := 0 to AWidth * AHeight - 1 do
  682. begin
  683. ADest[n].R := GetChannel;
  684. ADest[n].G := GetChannel;
  685. ADest[n].B := 0;
  686. ADest[n].A := 255;
  687. end;
  688. else
  689. raise EGLImageUtils.Create(strInvalidType);
  690. end;
  691. end;
  692. procedure UIntToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  693. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  694. var
  695. pSource: PLongWord;
  696. n: Integer;
  697. c0: Single;
  698. function GetChannel: Single;
  699. begin
  700. Result := pSource^ / $1000000;
  701. Inc(pSource);
  702. end;
  703. begin
  704. pSource := PLongWord(ASource);
  705. case AColorFormat of
  706. GL_RGB, GL_RGB_INTEGER:
  707. for n := 0 to AWidth * AHeight - 1 do
  708. begin
  709. ADest[n].R := GetChannel;
  710. ADest[n].G := GetChannel;
  711. ADest[n].B := GetChannel;
  712. ADest[n].A := 255.0;
  713. end;
  714. GL_BGR, GL_BGR_INTEGER:
  715. for n := 0 to AWidth * AHeight - 1 do
  716. begin
  717. ADest[n].B := GetChannel;
  718. ADest[n].G := GetChannel;
  719. ADest[n].R := GetChannel;
  720. ADest[n].A := 255.0;
  721. end;
  722. GL_RGBA, GL_RGBA_INTEGER:
  723. for n := 0 to AWidth * AHeight - 1 do
  724. begin
  725. ADest[n].R := GetChannel;
  726. ADest[n].G := GetChannel;
  727. ADest[n].B := GetChannel;
  728. ADest[n].A := GetChannel;
  729. end;
  730. GL_BGRA, GL_BGRA_INTEGER:
  731. for n := 0 to AWidth * AHeight - 1 do
  732. begin
  733. ADest[n].B := GetChannel;
  734. ADest[n].G := GetChannel;
  735. ADest[n].R := GetChannel;
  736. ADest[n].A := GetChannel;
  737. end;
  738. GL_ALPHA, GL_ALPHA_INTEGER:
  739. for n := 0 to AWidth * AHeight - 1 do
  740. begin
  741. ADest[n].R := 0;
  742. ADest[n].G := 0;
  743. ADest[n].B := 0;
  744. ADest[n].A := GetChannel;
  745. end;
  746. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  747. for n := 0 to AWidth * AHeight - 1 do
  748. begin
  749. c0 := GetChannel;
  750. ADest[n].R := c0;
  751. ADest[n].G := c0;
  752. ADest[n].B := c0;
  753. ADest[n].A := 255.0;
  754. end;
  755. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  756. for n := 0 to AWidth * AHeight - 1 do
  757. begin
  758. c0 := GetChannel;
  759. ADest[n].R := c0;
  760. ADest[n].G := c0;
  761. ADest[n].B := c0;
  762. ADest[n].A := GetChannel;
  763. end;
  764. GL_INTENSITY:
  765. for n := 0 to AWidth * AHeight - 1 do
  766. begin
  767. c0 := GetChannel;
  768. ADest[n].R := c0;
  769. ADest[n].G := c0;
  770. ADest[n].B := c0;
  771. ADest[n].A := c0;
  772. end;
  773. GL_RED, GL_RED_INTEGER:
  774. for n := 0 to AWidth * AHeight - 1 do
  775. begin
  776. ADest[n].R := GetChannel;
  777. ADest[n].G := 0;
  778. ADest[n].B := 0;
  779. ADest[n].A := 255;
  780. end;
  781. GL_GREEN, GL_GREEN_INTEGER:
  782. for n := 0 to AWidth * AHeight - 1 do
  783. begin
  784. ADest[n].R := 0;
  785. ADest[n].G := GetChannel;
  786. ADest[n].B := 0;
  787. ADest[n].A := 255;
  788. end;
  789. GL_BLUE, GL_BLUE_INTEGER:
  790. for n := 0 to AWidth * AHeight - 1 do
  791. begin
  792. ADest[n].R := 0;
  793. ADest[n].G := 0;
  794. ADest[n].B := GetChannel;
  795. ADest[n].A := 255;
  796. end;
  797. GL_RG, GL_RG_INTEGER:
  798. for n := 0 to AWidth * AHeight - 1 do
  799. begin
  800. ADest[n].R := GetChannel;
  801. ADest[n].G := GetChannel;
  802. ADest[n].B := 0;
  803. ADest[n].A := 255;
  804. end;
  805. else
  806. raise EGLImageUtils.Create(strInvalidType);
  807. end;
  808. end;
  809. procedure IntToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  810. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  811. var
  812. pSource: PLongInt;
  813. n: Integer;
  814. c0: Single;
  815. function GetChannel: Single;
  816. begin
  817. Result := pSource^ / $1000000;
  818. Inc(pSource);
  819. end;
  820. begin
  821. pSource := PLongInt(ASource);
  822. case AColorFormat of
  823. GL_RGB, GL_RGB_INTEGER:
  824. for n := 0 to AWidth * AHeight - 1 do
  825. begin
  826. ADest[n].R := GetChannel;
  827. ADest[n].G := GetChannel;
  828. ADest[n].B := GetChannel;
  829. ADest[n].A := 255.0;
  830. end;
  831. GL_BGR, GL_BGR_INTEGER:
  832. for n := 0 to AWidth * AHeight - 1 do
  833. begin
  834. ADest[n].B := GetChannel;
  835. ADest[n].G := GetChannel;
  836. ADest[n].R := GetChannel;
  837. ADest[n].A := 255.0;
  838. end;
  839. GL_RGBA, GL_RGBA_INTEGER:
  840. for n := 0 to AWidth * AHeight - 1 do
  841. begin
  842. ADest[n].R := GetChannel;
  843. ADest[n].G := GetChannel;
  844. ADest[n].B := GetChannel;
  845. ADest[n].A := GetChannel;
  846. end;
  847. GL_BGRA, GL_BGRA_INTEGER:
  848. for n := 0 to AWidth * AHeight - 1 do
  849. begin
  850. ADest[n].B := GetChannel;
  851. ADest[n].G := GetChannel;
  852. ADest[n].R := GetChannel;
  853. ADest[n].A := GetChannel;
  854. end;
  855. GL_ALPHA, GL_ALPHA_INTEGER:
  856. for n := 0 to AWidth * AHeight - 1 do
  857. begin
  858. ADest[n].R := 0;
  859. ADest[n].G := 0;
  860. ADest[n].B := 0;
  861. ADest[n].A := GetChannel;
  862. end;
  863. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  864. for n := 0 to AWidth * AHeight - 1 do
  865. begin
  866. c0 := GetChannel;
  867. ADest[n].R := c0;
  868. ADest[n].G := c0;
  869. ADest[n].B := c0;
  870. ADest[n].A := 255.0;
  871. end;
  872. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  873. for n := 0 to AWidth * AHeight - 1 do
  874. begin
  875. c0 := GetChannel;
  876. ADest[n].R := c0;
  877. ADest[n].G := c0;
  878. ADest[n].B := c0;
  879. ADest[n].A := GetChannel;
  880. end;
  881. GL_INTENSITY:
  882. for n := 0 to AWidth * AHeight - 1 do
  883. begin
  884. c0 := GetChannel;
  885. ADest[n].R := c0;
  886. ADest[n].G := c0;
  887. ADest[n].B := c0;
  888. ADest[n].A := c0;
  889. end;
  890. GL_RED, GL_RED_INTEGER:
  891. for n := 0 to AWidth * AHeight - 1 do
  892. begin
  893. ADest[n].R := GetChannel;
  894. ADest[n].G := 0;
  895. ADest[n].B := 0;
  896. ADest[n].A := 255;
  897. end;
  898. GL_GREEN, GL_GREEN_INTEGER:
  899. for n := 0 to AWidth * AHeight - 1 do
  900. begin
  901. ADest[n].R := 0;
  902. ADest[n].G := GetChannel;
  903. ADest[n].B := 0;
  904. ADest[n].A := 255;
  905. end;
  906. GL_BLUE, GL_BLUE_INTEGER:
  907. for n := 0 to AWidth * AHeight - 1 do
  908. begin
  909. ADest[n].R := 0;
  910. ADest[n].G := 0;
  911. ADest[n].B := GetChannel;
  912. ADest[n].A := 255;
  913. end;
  914. GL_RG, GL_RG_INTEGER:
  915. for n := 0 to AWidth * AHeight - 1 do
  916. begin
  917. ADest[n].R := GetChannel;
  918. ADest[n].G := GetChannel;
  919. ADest[n].B := 0;
  920. ADest[n].A := 255;
  921. end;
  922. else
  923. raise EGLImageUtils.Create(strInvalidType);
  924. end;
  925. end;
  926. procedure FloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  927. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  928. var
  929. pSource: PSingle;
  930. n: Integer;
  931. c0: Single;
  932. function GetChannel: Single;
  933. begin
  934. Result := pSource^ * 255.0;
  935. Inc(pSource);
  936. end;
  937. begin
  938. pSource := PSingle(ASource);
  939. case AColorFormat of
  940. GL_RGB, GL_RGB_INTEGER:
  941. for n := 0 to AWidth * AHeight - 1 do
  942. begin
  943. ADest[n].R := GetChannel;
  944. ADest[n].G := GetChannel;
  945. ADest[n].B := GetChannel;
  946. ADest[n].A := 255.0;
  947. end;
  948. GL_BGR, GL_BGR_INTEGER:
  949. for n := 0 to AWidth * AHeight - 1 do
  950. begin
  951. ADest[n].B := GetChannel;
  952. ADest[n].G := GetChannel;
  953. ADest[n].R := GetChannel;
  954. ADest[n].A := 255.0;
  955. end;
  956. GL_RGBA, GL_RGBA_INTEGER:
  957. for n := 0 to AWidth * AHeight - 1 do
  958. begin
  959. ADest[n].R := GetChannel;
  960. ADest[n].G := GetChannel;
  961. ADest[n].B := GetChannel;
  962. ADest[n].A := GetChannel;
  963. end;
  964. GL_BGRA, GL_BGRA_INTEGER:
  965. for n := 0 to AWidth * AHeight - 1 do
  966. begin
  967. ADest[n].B := GetChannel;
  968. ADest[n].G := GetChannel;
  969. ADest[n].R := GetChannel;
  970. ADest[n].A := GetChannel;
  971. end;
  972. GL_ALPHA, GL_ALPHA_INTEGER:
  973. for n := 0 to AWidth * AHeight - 1 do
  974. begin
  975. ADest[n].R := 0;
  976. ADest[n].G := 0;
  977. ADest[n].B := 0;
  978. ADest[n].A := GetChannel;
  979. end;
  980. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  981. for n := 0 to AWidth * AHeight - 1 do
  982. begin
  983. c0 := GetChannel;
  984. ADest[n].R := c0;
  985. ADest[n].G := c0;
  986. ADest[n].B := c0;
  987. ADest[n].A := 255.0;
  988. end;
  989. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  990. for n := 0 to AWidth * AHeight - 1 do
  991. begin
  992. c0 := GetChannel;
  993. ADest[n].R := c0;
  994. ADest[n].G := c0;
  995. ADest[n].B := c0;
  996. ADest[n].A := GetChannel;
  997. end;
  998. GL_INTENSITY:
  999. for n := 0 to AWidth * AHeight - 1 do
  1000. begin
  1001. c0 := GetChannel;
  1002. ADest[n].R := c0;
  1003. ADest[n].G := c0;
  1004. ADest[n].B := c0;
  1005. ADest[n].A := c0;
  1006. end;
  1007. GL_RED, GL_RED_INTEGER:
  1008. for n := 0 to AWidth * AHeight - 1 do
  1009. begin
  1010. ADest[n].R := GetChannel;
  1011. ADest[n].G := 0;
  1012. ADest[n].B := 0;
  1013. ADest[n].A := 255;
  1014. end;
  1015. GL_GREEN, GL_GREEN_INTEGER:
  1016. for n := 0 to AWidth * AHeight - 1 do
  1017. begin
  1018. ADest[n].R := 0;
  1019. ADest[n].G := GetChannel;
  1020. ADest[n].B := 0;
  1021. ADest[n].A := 255;
  1022. end;
  1023. GL_BLUE, GL_BLUE_INTEGER:
  1024. for n := 0 to AWidth * AHeight - 1 do
  1025. begin
  1026. ADest[n].R := 0;
  1027. ADest[n].G := 0;
  1028. ADest[n].B := GetChannel;
  1029. ADest[n].A := 255;
  1030. end;
  1031. GL_RG, GL_RG_INTEGER:
  1032. for n := 0 to AWidth * AHeight - 1 do
  1033. begin
  1034. ADest[n].R := GetChannel;
  1035. ADest[n].G := GetChannel;
  1036. ADest[n].B := 0;
  1037. ADest[n].A := 255;
  1038. end;
  1039. else
  1040. raise EGLImageUtils.Create(strInvalidType);
  1041. end;
  1042. end;
  1043. procedure HalfFloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1044. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1045. var
  1046. pSource: PHalfFloat;
  1047. n: Integer;
  1048. c0: Single;
  1049. function GetChannel: Single;
  1050. begin
  1051. Result := HalfToFloat(pSource^) * 255.0;
  1052. Inc(pSource);
  1053. end;
  1054. begin
  1055. pSource := PHalfFloat(ASource);
  1056. case AColorFormat of
  1057. GL_RGB, GL_RGB_INTEGER:
  1058. for n := 0 to AWidth * AHeight - 1 do
  1059. begin
  1060. ADest[n].R := GetChannel;
  1061. ADest[n].G := GetChannel;
  1062. ADest[n].B := GetChannel;
  1063. ADest[n].A := 255.0;
  1064. end;
  1065. GL_BGR, GL_BGR_INTEGER:
  1066. for n := 0 to AWidth * AHeight - 1 do
  1067. begin
  1068. ADest[n].B := GetChannel;
  1069. ADest[n].G := GetChannel;
  1070. ADest[n].R := GetChannel;
  1071. ADest[n].A := 255.0;
  1072. end;
  1073. GL_RGBA, GL_RGBA_INTEGER:
  1074. for n := 0 to AWidth * AHeight - 1 do
  1075. begin
  1076. ADest[n].R := GetChannel;
  1077. ADest[n].G := GetChannel;
  1078. ADest[n].B := GetChannel;
  1079. ADest[n].A := GetChannel;
  1080. end;
  1081. GL_BGRA, GL_BGRA_INTEGER:
  1082. for n := 0 to AWidth * AHeight - 1 do
  1083. begin
  1084. ADest[n].B := GetChannel;
  1085. ADest[n].G := GetChannel;
  1086. ADest[n].R := GetChannel;
  1087. ADest[n].A := GetChannel;
  1088. end;
  1089. GL_ALPHA, GL_ALPHA_INTEGER:
  1090. for n := 0 to AWidth * AHeight - 1 do
  1091. begin
  1092. ADest[n].R := 0;
  1093. ADest[n].G := 0;
  1094. ADest[n].B := 0;
  1095. ADest[n].A := GetChannel;
  1096. end;
  1097. GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
  1098. for n := 0 to AWidth * AHeight - 1 do
  1099. begin
  1100. c0 := GetChannel;
  1101. ADest[n].R := c0;
  1102. ADest[n].G := c0;
  1103. ADest[n].B := c0;
  1104. ADest[n].A := 255.0;
  1105. end;
  1106. GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
  1107. for n := 0 to AWidth * AHeight - 1 do
  1108. begin
  1109. c0 := GetChannel;
  1110. ADest[n].R := c0;
  1111. ADest[n].G := c0;
  1112. ADest[n].B := c0;
  1113. ADest[n].A := GetChannel;
  1114. end;
  1115. GL_INTENSITY:
  1116. for n := 0 to AWidth * AHeight - 1 do
  1117. begin
  1118. c0 := GetChannel;
  1119. ADest[n].R := c0;
  1120. ADest[n].G := c0;
  1121. ADest[n].B := c0;
  1122. ADest[n].A := c0;
  1123. end;
  1124. GL_RED, GL_RED_INTEGER:
  1125. for n := 0 to AWidth * AHeight - 1 do
  1126. begin
  1127. ADest[n].R := GetChannel;
  1128. ADest[n].G := 0;
  1129. ADest[n].B := 0;
  1130. ADest[n].A := 255;
  1131. end;
  1132. GL_GREEN, GL_GREEN_INTEGER:
  1133. for n := 0 to AWidth * AHeight - 1 do
  1134. begin
  1135. ADest[n].R := 0;
  1136. ADest[n].G := GetChannel;
  1137. ADest[n].B := 0;
  1138. ADest[n].A := 255;
  1139. end;
  1140. GL_BLUE, GL_BLUE_INTEGER:
  1141. for n := 0 to AWidth * AHeight - 1 do
  1142. begin
  1143. ADest[n].R := 0;
  1144. ADest[n].G := 0;
  1145. ADest[n].B := GetChannel;
  1146. ADest[n].A := 255;
  1147. end;
  1148. GL_RG, GL_RG_INTEGER:
  1149. for n := 0 to AWidth * AHeight - 1 do
  1150. begin
  1151. ADest[n].R := GetChannel;
  1152. ADest[n].G := GetChannel;
  1153. ADest[n].B := 0;
  1154. ADest[n].A := 255;
  1155. end;
  1156. else
  1157. raise EGLImageUtils.Create(strInvalidType);
  1158. end;
  1159. end;
  1160. procedure UInt8888ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1161. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1162. var
  1163. pSource: PByte;
  1164. n: Integer;
  1165. c0, c1, c2, c3: Byte;
  1166. procedure GetChannel;
  1167. begin
  1168. c0 := pSource^;
  1169. Inc(pSource);
  1170. c1 := pSource^;
  1171. Inc(pSource);
  1172. c2 := pSource^;
  1173. Inc(pSource);
  1174. c3 := pSource^;
  1175. Inc(pSource);
  1176. end;
  1177. begin
  1178. pSource := PByte(ASource);
  1179. case AColorFormat of
  1180. GL_RGBA, GL_RGBA_INTEGER:
  1181. for n := 0 to AWidth * AHeight - 1 do
  1182. begin
  1183. GetChannel;
  1184. ADest[n].R := c0;
  1185. ADest[n].G := c1;
  1186. ADest[n].B := c2;
  1187. ADest[n].A := c3;
  1188. end;
  1189. GL_BGRA, GL_BGRA_INTEGER:
  1190. for n := 0 to AWidth * AHeight - 1 do
  1191. begin
  1192. GetChannel;
  1193. ADest[n].B := c0;
  1194. ADest[n].G := c1;
  1195. ADest[n].R := c2;
  1196. ADest[n].A := c3;
  1197. end;
  1198. else
  1199. raise EGLImageUtils.Create(strInvalidType);
  1200. end;
  1201. end;
  1202. procedure UInt8888RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1203. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1204. var
  1205. pSource: PByte;
  1206. n: Integer;
  1207. c0, c1, c2, c3: Byte;
  1208. procedure GetChannel;
  1209. begin
  1210. c3 := pSource^;
  1211. Inc(pSource);
  1212. c2 := pSource^;
  1213. Inc(pSource);
  1214. c1 := pSource^;
  1215. Inc(pSource);
  1216. c0 := pSource^;
  1217. Inc(pSource);
  1218. end;
  1219. begin
  1220. pSource := PByte(ASource);
  1221. case AColorFormat of
  1222. GL_RGBA, GL_RGBA_INTEGER:
  1223. for n := 0 to AWidth * AHeight - 1 do
  1224. begin
  1225. GetChannel;
  1226. ADest[n].R := c0;
  1227. ADest[n].G := c1;
  1228. ADest[n].B := c2;
  1229. ADest[n].A := c3;
  1230. end;
  1231. GL_BGRA, GL_BGRA_INTEGER:
  1232. for n := 0 to AWidth * AHeight - 1 do
  1233. begin
  1234. GetChannel;
  1235. ADest[n].B := c0;
  1236. ADest[n].G := c1;
  1237. ADest[n].R := c2;
  1238. ADest[n].A := c3;
  1239. end;
  1240. else
  1241. raise EGLImageUtils.Create(strInvalidType);
  1242. end;
  1243. end;
  1244. procedure UShort4444ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1245. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1246. var
  1247. pSource: PByte;
  1248. n: Integer;
  1249. c0, c1, c2, c3, c4: Byte;
  1250. procedure GetChannel;
  1251. begin
  1252. c0 := pSource^;
  1253. c3 := $F0 and (c0 shl 4);
  1254. c4 := $F0 and c0;
  1255. Inc(pSource);
  1256. c0 := pSource^;
  1257. c1 := $F0 and (c0 shl 4);
  1258. c2 := $F0 and c0;
  1259. Inc(pSource);
  1260. end;
  1261. begin
  1262. pSource := PByte(ASource);
  1263. case AColorFormat of
  1264. GL_RGBA, GL_RGBA_INTEGER:
  1265. for n := 0 to AWidth * AHeight - 1 do
  1266. begin
  1267. GetChannel;
  1268. ADest[n].R := c1;
  1269. ADest[n].G := c2;
  1270. ADest[n].B := c3;
  1271. ADest[n].A := c4;
  1272. end;
  1273. GL_BGRA, GL_BGRA_INTEGER:
  1274. for n := 0 to AWidth * AHeight - 1 do
  1275. begin
  1276. GetChannel;
  1277. ADest[n].R := c1;
  1278. ADest[n].G := c2;
  1279. ADest[n].B := c3;
  1280. ADest[n].A := c4;
  1281. end;
  1282. else
  1283. raise EGLImageUtils.Create(strInvalidType);
  1284. end;
  1285. end;
  1286. procedure UShort4444RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1287. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1288. var
  1289. pSource: PByte;
  1290. n: Integer;
  1291. c0, c1, c2, c3, c4: Byte;
  1292. procedure GetChannel;
  1293. begin
  1294. c0 := pSource^;
  1295. c1 := $F0 and (c0 shl 4);
  1296. c2 := $F0 and c0;
  1297. Inc(pSource);
  1298. c0 := pSource^;
  1299. c3 := $F0 and (c0 shl 4);
  1300. c4 := $F0 and c0;
  1301. Inc(pSource);
  1302. end;
  1303. begin
  1304. pSource := PByte(ASource);
  1305. case AColorFormat of
  1306. GL_RGBA, GL_RGBA_INTEGER:
  1307. for n := 0 to AWidth * AHeight - 1 do
  1308. begin
  1309. GetChannel;
  1310. ADest[n].R := c1;
  1311. ADest[n].G := c2;
  1312. ADest[n].B := c3;
  1313. ADest[n].A := c4;
  1314. end;
  1315. GL_BGRA, GL_BGRA_INTEGER:
  1316. for n := 0 to AWidth * AHeight - 1 do
  1317. begin
  1318. GetChannel;
  1319. ADest[n].B := c1;
  1320. ADest[n].G := c2;
  1321. ADest[n].R := c3;
  1322. ADest[n].A := c4;
  1323. end;
  1324. else
  1325. raise EGLImageUtils.Create(strInvalidType);
  1326. end;
  1327. end;
  1328. procedure UShort565ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1329. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1330. var
  1331. pSource: PWord;
  1332. n: Integer;
  1333. c0: Word;
  1334. c1, c2, c3: Byte;
  1335. procedure GetChannel;
  1336. begin
  1337. c0 := pSource^;
  1338. c3 := (c0 and $001F) shl 3;
  1339. c2 := (c0 and $07E0) shr 3;
  1340. c1 := (c0 and $F800) shr 8;
  1341. Inc(pSource);
  1342. end;
  1343. begin
  1344. pSource := PWord(ASource);
  1345. case AColorFormat of
  1346. GL_RGB, GL_RGB_INTEGER:
  1347. for n := 0 to AWidth * AHeight - 1 do
  1348. begin
  1349. GetChannel;
  1350. ADest[n].R := c1;
  1351. ADest[n].G := c2;
  1352. ADest[n].B := c3;
  1353. end;
  1354. GL_BGR, GL_BGR_INTEGER:
  1355. for n := 0 to AWidth * AHeight - 1 do
  1356. begin
  1357. GetChannel;
  1358. ADest[n].B := c1;
  1359. ADest[n].G := c2;
  1360. ADest[n].R := c3;
  1361. end;
  1362. else
  1363. raise EGLImageUtils.Create(strInvalidType);
  1364. end;
  1365. end;
  1366. procedure UShort565RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1367. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1368. var
  1369. pSource: PWord;
  1370. n: Integer;
  1371. c0: Word;
  1372. c1, c2, c3: Byte;
  1373. procedure GetChannel;
  1374. begin
  1375. c0 := pSource^;
  1376. c1 := (c0 and $001F) shl 3;
  1377. c2 := (c0 and $07E0) shr 3;
  1378. c3 := (c0 and $F800) shr 8;
  1379. Inc(pSource);
  1380. end;
  1381. begin
  1382. pSource := PWord(ASource);
  1383. case AColorFormat of
  1384. GL_RGB, GL_RGB_INTEGER:
  1385. for n := 0 to AWidth * AHeight - 1 do
  1386. begin
  1387. GetChannel;
  1388. ADest[n].R := c1;
  1389. ADest[n].G := c2;
  1390. ADest[n].B := c3;
  1391. end;
  1392. GL_BGR, GL_BGR_INTEGER:
  1393. for n := 0 to AWidth * AHeight - 1 do
  1394. begin
  1395. GetChannel;
  1396. ADest[n].B := c1;
  1397. ADest[n].G := c2;
  1398. ADest[n].R := c3;
  1399. end;
  1400. else
  1401. raise EGLImageUtils.Create(strInvalidType);
  1402. end;
  1403. end;
  1404. procedure UShort5551ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1405. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1406. var
  1407. pSource: PWord;
  1408. n: Integer;
  1409. c0: Word;
  1410. c1, c2, c3, c4: Byte;
  1411. procedure GetChannel;
  1412. begin
  1413. c0 := pSource^;
  1414. c4 := (c0 and $001F) shl 3;
  1415. c3 := (c0 and $03E0) shr 2;
  1416. c2 := (c0 and $7C00) shr 7;
  1417. c1 := (c0 and $8000) shr 8;
  1418. Inc(pSource);
  1419. end;
  1420. begin
  1421. pSource := PWord(ASource);
  1422. case AColorFormat of
  1423. GL_RGBA, GL_RGBA_INTEGER:
  1424. for n := 0 to AWidth * AHeight - 1 do
  1425. begin
  1426. GetChannel;
  1427. ADest[n].R := c1;
  1428. ADest[n].G := c2;
  1429. ADest[n].B := c3;
  1430. ADest[n].A := c4;
  1431. end;
  1432. GL_BGRA, GL_BGRA_INTEGER:
  1433. for n := 0 to AWidth * AHeight - 1 do
  1434. begin
  1435. GetChannel;
  1436. ADest[n].B := c1;
  1437. ADest[n].G := c2;
  1438. ADest[n].R := c3;
  1439. ADest[n].A := c4;
  1440. end;
  1441. else
  1442. raise EGLImageUtils.Create(strInvalidType);
  1443. end;
  1444. end;
  1445. procedure UShort5551RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1446. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1447. var
  1448. pSource: PWord;
  1449. n: Integer;
  1450. c0: Word;
  1451. c1, c2, c3, c4: Byte;
  1452. procedure GetChannel;
  1453. begin
  1454. c0 := pSource^;
  1455. c1 := (c0 and $001F) shl 3;
  1456. c2 := (c0 and $03E0) shr 2;
  1457. c3 := (c0 and $7C00) shr 7;
  1458. c4 := (c0 and $8000) shr 8;
  1459. Inc(pSource);
  1460. end;
  1461. begin
  1462. pSource := PWord(ASource);
  1463. case AColorFormat of
  1464. GL_RGBA, GL_RGBA_INTEGER:
  1465. for n := 0 to AWidth * AHeight - 1 do
  1466. begin
  1467. GetChannel;
  1468. ADest[n].R := c1;
  1469. ADest[n].G := c2;
  1470. ADest[n].B := c3;
  1471. ADest[n].A := c4;
  1472. end;
  1473. GL_BGRA, GL_BGRA_INTEGER:
  1474. for n := 0 to AWidth * AHeight - 1 do
  1475. begin
  1476. GetChannel;
  1477. ADest[n].B := c1;
  1478. ADest[n].G := c2;
  1479. ADest[n].R := c3;
  1480. ADest[n].A := c4;
  1481. end;
  1482. else
  1483. raise EGLImageUtils.Create(strInvalidType);
  1484. end;
  1485. end;
  1486. procedure UInt_10_10_10_2_ToImf(ASource: Pointer;
  1487. ADest: PIntermediateFormatArray; AColorFormat: Cardinal;
  1488. AWidth, AHeight: Integer);
  1489. var
  1490. pSource: PLongWord;
  1491. n: Integer;
  1492. c0: LongWord;
  1493. c1, c2, c3, c4: Word;
  1494. procedure GetChannel;
  1495. begin
  1496. c0 := pSource^;
  1497. c1 := (c0 and $000003FF) shl 6;
  1498. c2 := (c0 and $000FFC00) shr 4;
  1499. c3 := (c0 and $3FF00000) shr 14;
  1500. c4 := (c0 and $C0000000) shr 16;
  1501. Inc(pSource);
  1502. end;
  1503. begin
  1504. pSource := PLongWord(ASource);
  1505. case AColorFormat of
  1506. GL_RGBA, GL_RGBA_INTEGER:
  1507. for n := 0 to AWidth * AHeight - 1 do
  1508. begin
  1509. GetChannel;
  1510. ADest[n].R := c1 / $100;
  1511. ADest[n].G := c2 / $100;
  1512. ADest[n].B := c3 / $100;
  1513. ADest[n].A := c4;
  1514. end;
  1515. GL_BGRA, GL_BGRA_INTEGER:
  1516. for n := 0 to AWidth * AHeight - 1 do
  1517. begin
  1518. GetChannel;
  1519. ADest[n].B := c1 / $100;
  1520. ADest[n].G := c2 / $100;
  1521. ADest[n].R := c3 / $100;
  1522. ADest[n].A := c4;
  1523. end;
  1524. else
  1525. raise EGLImageUtils.Create(strInvalidType);
  1526. end;
  1527. end;
  1528. procedure UInt_10_10_10_2_Rev_ToImf(ASource: Pointer;
  1529. ADest: PIntermediateFormatArray; AColorFormat: Cardinal;
  1530. AWidth, AHeight: Integer);
  1531. var
  1532. pSource: PLongWord;
  1533. n: Integer;
  1534. c0: LongWord;
  1535. c1, c2, c3, c4: Word;
  1536. procedure GetChannel;
  1537. begin
  1538. c0 := pSource^;
  1539. c1 := (c0 and $000003FF) shl 6;
  1540. c2 := (c0 and $000FFC00) shr 4;
  1541. c3 := (c0 and $3FF00000) shr 14;
  1542. c4 := (c0 and $C0000000) shr 16;
  1543. Inc(pSource);
  1544. end;
  1545. begin
  1546. pSource := PLongWord(ASource);
  1547. case AColorFormat of
  1548. GL_RGBA, GL_RGBA_INTEGER:
  1549. for n := 0 to AWidth * AHeight - 1 do
  1550. begin
  1551. GetChannel;
  1552. ADest[n].R := c1 / $100;
  1553. ADest[n].G := c2 / $100;
  1554. ADest[n].B := c3 / $100;
  1555. ADest[n].A := c4;
  1556. end;
  1557. GL_BGRA, GL_BGRA_INTEGER:
  1558. for n := 0 to AWidth * AHeight - 1 do
  1559. begin
  1560. GetChannel;
  1561. ADest[n].B := c1 / $100;
  1562. ADest[n].G := c2 / $100;
  1563. ADest[n].R := c3 / $100;
  1564. ADest[n].A := c4;
  1565. end;
  1566. else
  1567. raise EGLImageUtils.Create(strInvalidType);
  1568. end;
  1569. end;
  1570. // ------------------------------ Decompression
  1571. procedure DecodeColor565(col: Word; out R, G, B: Byte);
  1572. begin
  1573. R := col and $1F;
  1574. G := (col shr 5) and $3F;
  1575. B := (col shr 11) and $1F;
  1576. end;
  1577. procedure DXT1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1578. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1579. var
  1580. x, y, i, j, k, select, offset: Integer;
  1581. col0, col1: Word;
  1582. colors: TU48BitBlock;
  1583. bitmask: Cardinal;
  1584. temp: PGLubyte;
  1585. r0, g0, b0, r1, g1, b1: Byte;
  1586. begin
  1587. temp := PGLubyte(ASource);
  1588. for y := 0 to (AHeight div 4) - 1 do
  1589. begin
  1590. for x := 0 to (AWidth div 4) - 1 do
  1591. begin
  1592. col0 := PWord(temp)^;
  1593. Inc(temp, 2);
  1594. col1 := PWord(temp)^;
  1595. Inc(temp, 2);
  1596. bitmask := PCardinal(temp)^;
  1597. Inc(temp, 4);
  1598. DecodeColor565(col0, r0, g0, b0);
  1599. DecodeColor565(col1, r1, g1, b1);
  1600. colors[0][0] := r0 shl 3;
  1601. colors[0][1] := g0 shl 2;
  1602. colors[0][2] := b0 shl 3;
  1603. colors[0][3] := $FF;
  1604. colors[1][0] := r1 shl 3;
  1605. colors[1][1] := g1 shl 2;
  1606. colors[1][2] := b1 shl 3;
  1607. colors[1][3] := $FF;
  1608. if col0 > col1 then
  1609. begin
  1610. colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
  1611. colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
  1612. colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
  1613. colors[2][3] := $FF;
  1614. colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
  1615. colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
  1616. colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
  1617. colors[3][3] := $FF;
  1618. end
  1619. else
  1620. begin
  1621. colors[2][0] := (colors[0][0] + colors[1][0]) div 2;
  1622. colors[2][1] := (colors[0][1] + colors[1][1]) div 2;
  1623. colors[2][2] := (colors[0][2] + colors[1][2]) div 2;
  1624. colors[2][3] := $FF;
  1625. colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
  1626. colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
  1627. colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
  1628. colors[3][3] := 0;
  1629. end;
  1630. k := 0;
  1631. for j := 0 to 3 do
  1632. begin
  1633. for i := 0 to 3 do
  1634. begin
  1635. select := (bitmask and (3 shl (k * 2))) shr (k * 2);
  1636. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  1637. begin
  1638. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1639. ADest[offset].B := colors[select][0];
  1640. ADest[offset].G := colors[select][1];
  1641. ADest[offset].R := colors[select][2];
  1642. ADest[offset].A := colors[select][3];
  1643. end;
  1644. Inc(k);
  1645. end;
  1646. end;
  1647. end;
  1648. end;
  1649. end;
  1650. procedure DXT3_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1651. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1652. var
  1653. x, y, i, j, k, select: Integer;
  1654. col0, col1, wrd: Word;
  1655. colors: TU48BitBlock;
  1656. bitmask, offset: Cardinal;
  1657. temp: PGLubyte;
  1658. r0, g0, b0, r1, g1, b1: Byte;
  1659. alpha: array [0 .. 3] of Word;
  1660. begin
  1661. temp := PGLubyte(ASource);
  1662. for y := 0 to (AHeight div 4) - 1 do
  1663. begin
  1664. for x := 0 to (AWidth div 4) - 1 do
  1665. begin
  1666. alpha[0] := PWord(temp)^;
  1667. Inc(temp, 2);
  1668. alpha[1] := PWord(temp)^;
  1669. Inc(temp, 2);
  1670. alpha[2] := PWord(temp)^;
  1671. Inc(temp, 2);
  1672. alpha[3] := PWord(temp)^;
  1673. Inc(temp, 2);
  1674. col0 := PWord(temp)^;
  1675. Inc(temp, 2);
  1676. col1 := PWord(temp)^;
  1677. Inc(temp, 2);
  1678. bitmask := PCardinal(temp)^;
  1679. Inc(temp, 4);
  1680. DecodeColor565(col0, r0, g0, b0);
  1681. DecodeColor565(col1, r1, g1, b1);
  1682. colors[0][0] := r0 shl 3;
  1683. colors[0][1] := g0 shl 2;
  1684. colors[0][2] := b0 shl 3;
  1685. colors[0][3] := $FF;
  1686. colors[1][0] := r1 shl 3;
  1687. colors[1][1] := g1 shl 2;
  1688. colors[1][2] := b1 shl 3;
  1689. colors[1][3] := $FF;
  1690. colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
  1691. colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
  1692. colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
  1693. colors[2][3] := $FF;
  1694. colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
  1695. colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
  1696. colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
  1697. colors[3][3] := $FF;
  1698. k := 0;
  1699. for j := 0 to 3 do
  1700. begin
  1701. for i := 0 to 3 do
  1702. begin
  1703. select := (bitmask and (3 shl (k * 2))) shr (k * 2);
  1704. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  1705. begin
  1706. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1707. ADest[offset].B := colors[select][0];
  1708. ADest[offset].G := colors[select][1];
  1709. ADest[offset].R := colors[select][2];
  1710. ADest[offset].A := colors[select][3];
  1711. end;
  1712. Inc(k);
  1713. end;
  1714. end;
  1715. for j := 0 to 3 do
  1716. begin
  1717. wrd := alpha[j];
  1718. for i := 0 to 3 do
  1719. begin
  1720. if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
  1721. begin
  1722. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1723. r0 := wrd and $0F;
  1724. ADest[offset].A := r0 or (r0 shl 4);
  1725. end;
  1726. wrd := wrd shr 4;
  1727. end;
  1728. end;
  1729. end;
  1730. end;
  1731. end;
  1732. procedure DXT5_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1733. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1734. var
  1735. x, y, i, j, k, select, offset: Integer;
  1736. col0, col1: Word;
  1737. colors: TU48BitBlock;
  1738. bits, bitmask: Cardinal;
  1739. temp, alphamask: PGLubyte;
  1740. r0, g0, b0, r1, g1, b1: Byte;
  1741. alphas: array [0 .. 7] of Byte;
  1742. begin
  1743. temp := PGLubyte(ASource);
  1744. for y := 0 to (AHeight div 4) - 1 do
  1745. begin
  1746. for x := 0 to (AWidth div 4) - 1 do
  1747. begin
  1748. alphas[0] := temp^;
  1749. Inc(temp);
  1750. alphas[1] := temp^;
  1751. Inc(temp);
  1752. alphamask := temp;
  1753. Inc(temp, 6);
  1754. col0 := PWord(temp)^;
  1755. Inc(temp, 2);
  1756. col1 := PWord(temp)^;
  1757. Inc(temp, 2);
  1758. bitmask := PCardinal(temp)^;
  1759. Inc(temp, 4);
  1760. DecodeColor565(col0, r0, g0, b0);
  1761. DecodeColor565(col1, r1, g1, b1);
  1762. colors[0][0] := r0 shl 3;
  1763. colors[0][1] := g0 shl 2;
  1764. colors[0][2] := b0 shl 3;
  1765. colors[0][3] := $FF;
  1766. colors[1][0] := r1 shl 3;
  1767. colors[1][1] := g1 shl 2;
  1768. colors[1][2] := b1 shl 3;
  1769. colors[1][3] := $FF;
  1770. colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
  1771. colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
  1772. colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
  1773. colors[2][3] := $FF;
  1774. colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
  1775. colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
  1776. colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
  1777. colors[3][3] := $FF;
  1778. k := 0;
  1779. for j := 0 to 3 do
  1780. begin
  1781. for i := 0 to 3 do
  1782. begin
  1783. select := (bitmask and (3 shl (k * 2))) shr (k * 2);
  1784. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  1785. begin
  1786. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1787. ADest[offset].B := colors[select][0];
  1788. ADest[offset].G := colors[select][1];
  1789. ADest[offset].R := colors[select][2];
  1790. end;
  1791. Inc(k);
  1792. end;
  1793. end;
  1794. if (alphas[0] > alphas[1]) then
  1795. begin
  1796. alphas[2] := (6 * alphas[0] + 1 * alphas[1] + 3) div 7;
  1797. alphas[3] := (5 * alphas[0] + 2 * alphas[1] + 3) div 7;
  1798. alphas[4] := (4 * alphas[0] + 3 * alphas[1] + 3) div 7;
  1799. alphas[5] := (3 * alphas[0] + 4 * alphas[1] + 3) div 7;
  1800. alphas[6] := (2 * alphas[0] + 5 * alphas[1] + 3) div 7;
  1801. alphas[7] := (1 * alphas[0] + 6 * alphas[1] + 3) div 7;
  1802. end
  1803. else
  1804. begin
  1805. alphas[2] := (4 * alphas[0] + 1 * alphas[1] + 2) div 5;
  1806. alphas[3] := (3 * alphas[0] + 2 * alphas[1] + 2) div 5;
  1807. alphas[4] := (2 * alphas[0] + 3 * alphas[1] + 2) div 5;
  1808. alphas[5] := (1 * alphas[0] + 4 * alphas[1] + 2) div 5;
  1809. alphas[6] := 0;
  1810. alphas[7] := $FF;
  1811. end;
  1812. bits := PCardinal(alphamask)^;
  1813. for j := 0 to 1 do
  1814. begin
  1815. for i := 0 to 3 do
  1816. begin
  1817. if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
  1818. begin
  1819. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1820. ADest[offset].A := alphas[bits and 7];
  1821. end;
  1822. bits := bits shr 3;
  1823. end;
  1824. end;
  1825. Inc(alphamask, 3);
  1826. bits := PCardinal(alphamask)^;
  1827. for j := 2 to 3 do
  1828. begin
  1829. for i := 0 to 3 do
  1830. begin
  1831. if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
  1832. begin
  1833. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1834. ADest[offset].A := alphas[bits and 7];
  1835. end;
  1836. bits := bits shr 3;
  1837. end;
  1838. end;
  1839. end;
  1840. end;
  1841. end;
  1842. procedure Decode48BitBlock(ACode: Int64; out ABlock: TU48BitBlock); overload;
  1843. var
  1844. x, y: Byte;
  1845. begin
  1846. for y := 0 to 3 do
  1847. for x := 0 to 3 do
  1848. begin
  1849. ABlock[x][y] := Byte(ACode and $03);
  1850. ACode := ACode shr 2;
  1851. end;
  1852. end;
  1853. procedure Decode48BitBlock(ACode: Int64; out ABlock: T48BitBlock); overload;
  1854. var
  1855. x, y: Byte;
  1856. begin
  1857. for y := 0 to 3 do
  1858. for x := 0 to 3 do
  1859. begin
  1860. ABlock[x][y] := SmallInt(ACode and $03);
  1861. ACode := ACode shr 2;
  1862. end;
  1863. end;
  1864. procedure LATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1865. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1866. var
  1867. x, y, i, j, offset: Integer;
  1868. LUM0, LUM1: Byte;
  1869. lum: Single;
  1870. colors: TU48BitBlock;
  1871. bitmask: Int64;
  1872. temp: PGLubyte;
  1873. begin
  1874. temp := PGLubyte(ASource);
  1875. for y := 0 to (AHeight div 4) - 1 do
  1876. begin
  1877. for x := 0 to (AWidth div 4) - 1 do
  1878. begin
  1879. LUM0 := temp^;
  1880. Inc(temp);
  1881. LUM1 := temp^;
  1882. Inc(temp);
  1883. bitmask := PInt64(temp)^;
  1884. Inc(temp, 6);
  1885. Decode48BitBlock(bitmask, colors);
  1886. for j := 0 to 3 do
  1887. begin
  1888. for i := 0 to 3 do
  1889. begin
  1890. if LUM0 > LUM1 then
  1891. case colors[j, i] of
  1892. 0:
  1893. colors[j, i] := LUM0;
  1894. 1:
  1895. colors[j, i] := LUM1;
  1896. 2:
  1897. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  1898. 3:
  1899. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  1900. 4:
  1901. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  1902. 5:
  1903. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  1904. 6:
  1905. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  1906. 7:
  1907. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  1908. end
  1909. else
  1910. case colors[j, i] of
  1911. 0:
  1912. colors[j, i] := LUM0;
  1913. 1:
  1914. colors[j, i] := LUM1;
  1915. 2:
  1916. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  1917. 3:
  1918. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  1919. 4:
  1920. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  1921. 5:
  1922. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  1923. 6:
  1924. colors[j, i] := 0;
  1925. 7:
  1926. colors[j, i] := 255;
  1927. end;
  1928. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  1929. begin
  1930. offset := ((4 * y + j) * AWidth + (4 * x + i));
  1931. lum := colors[j, i];
  1932. ADest[offset].R := lum;
  1933. ADest[offset].G := lum;
  1934. ADest[offset].B := lum;
  1935. ADest[offset].A := 255.0;
  1936. end;
  1937. end;
  1938. end;
  1939. end;
  1940. end;
  1941. end;
  1942. procedure SLATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  1943. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  1944. var
  1945. x, y, i, j, offset: Integer;
  1946. LUM0, LUM1: SmallInt;
  1947. lum: Single;
  1948. colors: T48BitBlock;
  1949. bitmask: Int64;
  1950. temp: PGLubyte;
  1951. begin
  1952. temp := PGLubyte(ASource);
  1953. for y := 0 to (AHeight div 4) - 1 do
  1954. begin
  1955. for x := 0 to (AWidth div 4) - 1 do
  1956. begin
  1957. LUM0 := PSmallInt(temp)^;
  1958. Inc(temp);
  1959. LUM1 := PSmallInt(temp)^;
  1960. Inc(temp);
  1961. bitmask := PInt64(temp)^;
  1962. Inc(temp, 6);
  1963. Decode48BitBlock(bitmask, colors);
  1964. for j := 0 to 3 do
  1965. begin
  1966. for i := 0 to 3 do
  1967. begin
  1968. if LUM0 > LUM1 then
  1969. case colors[j, i] of
  1970. 0:
  1971. colors[j, i] := LUM0;
  1972. 1:
  1973. colors[j, i] := LUM1;
  1974. 2:
  1975. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  1976. 3:
  1977. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  1978. 4:
  1979. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  1980. 5:
  1981. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  1982. 6:
  1983. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  1984. 7:
  1985. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  1986. end
  1987. else
  1988. case colors[j, i] of
  1989. 0:
  1990. colors[j, i] := LUM0;
  1991. 1:
  1992. colors[j, i] := LUM1;
  1993. 2:
  1994. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  1995. 3:
  1996. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  1997. 4:
  1998. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  1999. 5:
  2000. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  2001. 6:
  2002. colors[j, i] := -127;
  2003. 7:
  2004. colors[j, i] := 127;
  2005. end;
  2006. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2007. begin
  2008. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2009. lum := 2 * colors[j, i];
  2010. ADest[offset].R := lum;
  2011. ADest[offset].G := lum;
  2012. ADest[offset].B := lum;
  2013. ADest[offset].A := 127.0;
  2014. end;
  2015. end;
  2016. end;
  2017. end;
  2018. end;
  2019. end;
  2020. procedure LATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2021. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2022. var
  2023. x, y, i, j, offset: Integer;
  2024. LUM0, LUM1: Byte;
  2025. lum: Single;
  2026. colors: TU48BitBlock;
  2027. bitmask: Int64;
  2028. temp: PGLubyte;
  2029. begin
  2030. temp := PGLubyte(ASource);
  2031. for y := 0 to (AHeight div 4) - 1 do
  2032. begin
  2033. for x := 0 to (AWidth div 4) - 1 do
  2034. begin
  2035. LUM0 := temp^;
  2036. Inc(temp);
  2037. LUM1 := temp^;
  2038. Inc(temp);
  2039. bitmask := PInt64(temp)^;
  2040. Inc(temp, 6);
  2041. Decode48BitBlock(bitmask, colors);
  2042. for j := 0 to 3 do
  2043. begin
  2044. for i := 0 to 3 do
  2045. begin
  2046. if LUM0 > LUM1 then
  2047. case colors[j, i] of
  2048. 0:
  2049. colors[j, i] := LUM0;
  2050. 1:
  2051. colors[j, i] := LUM1;
  2052. 2:
  2053. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  2054. 3:
  2055. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  2056. 4:
  2057. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  2058. 5:
  2059. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  2060. 6:
  2061. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  2062. 7:
  2063. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  2064. end
  2065. else
  2066. case colors[j, i] of
  2067. 0:
  2068. colors[j, i] := LUM0;
  2069. 1:
  2070. colors[j, i] := LUM1;
  2071. 2:
  2072. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  2073. 3:
  2074. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  2075. 4:
  2076. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  2077. 5:
  2078. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  2079. 6:
  2080. colors[j, i] := 0;
  2081. 7:
  2082. colors[j, i] := 255;
  2083. end;
  2084. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2085. begin
  2086. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2087. lum := colors[j][i];
  2088. ADest[offset].R := lum;
  2089. ADest[offset].G := lum;
  2090. ADest[offset].B := lum;
  2091. end;
  2092. end; // for i
  2093. end; // for j
  2094. LUM0 := temp^;
  2095. Inc(temp);
  2096. LUM1 := temp^;
  2097. Inc(temp);
  2098. bitmask := PInt64(temp)^;
  2099. Inc(temp, 6);
  2100. Decode48BitBlock(bitmask, colors);
  2101. for j := 0 to 3 do
  2102. begin
  2103. for i := 0 to 3 do
  2104. begin
  2105. if LUM0 > LUM1 then
  2106. case colors[j, i] of
  2107. 0:
  2108. colors[j, i] := LUM0;
  2109. 1:
  2110. colors[j, i] := LUM1;
  2111. 2:
  2112. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  2113. 3:
  2114. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  2115. 4:
  2116. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  2117. 5:
  2118. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  2119. 6:
  2120. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  2121. 7:
  2122. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  2123. end
  2124. else
  2125. case colors[j, i] of
  2126. 0:
  2127. colors[j, i] := LUM0;
  2128. 1:
  2129. colors[j, i] := LUM1;
  2130. 2:
  2131. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  2132. 3:
  2133. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  2134. 4:
  2135. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  2136. 5:
  2137. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  2138. 6:
  2139. colors[j, i] := 0;
  2140. 7:
  2141. colors[j, i] := 255;
  2142. end;
  2143. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2144. ADest[((4 * y + j) * AWidth + (4 * x + i))].A := colors[j][i];
  2145. end;
  2146. end;
  2147. end;
  2148. end;
  2149. end;
  2150. procedure SLATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2151. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2152. var
  2153. x, y, i, j, offset: Integer;
  2154. LUM0, LUM1: SmallInt;
  2155. lum: Single;
  2156. colors: T48BitBlock;
  2157. bitmask: Int64;
  2158. temp: PGLubyte;
  2159. begin
  2160. temp := PGLubyte(ASource);
  2161. for y := 0 to (AHeight div 4) - 1 do
  2162. begin
  2163. for x := 0 to (AWidth div 4) - 1 do
  2164. begin
  2165. LUM0 := PSmallInt(temp)^;
  2166. Inc(temp);
  2167. LUM1 := PSmallInt(temp)^;
  2168. Inc(temp);
  2169. bitmask := PInt64(temp)^;
  2170. Inc(temp, 6);
  2171. Decode48BitBlock(bitmask, colors);
  2172. for j := 0 to 3 do
  2173. begin
  2174. for i := 0 to 3 do
  2175. begin
  2176. if LUM0 > LUM1 then
  2177. case colors[j, i] of
  2178. 0:
  2179. colors[j, i] := LUM0;
  2180. 1:
  2181. colors[j, i] := LUM1;
  2182. 2:
  2183. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  2184. 3:
  2185. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  2186. 4:
  2187. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  2188. 5:
  2189. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  2190. 6:
  2191. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  2192. 7:
  2193. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  2194. end
  2195. else
  2196. case colors[j, i] of
  2197. 0:
  2198. colors[j, i] := LUM0;
  2199. 1:
  2200. colors[j, i] := LUM1;
  2201. 2:
  2202. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  2203. 3:
  2204. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  2205. 4:
  2206. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  2207. 5:
  2208. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  2209. 6:
  2210. colors[j, i] := -127;
  2211. 7:
  2212. colors[j, i] := 127;
  2213. end;
  2214. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2215. begin
  2216. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2217. lum := 2 * colors[j][i];
  2218. ADest[offset].R := lum;
  2219. ADest[offset].G := lum;
  2220. ADest[offset].B := lum;
  2221. end;
  2222. end;
  2223. end;
  2224. LUM0 := PSmallInt(temp)^;
  2225. Inc(temp);
  2226. LUM1 := PSmallInt(temp)^;
  2227. Inc(temp);
  2228. bitmask := PInt64(temp)^;
  2229. Inc(temp, 6);
  2230. Decode48BitBlock(bitmask, colors);
  2231. for j := 0 to 3 do
  2232. begin
  2233. for i := 0 to 3 do
  2234. begin
  2235. if LUM0 > LUM1 then
  2236. case colors[j, i] of
  2237. 0:
  2238. colors[j, i] := LUM0;
  2239. 1:
  2240. colors[j, i] := LUM1;
  2241. 2:
  2242. colors[j, i] := (6 * LUM0 + LUM1) div 7;
  2243. 3:
  2244. colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
  2245. 4:
  2246. colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
  2247. 5:
  2248. colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
  2249. 6:
  2250. colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
  2251. 7:
  2252. colors[j, i] := (LUM0 + 6 * LUM1) div 7;
  2253. end
  2254. else
  2255. case colors[j, i] of
  2256. 0:
  2257. colors[j, i] := LUM0;
  2258. 1:
  2259. colors[j, i] := LUM1;
  2260. 2:
  2261. colors[j, i] := (4 * LUM0 + LUM1) div 5;
  2262. 3:
  2263. colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
  2264. 4:
  2265. colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
  2266. 5:
  2267. colors[j, i] := (LUM0 + 4 * LUM1) div 5;
  2268. 6:
  2269. colors[j, i] := -127;
  2270. 7:
  2271. colors[j, i] := 127;
  2272. end;
  2273. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2274. begin
  2275. ADest[((4 * y + j) * AWidth + (4 * x + i))].A := 2 * colors[j][i];
  2276. end;
  2277. end;
  2278. end;
  2279. end;
  2280. end;
  2281. end;
  2282. procedure RGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2283. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2284. var
  2285. x, y, i, j, offset: Integer;
  2286. RED0, RED1: Byte;
  2287. lum: Single;
  2288. colors: TU48BitBlock;
  2289. bitmask: Int64;
  2290. temp: PGLubyte;
  2291. begin
  2292. temp := PGLubyte(ASource);
  2293. for y := 0 to (AHeight div 4) - 1 do
  2294. begin
  2295. for x := 0 to (AWidth div 4) - 1 do
  2296. begin
  2297. RED0 := temp^;
  2298. Inc(temp);
  2299. RED1 := temp^;
  2300. Inc(temp);
  2301. bitmask := PInt64(temp)^;
  2302. Inc(temp, 6);
  2303. Decode48BitBlock(bitmask, colors);
  2304. for j := 0 to 3 do
  2305. begin
  2306. for i := 0 to 3 do
  2307. begin
  2308. if RED0 > RED1 then
  2309. case colors[j, i] of
  2310. 0:
  2311. colors[j, i] := RED0;
  2312. 1:
  2313. colors[j, i] := RED1;
  2314. 2:
  2315. colors[j, i] := (6 * RED0 + RED1) div 7;
  2316. 3:
  2317. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2318. 4:
  2319. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2320. 5:
  2321. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2322. 6:
  2323. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2324. 7:
  2325. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2326. end
  2327. else
  2328. case colors[j, i] of
  2329. 0:
  2330. colors[j, i] := RED0;
  2331. 1:
  2332. colors[j, i] := RED1;
  2333. 2:
  2334. colors[j, i] := (4 * RED0 + RED1) div 5;
  2335. 3:
  2336. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2337. 4:
  2338. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2339. 5:
  2340. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2341. 6:
  2342. colors[j, i] := 0;
  2343. 7:
  2344. colors[j, i] := 255;
  2345. end;
  2346. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2347. begin
  2348. offset := ((4 * y + j) * AWidth + (4 * x + i)) * 4;
  2349. lum := colors[j][i];
  2350. ADest[offset].R := lum;
  2351. ADest[offset].G := 0.0;
  2352. ADest[offset].B := 0.0;
  2353. ADest[offset].A := 255.0;
  2354. end;
  2355. end;
  2356. end;
  2357. end;
  2358. end;
  2359. end;
  2360. procedure SRGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2361. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2362. var
  2363. x, y, i, j, offset: Integer;
  2364. RED0, RED1: SmallInt;
  2365. lum: Single;
  2366. colors: T48BitBlock;
  2367. bitmask: Int64;
  2368. temp: PGLubyte;
  2369. begin
  2370. temp := PGLubyte(ASource);
  2371. for y := 0 to (AHeight div 4) - 1 do
  2372. begin
  2373. for x := 0 to (AWidth div 4) - 1 do
  2374. begin
  2375. RED0 := PSmallInt(temp)^;
  2376. Inc(temp);
  2377. RED1 := PSmallInt(temp)^;
  2378. Inc(temp);
  2379. bitmask := PInt64(temp)^;
  2380. Inc(temp, 6);
  2381. Decode48BitBlock(bitmask, colors);
  2382. for j := 0 to 3 do
  2383. begin
  2384. for i := 0 to 3 do
  2385. begin
  2386. if RED0 > RED1 then
  2387. case colors[j, i] of
  2388. 0:
  2389. colors[j, i] := RED0;
  2390. 1:
  2391. colors[j, i] := RED1;
  2392. 2:
  2393. colors[j, i] := (6 * RED0 + RED1) div 7;
  2394. 3:
  2395. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2396. 4:
  2397. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2398. 5:
  2399. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2400. 6:
  2401. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2402. 7:
  2403. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2404. end
  2405. else
  2406. case colors[j, i] of
  2407. 0:
  2408. colors[j, i] := RED0;
  2409. 1:
  2410. colors[j, i] := RED1;
  2411. 2:
  2412. colors[j, i] := (4 * RED0 + RED1) div 5;
  2413. 3:
  2414. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2415. 4:
  2416. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2417. 5:
  2418. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2419. 6:
  2420. colors[j, i] := -127;
  2421. 7:
  2422. colors[j, i] := 127;
  2423. end;
  2424. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2425. begin
  2426. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2427. lum := 2 * colors[j][i];
  2428. ADest[offset].R := lum;
  2429. ADest[offset].G := 0.0;
  2430. ADest[offset].B := 0.0;
  2431. ADest[offset].A := 127.0;
  2432. end;
  2433. end;
  2434. end;
  2435. end;
  2436. end;
  2437. end;
  2438. procedure RGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2439. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2440. var
  2441. x, y, i, j, offset: Integer;
  2442. RED0, RED1: Byte;
  2443. colors: TU48BitBlock;
  2444. bitmask: Int64;
  2445. temp: PGLubyte;
  2446. begin
  2447. temp := PGLubyte(ASource);
  2448. for y := 0 to (AHeight div 4) - 1 do
  2449. begin
  2450. for x := 0 to (AWidth div 4) - 1 do
  2451. begin
  2452. RED0 := temp^;
  2453. Inc(temp);
  2454. RED1 := temp^;
  2455. Inc(temp);
  2456. bitmask := PInt64(temp)^;
  2457. Inc(temp, 6);
  2458. Decode48BitBlock(bitmask, colors);
  2459. for j := 0 to 3 do
  2460. begin
  2461. for i := 0 to 3 do
  2462. begin
  2463. if RED0 > RED1 then
  2464. case colors[j, i] of
  2465. 0:
  2466. colors[j, i] := RED0;
  2467. 1:
  2468. colors[j, i] := RED1;
  2469. 2:
  2470. colors[j, i] := (6 * RED0 + RED1) div 7;
  2471. 3:
  2472. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2473. 4:
  2474. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2475. 5:
  2476. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2477. 6:
  2478. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2479. 7:
  2480. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2481. end
  2482. else
  2483. case colors[j, i] of
  2484. 0:
  2485. colors[j, i] := RED0;
  2486. 1:
  2487. colors[j, i] := RED1;
  2488. 2:
  2489. colors[j, i] := (4 * RED0 + RED1) div 5;
  2490. 3:
  2491. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2492. 4:
  2493. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2494. 5:
  2495. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2496. 6:
  2497. colors[j, i] := 0;
  2498. 7:
  2499. colors[j, i] := 255;
  2500. end;
  2501. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2502. begin
  2503. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2504. ADest[offset].R := colors[j][i];
  2505. ADest[offset].B := 0.0;
  2506. end;
  2507. end;
  2508. end;
  2509. RED0 := temp^;
  2510. Inc(temp);
  2511. RED1 := temp^;
  2512. Inc(temp);
  2513. bitmask := PInt64(temp)^;
  2514. Inc(temp, 6);
  2515. Decode48BitBlock(bitmask, colors);
  2516. for j := 0 to 3 do
  2517. begin
  2518. for i := 0 to 3 do
  2519. begin
  2520. if RED0 > RED1 then
  2521. case colors[j, i] of
  2522. 0:
  2523. colors[j, i] := RED0;
  2524. 1:
  2525. colors[j, i] := RED1;
  2526. 2:
  2527. colors[j, i] := (6 * RED0 + RED1) div 7;
  2528. 3:
  2529. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2530. 4:
  2531. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2532. 5:
  2533. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2534. 6:
  2535. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2536. 7:
  2537. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2538. end
  2539. else
  2540. case colors[j, i] of
  2541. 0:
  2542. colors[j, i] := RED0;
  2543. 1:
  2544. colors[j, i] := RED1;
  2545. 2:
  2546. colors[j, i] := (4 * RED0 + RED1) div 5;
  2547. 3:
  2548. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2549. 4:
  2550. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2551. 5:
  2552. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2553. 6:
  2554. colors[j, i] := 0;
  2555. 7:
  2556. colors[j, i] := 255;
  2557. end;
  2558. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2559. begin
  2560. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2561. ADest[offset].G := colors[j][i];
  2562. ADest[offset].A := 255.0;
  2563. end;
  2564. end;
  2565. end;
  2566. end;
  2567. end;
  2568. end;
  2569. procedure SRGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
  2570. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2571. var
  2572. x, y, i, j, offset: Integer;
  2573. RED0, RED1: SmallInt;
  2574. lum: Single;
  2575. colors: T48BitBlock;
  2576. bitmask: Int64;
  2577. temp: PGLubyte;
  2578. begin
  2579. temp := PGLubyte(ASource);
  2580. for y := 0 to (AHeight div 4) - 1 do
  2581. begin
  2582. for x := 0 to (AWidth div 4) - 1 do
  2583. begin
  2584. RED0 := PSmallInt(temp)^;
  2585. Inc(temp);
  2586. RED1 := PSmallInt(temp)^;
  2587. Inc(temp);
  2588. bitmask := PInt64(temp)^;
  2589. Inc(temp, 6);
  2590. Decode48BitBlock(bitmask, colors);
  2591. for j := 0 to 3 do
  2592. begin
  2593. for i := 0 to 3 do
  2594. begin
  2595. if RED0 > RED1 then
  2596. case colors[j, i] of
  2597. 0:
  2598. colors[j, i] := RED0;
  2599. 1:
  2600. colors[j, i] := RED1;
  2601. 2:
  2602. colors[j, i] := (6 * RED0 + RED1) div 7;
  2603. 3:
  2604. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2605. 4:
  2606. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2607. 5:
  2608. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2609. 6:
  2610. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2611. 7:
  2612. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2613. end
  2614. else
  2615. case colors[j, i] of
  2616. 0:
  2617. colors[j, i] := RED0;
  2618. 1:
  2619. colors[j, i] := RED1;
  2620. 2:
  2621. colors[j, i] := (4 * RED0 + RED1) div 5;
  2622. 3:
  2623. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2624. 4:
  2625. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2626. 5:
  2627. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2628. 6:
  2629. colors[j, i] := -127;
  2630. 7:
  2631. colors[j, i] := 127;
  2632. end;
  2633. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2634. begin
  2635. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2636. lum := 2 * colors[j][i];
  2637. ADest[offset].R := lum;
  2638. ADest[offset].B := 0.0;
  2639. end;
  2640. end;
  2641. end;
  2642. RED0 := PSmallInt(temp)^;
  2643. Inc(temp);
  2644. RED1 := PSmallInt(temp)^;
  2645. Inc(temp);
  2646. bitmask := PInt64(temp)^;
  2647. Inc(temp, 6);
  2648. Decode48BitBlock(bitmask, colors);
  2649. for j := 0 to 3 do
  2650. begin
  2651. for i := 0 to 3 do
  2652. begin
  2653. if RED0 > RED1 then
  2654. case colors[j, i] of
  2655. 0:
  2656. colors[j, i] := RED0;
  2657. 1:
  2658. colors[j, i] := RED1;
  2659. 2:
  2660. colors[j, i] := (6 * RED0 + RED1) div 7;
  2661. 3:
  2662. colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
  2663. 4:
  2664. colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
  2665. 5:
  2666. colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
  2667. 6:
  2668. colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
  2669. 7:
  2670. colors[j, i] := (RED0 + 6 * RED1) div 7;
  2671. end
  2672. else
  2673. case colors[j, i] of
  2674. 0:
  2675. colors[j, i] := RED0;
  2676. 1:
  2677. colors[j, i] := RED1;
  2678. 2:
  2679. colors[j, i] := (4 * RED0 + RED1) div 5;
  2680. 3:
  2681. colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
  2682. 4:
  2683. colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
  2684. 5:
  2685. colors[j, i] := (RED0 + 4 * RED1) div 5;
  2686. 6:
  2687. colors[j, i] := -127;
  2688. 7:
  2689. colors[j, i] := 127;
  2690. end;
  2691. if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
  2692. begin
  2693. offset := ((4 * y + j) * AWidth + (4 * x + i));
  2694. lum := 2 * colors[j][i];
  2695. ADest[offset].G := lum;
  2696. ADest[offset].A := 127.0;
  2697. end;
  2698. end;
  2699. end;
  2700. end;
  2701. end;
  2702. end;
  2703. // ------------------------------ RGBA Float to OpenGL format image
  2704. procedure UnsupportedFromImf(ASource: PIntermediateFormatArray; ADest: Pointer;
  2705. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2706. begin
  2707. raise EGLImageUtils.Create('Unimplemented type of conversion');
  2708. end;
  2709. procedure ImfToUbyte(ASource: PIntermediateFormatArray; ADest: Pointer;
  2710. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2711. var
  2712. pDest: PByte;
  2713. n: Integer;
  2714. procedure SetChannel(AValue: Single);
  2715. begin
  2716. pDest^ := Trunc(ClampValue(AValue, 0.0, 255.0));
  2717. Inc(pDest);
  2718. end;
  2719. procedure SetChannelI(AValue: Single);
  2720. begin
  2721. pDest^ := Trunc(AValue);
  2722. Inc(pDest);
  2723. end;
  2724. begin
  2725. pDest := PByte(ADest);
  2726. case AColorFormat of
  2727. GL_RGB:
  2728. for n := 0 to AWidth * AHeight - 1 do
  2729. begin
  2730. SetChannel(ASource[n].R);
  2731. SetChannel(ASource[n].G);
  2732. SetChannel(ASource[n].B);
  2733. end;
  2734. GL_RGB_INTEGER:
  2735. for n := 0 to AWidth * AHeight - 1 do
  2736. begin
  2737. SetChannelI(ASource[n].R);
  2738. SetChannelI(ASource[n].G);
  2739. SetChannelI(ASource[n].B);
  2740. end;
  2741. GL_BGR:
  2742. for n := 0 to AWidth * AHeight - 1 do
  2743. begin
  2744. SetChannel(ASource[n].B);
  2745. SetChannel(ASource[n].G);
  2746. SetChannel(ASource[n].R);
  2747. end;
  2748. GL_BGR_INTEGER:
  2749. for n := 0 to AWidth * AHeight - 1 do
  2750. begin
  2751. SetChannelI(ASource[n].B);
  2752. SetChannelI(ASource[n].G);
  2753. SetChannelI(ASource[n].R);
  2754. end;
  2755. GL_RGBA:
  2756. for n := 0 to AWidth * AHeight - 1 do
  2757. begin
  2758. SetChannel(ASource[n].R);
  2759. SetChannel(ASource[n].G);
  2760. SetChannel(ASource[n].B);
  2761. SetChannel(ASource[n].A);
  2762. end;
  2763. GL_RGBA_INTEGER:
  2764. for n := 0 to AWidth * AHeight - 1 do
  2765. begin
  2766. SetChannelI(ASource[n].R);
  2767. SetChannelI(ASource[n].G);
  2768. SetChannelI(ASource[n].B);
  2769. SetChannelI(ASource[n].A);
  2770. end;
  2771. GL_BGRA:
  2772. for n := 0 to AWidth * AHeight - 1 do
  2773. begin
  2774. SetChannel(ASource[n].B);
  2775. SetChannel(ASource[n].G);
  2776. SetChannel(ASource[n].R);
  2777. SetChannel(ASource[n].A);
  2778. end;
  2779. GL_BGRA_INTEGER:
  2780. for n := 0 to AWidth * AHeight - 1 do
  2781. begin
  2782. SetChannelI(ASource[n].B);
  2783. SetChannelI(ASource[n].G);
  2784. SetChannelI(ASource[n].R);
  2785. SetChannelI(ASource[n].A);
  2786. end;
  2787. GL_ALPHA:
  2788. for n := 0 to AWidth * AHeight - 1 do
  2789. begin
  2790. SetChannel(ASource[n].A);
  2791. end;
  2792. GL_ALPHA_INTEGER:
  2793. for n := 0 to AWidth * AHeight - 1 do
  2794. begin
  2795. SetChannelI(ASource[n].A);
  2796. end;
  2797. GL_LUMINANCE:
  2798. for n := 0 to AWidth * AHeight - 1 do
  2799. begin
  2800. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2801. end;
  2802. GL_LUMINANCE_INTEGER_EXT:
  2803. for n := 0 to AWidth * AHeight - 1 do
  2804. begin
  2805. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2806. end;
  2807. GL_LUMINANCE_ALPHA:
  2808. for n := 0 to AWidth * AHeight - 1 do
  2809. begin
  2810. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2811. SetChannel(ASource[n].A);
  2812. end;
  2813. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  2814. for n := 0 to AWidth * AHeight - 1 do
  2815. begin
  2816. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2817. SetChannelI(ASource[n].A);
  2818. end;
  2819. GL_INTENSITY:
  2820. for n := 0 to AWidth * AHeight - 1 do
  2821. begin
  2822. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2823. end;
  2824. GL_RED:
  2825. for n := 0 to AWidth * AHeight - 1 do
  2826. begin
  2827. SetChannel(ASource[n].R);
  2828. end;
  2829. GL_RED_INTEGER:
  2830. for n := 0 to AWidth * AHeight - 1 do
  2831. begin
  2832. SetChannelI(ASource[n].R);
  2833. end;
  2834. GL_GREEN:
  2835. for n := 0 to AWidth * AHeight - 1 do
  2836. begin
  2837. SetChannel(ASource[n].G);
  2838. end;
  2839. GL_GREEN_INTEGER:
  2840. for n := 0 to AWidth * AHeight - 1 do
  2841. begin
  2842. SetChannelI(ASource[n].G);
  2843. end;
  2844. GL_BLUE:
  2845. for n := 0 to AWidth * AHeight - 1 do
  2846. begin
  2847. SetChannel(ASource[n].B);
  2848. end;
  2849. GL_BLUE_INTEGER:
  2850. for n := 0 to AWidth * AHeight - 1 do
  2851. begin
  2852. SetChannelI(ASource[n].B);
  2853. end;
  2854. GL_RG:
  2855. for n := 0 to AWidth * AHeight - 1 do
  2856. begin
  2857. SetChannel(ASource[n].R);
  2858. SetChannel(ASource[n].G);
  2859. end;
  2860. GL_RG_INTEGER:
  2861. for n := 0 to AWidth * AHeight - 1 do
  2862. begin
  2863. SetChannelI(ASource[n].R);
  2864. SetChannelI(ASource[n].G);
  2865. end;
  2866. else
  2867. raise EGLImageUtils.Create(strInvalidType);
  2868. end;
  2869. end;
  2870. procedure ImfToByte(ASource: PIntermediateFormatArray; ADest: Pointer;
  2871. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  2872. var
  2873. pDest: PShortInt;
  2874. n: Integer;
  2875. procedure SetChannel(AValue: Single);
  2876. begin
  2877. pDest^ := Trunc(ClampValue(AValue, -127.0, 127.0));
  2878. Inc(pDest);
  2879. end;
  2880. procedure SetChannelI(AValue: Single);
  2881. begin
  2882. pDest^ := Trunc(AValue);
  2883. Inc(pDest);
  2884. end;
  2885. begin
  2886. pDest := PShortInt(ADest);
  2887. case AColorFormat of
  2888. GL_RGB:
  2889. for n := 0 to AWidth * AHeight - 1 do
  2890. begin
  2891. SetChannel(ASource[n].R);
  2892. SetChannel(ASource[n].G);
  2893. SetChannel(ASource[n].B);
  2894. end;
  2895. GL_RGB_INTEGER:
  2896. for n := 0 to AWidth * AHeight - 1 do
  2897. begin
  2898. SetChannelI(ASource[n].R);
  2899. SetChannelI(ASource[n].G);
  2900. SetChannelI(ASource[n].B);
  2901. end;
  2902. GL_BGR:
  2903. for n := 0 to AWidth * AHeight - 1 do
  2904. begin
  2905. SetChannel(ASource[n].B);
  2906. SetChannel(ASource[n].G);
  2907. SetChannel(ASource[n].R);
  2908. end;
  2909. GL_BGR_INTEGER:
  2910. for n := 0 to AWidth * AHeight - 1 do
  2911. begin
  2912. SetChannelI(ASource[n].B);
  2913. SetChannelI(ASource[n].G);
  2914. SetChannelI(ASource[n].R);
  2915. end;
  2916. GL_RGBA:
  2917. for n := 0 to AWidth * AHeight - 1 do
  2918. begin
  2919. SetChannel(ASource[n].R);
  2920. SetChannel(ASource[n].G);
  2921. SetChannel(ASource[n].B);
  2922. SetChannel(ASource[n].A);
  2923. end;
  2924. GL_RGBA_INTEGER:
  2925. for n := 0 to AWidth * AHeight - 1 do
  2926. begin
  2927. SetChannelI(ASource[n].R);
  2928. SetChannelI(ASource[n].G);
  2929. SetChannelI(ASource[n].B);
  2930. SetChannelI(ASource[n].A);
  2931. end;
  2932. GL_BGRA:
  2933. for n := 0 to AWidth * AHeight - 1 do
  2934. begin
  2935. SetChannel(ASource[n].B);
  2936. SetChannel(ASource[n].G);
  2937. SetChannel(ASource[n].R);
  2938. SetChannel(ASource[n].A);
  2939. end;
  2940. GL_BGRA_INTEGER:
  2941. for n := 0 to AWidth * AHeight - 1 do
  2942. begin
  2943. SetChannelI(ASource[n].B);
  2944. SetChannelI(ASource[n].G);
  2945. SetChannelI(ASource[n].R);
  2946. SetChannelI(ASource[n].A);
  2947. end;
  2948. GL_ALPHA:
  2949. for n := 0 to AWidth * AHeight - 1 do
  2950. begin
  2951. SetChannel(ASource[n].A);
  2952. end;
  2953. GL_ALPHA_INTEGER:
  2954. for n := 0 to AWidth * AHeight - 1 do
  2955. begin
  2956. SetChannelI(ASource[n].A);
  2957. end;
  2958. GL_LUMINANCE:
  2959. for n := 0 to AWidth * AHeight - 1 do
  2960. begin
  2961. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2962. end;
  2963. GL_LUMINANCE_INTEGER_EXT:
  2964. for n := 0 to AWidth * AHeight - 1 do
  2965. begin
  2966. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2967. end;
  2968. GL_LUMINANCE_ALPHA:
  2969. for n := 0 to AWidth * AHeight - 1 do
  2970. begin
  2971. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2972. SetChannel(ASource[n].A);
  2973. end;
  2974. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  2975. for n := 0 to AWidth * AHeight - 1 do
  2976. begin
  2977. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2978. SetChannelI(ASource[n].A);
  2979. end;
  2980. GL_INTENSITY:
  2981. for n := 0 to AWidth * AHeight - 1 do
  2982. begin
  2983. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  2984. end;
  2985. GL_RED:
  2986. for n := 0 to AWidth * AHeight - 1 do
  2987. begin
  2988. SetChannel(ASource[n].R);
  2989. end;
  2990. GL_RED_INTEGER:
  2991. for n := 0 to AWidth * AHeight - 1 do
  2992. begin
  2993. SetChannelI(ASource[n].R);
  2994. end;
  2995. GL_GREEN:
  2996. for n := 0 to AWidth * AHeight - 1 do
  2997. begin
  2998. SetChannel(ASource[n].G);
  2999. end;
  3000. GL_GREEN_INTEGER:
  3001. for n := 0 to AWidth * AHeight - 1 do
  3002. begin
  3003. SetChannelI(ASource[n].G);
  3004. end;
  3005. GL_BLUE:
  3006. for n := 0 to AWidth * AHeight - 1 do
  3007. begin
  3008. SetChannel(ASource[n].B);
  3009. end;
  3010. GL_BLUE_INTEGER:
  3011. for n := 0 to AWidth * AHeight - 1 do
  3012. begin
  3013. SetChannelI(ASource[n].B);
  3014. end;
  3015. GL_RG:
  3016. for n := 0 to AWidth * AHeight - 1 do
  3017. begin
  3018. SetChannel(ASource[n].R);
  3019. SetChannel(ASource[n].G);
  3020. end;
  3021. GL_RG_INTEGER:
  3022. for n := 0 to AWidth * AHeight - 1 do
  3023. begin
  3024. SetChannelI(ASource[n].R);
  3025. SetChannelI(ASource[n].G);
  3026. end;
  3027. else
  3028. raise EGLImageUtils.Create(strInvalidType);
  3029. end;
  3030. end;
  3031. procedure ImfToUShort(ASource: PIntermediateFormatArray; ADest: Pointer;
  3032. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3033. var
  3034. pDest: PWord;
  3035. n: Integer;
  3036. procedure SetChannel(AValue: Single);
  3037. begin
  3038. pDest^ := Trunc(ClampValue(AValue, 0.0, 65535.0));
  3039. Inc(pDest);
  3040. end;
  3041. procedure SetChannelI(AValue: Single);
  3042. begin
  3043. pDest^ := Trunc(AValue);
  3044. Inc(pDest);
  3045. end;
  3046. begin
  3047. pDest := PWord(ADest);
  3048. case AColorFormat of
  3049. GL_RGB:
  3050. for n := 0 to AWidth * AHeight - 1 do
  3051. begin
  3052. SetChannel(ASource[n].R);
  3053. SetChannel(ASource[n].G);
  3054. SetChannel(ASource[n].B);
  3055. end;
  3056. GL_RGB_INTEGER:
  3057. for n := 0 to AWidth * AHeight - 1 do
  3058. begin
  3059. SetChannelI(ASource[n].R);
  3060. SetChannelI(ASource[n].G);
  3061. SetChannelI(ASource[n].B);
  3062. end;
  3063. GL_BGR:
  3064. for n := 0 to AWidth * AHeight - 1 do
  3065. begin
  3066. SetChannel(ASource[n].B);
  3067. SetChannel(ASource[n].G);
  3068. SetChannel(ASource[n].R);
  3069. end;
  3070. GL_BGR_INTEGER:
  3071. for n := 0 to AWidth * AHeight - 1 do
  3072. begin
  3073. SetChannelI(ASource[n].B);
  3074. SetChannelI(ASource[n].G);
  3075. SetChannelI(ASource[n].R);
  3076. end;
  3077. GL_RGBA:
  3078. for n := 0 to AWidth * AHeight - 1 do
  3079. begin
  3080. SetChannel(ASource[n].R);
  3081. SetChannel(ASource[n].G);
  3082. SetChannel(ASource[n].B);
  3083. SetChannel(ASource[n].A);
  3084. end;
  3085. GL_RGBA_INTEGER:
  3086. for n := 0 to AWidth * AHeight - 1 do
  3087. begin
  3088. SetChannelI(ASource[n].R);
  3089. SetChannelI(ASource[n].G);
  3090. SetChannelI(ASource[n].B);
  3091. SetChannelI(ASource[n].A);
  3092. end;
  3093. GL_BGRA:
  3094. for n := 0 to AWidth * AHeight - 1 do
  3095. begin
  3096. SetChannel(ASource[n].B);
  3097. SetChannel(ASource[n].G);
  3098. SetChannel(ASource[n].R);
  3099. SetChannel(ASource[n].A);
  3100. end;
  3101. GL_BGRA_INTEGER:
  3102. for n := 0 to AWidth * AHeight - 1 do
  3103. begin
  3104. SetChannelI(ASource[n].B);
  3105. SetChannelI(ASource[n].G);
  3106. SetChannelI(ASource[n].R);
  3107. SetChannelI(ASource[n].A);
  3108. end;
  3109. GL_ALPHA:
  3110. for n := 0 to AWidth * AHeight - 1 do
  3111. begin
  3112. SetChannel(ASource[n].A);
  3113. end;
  3114. GL_ALPHA_INTEGER:
  3115. for n := 0 to AWidth * AHeight - 1 do
  3116. begin
  3117. SetChannelI(ASource[n].A);
  3118. end;
  3119. GL_LUMINANCE:
  3120. for n := 0 to AWidth * AHeight - 1 do
  3121. begin
  3122. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3123. end;
  3124. GL_LUMINANCE_INTEGER_EXT:
  3125. for n := 0 to AWidth * AHeight - 1 do
  3126. begin
  3127. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3128. end;
  3129. GL_LUMINANCE_ALPHA:
  3130. for n := 0 to AWidth * AHeight - 1 do
  3131. begin
  3132. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3133. SetChannel(ASource[n].A);
  3134. end;
  3135. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3136. for n := 0 to AWidth * AHeight - 1 do
  3137. begin
  3138. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3139. SetChannelI(ASource[n].A);
  3140. end;
  3141. GL_INTENSITY:
  3142. for n := 0 to AWidth * AHeight - 1 do
  3143. begin
  3144. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3145. end;
  3146. GL_RED:
  3147. for n := 0 to AWidth * AHeight - 1 do
  3148. begin
  3149. SetChannel(ASource[n].R);
  3150. end;
  3151. GL_RED_INTEGER:
  3152. for n := 0 to AWidth * AHeight - 1 do
  3153. begin
  3154. SetChannelI(ASource[n].R);
  3155. end;
  3156. GL_GREEN:
  3157. for n := 0 to AWidth * AHeight - 1 do
  3158. begin
  3159. SetChannel(ASource[n].G);
  3160. end;
  3161. GL_GREEN_INTEGER:
  3162. for n := 0 to AWidth * AHeight - 1 do
  3163. begin
  3164. SetChannelI(ASource[n].G);
  3165. end;
  3166. GL_BLUE:
  3167. for n := 0 to AWidth * AHeight - 1 do
  3168. begin
  3169. SetChannel(ASource[n].B);
  3170. end;
  3171. GL_BLUE_INTEGER:
  3172. for n := 0 to AWidth * AHeight - 1 do
  3173. begin
  3174. SetChannelI(ASource[n].B);
  3175. end;
  3176. GL_RG:
  3177. for n := 0 to AWidth * AHeight - 1 do
  3178. begin
  3179. SetChannel(ASource[n].R);
  3180. SetChannel(ASource[n].G);
  3181. end;
  3182. GL_RG_INTEGER:
  3183. for n := 0 to AWidth * AHeight - 1 do
  3184. begin
  3185. SetChannelI(ASource[n].R);
  3186. SetChannelI(ASource[n].G);
  3187. end;
  3188. else
  3189. raise EGLImageUtils.Create(strInvalidType);
  3190. end;
  3191. end;
  3192. procedure ImfToShort(ASource: PIntermediateFormatArray; ADest: Pointer;
  3193. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3194. var
  3195. pDest: PSmallInt;
  3196. n: Integer;
  3197. procedure SetChannel(AValue: Single);
  3198. begin
  3199. pDest^ := Trunc(ClampValue(AValue, -32767.0, 32767.0));
  3200. Inc(pDest);
  3201. end;
  3202. procedure SetChannelI(AValue: Single);
  3203. begin
  3204. pDest^ := Trunc(AValue);
  3205. Inc(pDest);
  3206. end;
  3207. begin
  3208. pDest := PSmallInt(ADest);
  3209. case AColorFormat of
  3210. GL_RGB:
  3211. for n := 0 to AWidth * AHeight - 1 do
  3212. begin
  3213. SetChannel(ASource[n].R);
  3214. SetChannel(ASource[n].G);
  3215. SetChannel(ASource[n].B);
  3216. end;
  3217. GL_RGB_INTEGER:
  3218. for n := 0 to AWidth * AHeight - 1 do
  3219. begin
  3220. SetChannelI(ASource[n].R);
  3221. SetChannelI(ASource[n].G);
  3222. SetChannelI(ASource[n].B);
  3223. end;
  3224. GL_BGR:
  3225. for n := 0 to AWidth * AHeight - 1 do
  3226. begin
  3227. SetChannel(ASource[n].B);
  3228. SetChannel(ASource[n].G);
  3229. SetChannel(ASource[n].R);
  3230. end;
  3231. GL_BGR_INTEGER:
  3232. for n := 0 to AWidth * AHeight - 1 do
  3233. begin
  3234. SetChannelI(ASource[n].B);
  3235. SetChannelI(ASource[n].G);
  3236. SetChannelI(ASource[n].R);
  3237. end;
  3238. GL_RGBA:
  3239. for n := 0 to AWidth * AHeight - 1 do
  3240. begin
  3241. SetChannel(ASource[n].R);
  3242. SetChannel(ASource[n].G);
  3243. SetChannel(ASource[n].B);
  3244. SetChannel(ASource[n].A);
  3245. end;
  3246. GL_RGBA_INTEGER:
  3247. for n := 0 to AWidth * AHeight - 1 do
  3248. begin
  3249. SetChannelI(ASource[n].R);
  3250. SetChannelI(ASource[n].G);
  3251. SetChannelI(ASource[n].B);
  3252. SetChannelI(ASource[n].A);
  3253. end;
  3254. GL_BGRA:
  3255. for n := 0 to AWidth * AHeight - 1 do
  3256. begin
  3257. SetChannel(ASource[n].B);
  3258. SetChannel(ASource[n].G);
  3259. SetChannel(ASource[n].R);
  3260. SetChannel(ASource[n].A);
  3261. end;
  3262. GL_BGRA_INTEGER:
  3263. for n := 0 to AWidth * AHeight - 1 do
  3264. begin
  3265. SetChannelI(ASource[n].B);
  3266. SetChannelI(ASource[n].G);
  3267. SetChannelI(ASource[n].R);
  3268. SetChannelI(ASource[n].A);
  3269. end;
  3270. GL_ALPHA:
  3271. for n := 0 to AWidth * AHeight - 1 do
  3272. begin
  3273. SetChannel(ASource[n].A);
  3274. end;
  3275. GL_ALPHA_INTEGER:
  3276. for n := 0 to AWidth * AHeight - 1 do
  3277. begin
  3278. SetChannelI(ASource[n].A);
  3279. end;
  3280. GL_LUMINANCE:
  3281. for n := 0 to AWidth * AHeight - 1 do
  3282. begin
  3283. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3284. end;
  3285. GL_LUMINANCE_INTEGER_EXT:
  3286. for n := 0 to AWidth * AHeight - 1 do
  3287. begin
  3288. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3289. end;
  3290. GL_LUMINANCE_ALPHA:
  3291. for n := 0 to AWidth * AHeight - 1 do
  3292. begin
  3293. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3294. SetChannel(ASource[n].A);
  3295. end;
  3296. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3297. for n := 0 to AWidth * AHeight - 1 do
  3298. begin
  3299. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3300. SetChannelI(ASource[n].A);
  3301. end;
  3302. GL_INTENSITY:
  3303. for n := 0 to AWidth * AHeight - 1 do
  3304. begin
  3305. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3306. end;
  3307. GL_RED:
  3308. for n := 0 to AWidth * AHeight - 1 do
  3309. begin
  3310. SetChannel(ASource[n].R);
  3311. end;
  3312. GL_RED_INTEGER:
  3313. for n := 0 to AWidth * AHeight - 1 do
  3314. begin
  3315. SetChannelI(ASource[n].R);
  3316. end;
  3317. GL_GREEN:
  3318. for n := 0 to AWidth * AHeight - 1 do
  3319. begin
  3320. SetChannel(ASource[n].G);
  3321. end;
  3322. GL_GREEN_INTEGER:
  3323. for n := 0 to AWidth * AHeight - 1 do
  3324. begin
  3325. SetChannelI(ASource[n].G);
  3326. end;
  3327. GL_BLUE:
  3328. for n := 0 to AWidth * AHeight - 1 do
  3329. begin
  3330. SetChannel(ASource[n].B);
  3331. end;
  3332. GL_BLUE_INTEGER:
  3333. for n := 0 to AWidth * AHeight - 1 do
  3334. begin
  3335. SetChannelI(ASource[n].B);
  3336. end;
  3337. GL_RG:
  3338. for n := 0 to AWidth * AHeight - 1 do
  3339. begin
  3340. SetChannel(ASource[n].R);
  3341. SetChannel(ASource[n].G);
  3342. end;
  3343. GL_RG_INTEGER:
  3344. for n := 0 to AWidth * AHeight - 1 do
  3345. begin
  3346. SetChannelI(ASource[n].R);
  3347. SetChannelI(ASource[n].G);
  3348. end;
  3349. else
  3350. raise EGLImageUtils.Create(strInvalidType);
  3351. end;
  3352. end;
  3353. procedure ImfToUInt(ASource: PIntermediateFormatArray; ADest: Pointer;
  3354. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3355. var
  3356. pDest: PLongWord;
  3357. n: Integer;
  3358. procedure SetChannel(AValue: Single);
  3359. begin
  3360. pDest^ := Trunc(ClampValue(AValue, 0.0, $FFFFFFFF));
  3361. Inc(pDest);
  3362. end;
  3363. procedure SetChannelI(AValue: Single);
  3364. begin
  3365. pDest^ := Trunc(AValue);
  3366. Inc(pDest);
  3367. end;
  3368. begin
  3369. pDest := PLongWord(ADest);
  3370. case AColorFormat of
  3371. GL_RGB:
  3372. for n := 0 to AWidth * AHeight - 1 do
  3373. begin
  3374. SetChannel(ASource[n].R);
  3375. SetChannel(ASource[n].G);
  3376. SetChannel(ASource[n].B);
  3377. end;
  3378. GL_RGB_INTEGER:
  3379. for n := 0 to AWidth * AHeight - 1 do
  3380. begin
  3381. SetChannelI(ASource[n].R);
  3382. SetChannelI(ASource[n].G);
  3383. SetChannelI(ASource[n].B);
  3384. end;
  3385. GL_BGR:
  3386. for n := 0 to AWidth * AHeight - 1 do
  3387. begin
  3388. SetChannel(ASource[n].B);
  3389. SetChannel(ASource[n].G);
  3390. SetChannel(ASource[n].R);
  3391. end;
  3392. GL_BGR_INTEGER:
  3393. for n := 0 to AWidth * AHeight - 1 do
  3394. begin
  3395. SetChannelI(ASource[n].B);
  3396. SetChannelI(ASource[n].G);
  3397. SetChannelI(ASource[n].R);
  3398. end;
  3399. GL_RGBA:
  3400. for n := 0 to AWidth * AHeight - 1 do
  3401. begin
  3402. SetChannel(ASource[n].R);
  3403. SetChannel(ASource[n].G);
  3404. SetChannel(ASource[n].B);
  3405. SetChannel(ASource[n].A);
  3406. end;
  3407. GL_RGBA_INTEGER:
  3408. for n := 0 to AWidth * AHeight - 1 do
  3409. begin
  3410. SetChannelI(ASource[n].R);
  3411. SetChannelI(ASource[n].G);
  3412. SetChannelI(ASource[n].B);
  3413. SetChannelI(ASource[n].A);
  3414. end;
  3415. GL_BGRA:
  3416. for n := 0 to AWidth * AHeight - 1 do
  3417. begin
  3418. SetChannel(ASource[n].B);
  3419. SetChannel(ASource[n].G);
  3420. SetChannel(ASource[n].R);
  3421. SetChannel(ASource[n].A);
  3422. end;
  3423. GL_BGRA_INTEGER:
  3424. for n := 0 to AWidth * AHeight - 1 do
  3425. begin
  3426. SetChannelI(ASource[n].B);
  3427. SetChannelI(ASource[n].G);
  3428. SetChannelI(ASource[n].R);
  3429. SetChannelI(ASource[n].A);
  3430. end;
  3431. GL_ALPHA:
  3432. for n := 0 to AWidth * AHeight - 1 do
  3433. begin
  3434. SetChannel(ASource[n].A);
  3435. end;
  3436. GL_ALPHA_INTEGER:
  3437. for n := 0 to AWidth * AHeight - 1 do
  3438. begin
  3439. SetChannelI(ASource[n].A);
  3440. end;
  3441. GL_LUMINANCE:
  3442. for n := 0 to AWidth * AHeight - 1 do
  3443. begin
  3444. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3445. end;
  3446. GL_LUMINANCE_INTEGER_EXT:
  3447. for n := 0 to AWidth * AHeight - 1 do
  3448. begin
  3449. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3450. end;
  3451. GL_LUMINANCE_ALPHA:
  3452. for n := 0 to AWidth * AHeight - 1 do
  3453. begin
  3454. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3455. SetChannel(ASource[n].A);
  3456. end;
  3457. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3458. for n := 0 to AWidth * AHeight - 1 do
  3459. begin
  3460. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3461. SetChannelI(ASource[n].A);
  3462. end;
  3463. GL_INTENSITY:
  3464. for n := 0 to AWidth * AHeight - 1 do
  3465. begin
  3466. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3467. end;
  3468. GL_RED:
  3469. for n := 0 to AWidth * AHeight - 1 do
  3470. begin
  3471. SetChannel(ASource[n].R);
  3472. end;
  3473. GL_RED_INTEGER:
  3474. for n := 0 to AWidth * AHeight - 1 do
  3475. begin
  3476. SetChannelI(ASource[n].R);
  3477. end;
  3478. GL_GREEN:
  3479. for n := 0 to AWidth * AHeight - 1 do
  3480. begin
  3481. SetChannel(ASource[n].G);
  3482. end;
  3483. GL_GREEN_INTEGER:
  3484. for n := 0 to AWidth * AHeight - 1 do
  3485. begin
  3486. SetChannelI(ASource[n].G);
  3487. end;
  3488. GL_BLUE:
  3489. for n := 0 to AWidth * AHeight - 1 do
  3490. begin
  3491. SetChannel(ASource[n].B);
  3492. end;
  3493. GL_BLUE_INTEGER:
  3494. for n := 0 to AWidth * AHeight - 1 do
  3495. begin
  3496. SetChannelI(ASource[n].B);
  3497. end;
  3498. GL_RG:
  3499. for n := 0 to AWidth * AHeight - 1 do
  3500. begin
  3501. SetChannel(ASource[n].R);
  3502. SetChannel(ASource[n].G);
  3503. end;
  3504. GL_RG_INTEGER:
  3505. for n := 0 to AWidth * AHeight - 1 do
  3506. begin
  3507. SetChannelI(ASource[n].R);
  3508. SetChannelI(ASource[n].G);
  3509. end;
  3510. else
  3511. raise EGLImageUtils.Create(strInvalidType);
  3512. end;
  3513. end;
  3514. procedure ImfToInt(ASource: PIntermediateFormatArray; ADest: Pointer;
  3515. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3516. var
  3517. pDest: PLongInt;
  3518. n: Integer;
  3519. procedure SetChannel(AValue: Single);
  3520. begin
  3521. pDest^ := Trunc(ClampValue(AValue, -$7FFFFFFF, $7FFFFFFF));
  3522. Inc(pDest);
  3523. end;
  3524. procedure SetChannelI(AValue: Single);
  3525. begin
  3526. pDest^ := Trunc(AValue);
  3527. Inc(pDest);
  3528. end;
  3529. begin
  3530. pDest := PLongInt(ADest);
  3531. case AColorFormat of
  3532. GL_RGB:
  3533. for n := 0 to AWidth * AHeight - 1 do
  3534. begin
  3535. SetChannel(ASource[n].R);
  3536. SetChannel(ASource[n].G);
  3537. SetChannel(ASource[n].B);
  3538. end;
  3539. GL_RGB_INTEGER:
  3540. for n := 0 to AWidth * AHeight - 1 do
  3541. begin
  3542. SetChannelI(ASource[n].R);
  3543. SetChannelI(ASource[n].G);
  3544. SetChannelI(ASource[n].B);
  3545. end;
  3546. GL_BGR:
  3547. for n := 0 to AWidth * AHeight - 1 do
  3548. begin
  3549. SetChannel(ASource[n].B);
  3550. SetChannel(ASource[n].G);
  3551. SetChannel(ASource[n].R);
  3552. end;
  3553. GL_BGR_INTEGER:
  3554. for n := 0 to AWidth * AHeight - 1 do
  3555. begin
  3556. SetChannelI(ASource[n].B);
  3557. SetChannelI(ASource[n].G);
  3558. SetChannelI(ASource[n].R);
  3559. end;
  3560. GL_RGBA:
  3561. for n := 0 to AWidth * AHeight - 1 do
  3562. begin
  3563. SetChannel(ASource[n].R);
  3564. SetChannel(ASource[n].G);
  3565. SetChannel(ASource[n].B);
  3566. SetChannel(ASource[n].A);
  3567. end;
  3568. GL_RGBA_INTEGER:
  3569. for n := 0 to AWidth * AHeight - 1 do
  3570. begin
  3571. SetChannelI(ASource[n].R);
  3572. SetChannelI(ASource[n].G);
  3573. SetChannelI(ASource[n].B);
  3574. SetChannelI(ASource[n].A);
  3575. end;
  3576. GL_BGRA:
  3577. for n := 0 to AWidth * AHeight - 1 do
  3578. begin
  3579. SetChannel(ASource[n].B);
  3580. SetChannel(ASource[n].G);
  3581. SetChannel(ASource[n].R);
  3582. SetChannel(ASource[n].A);
  3583. end;
  3584. GL_BGRA_INTEGER:
  3585. for n := 0 to AWidth * AHeight - 1 do
  3586. begin
  3587. SetChannelI(ASource[n].B);
  3588. SetChannelI(ASource[n].G);
  3589. SetChannelI(ASource[n].R);
  3590. SetChannelI(ASource[n].A);
  3591. end;
  3592. GL_ALPHA:
  3593. for n := 0 to AWidth * AHeight - 1 do
  3594. begin
  3595. SetChannel(ASource[n].A);
  3596. end;
  3597. GL_ALPHA_INTEGER:
  3598. for n := 0 to AWidth * AHeight - 1 do
  3599. begin
  3600. SetChannelI(ASource[n].A);
  3601. end;
  3602. GL_LUMINANCE:
  3603. for n := 0 to AWidth * AHeight - 1 do
  3604. begin
  3605. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3606. end;
  3607. GL_LUMINANCE_INTEGER_EXT:
  3608. for n := 0 to AWidth * AHeight - 1 do
  3609. begin
  3610. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3611. end;
  3612. GL_LUMINANCE_ALPHA:
  3613. for n := 0 to AWidth * AHeight - 1 do
  3614. begin
  3615. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3616. SetChannel(ASource[n].A);
  3617. end;
  3618. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3619. for n := 0 to AWidth * AHeight - 1 do
  3620. begin
  3621. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3622. SetChannelI(ASource[n].A);
  3623. end;
  3624. GL_INTENSITY:
  3625. for n := 0 to AWidth * AHeight - 1 do
  3626. begin
  3627. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3628. end;
  3629. GL_RED:
  3630. for n := 0 to AWidth * AHeight - 1 do
  3631. begin
  3632. SetChannel(ASource[n].R);
  3633. end;
  3634. GL_RED_INTEGER:
  3635. for n := 0 to AWidth * AHeight - 1 do
  3636. begin
  3637. SetChannelI(ASource[n].R);
  3638. end;
  3639. GL_GREEN:
  3640. for n := 0 to AWidth * AHeight - 1 do
  3641. begin
  3642. SetChannel(ASource[n].G);
  3643. end;
  3644. GL_GREEN_INTEGER:
  3645. for n := 0 to AWidth * AHeight - 1 do
  3646. begin
  3647. SetChannelI(ASource[n].G);
  3648. end;
  3649. GL_BLUE:
  3650. for n := 0 to AWidth * AHeight - 1 do
  3651. begin
  3652. SetChannel(ASource[n].B);
  3653. end;
  3654. GL_BLUE_INTEGER:
  3655. for n := 0 to AWidth * AHeight - 1 do
  3656. begin
  3657. SetChannelI(ASource[n].B);
  3658. end;
  3659. GL_RG:
  3660. for n := 0 to AWidth * AHeight - 1 do
  3661. begin
  3662. SetChannel(ASource[n].R);
  3663. SetChannel(ASource[n].G);
  3664. end;
  3665. GL_RG_INTEGER:
  3666. for n := 0 to AWidth * AHeight - 1 do
  3667. begin
  3668. SetChannelI(ASource[n].R);
  3669. SetChannelI(ASource[n].G);
  3670. end;
  3671. else
  3672. raise EGLImageUtils.Create(strInvalidType);
  3673. end;
  3674. end;
  3675. procedure ImfToFloat(ASource: PIntermediateFormatArray; ADest: Pointer;
  3676. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3677. const
  3678. cInv255 = 1.0 / 255.0;
  3679. var
  3680. pDest: PSingle;
  3681. n: Integer;
  3682. procedure SetChannel(AValue: Single);
  3683. begin
  3684. pDest^ := AValue * cInv255;
  3685. Inc(pDest);
  3686. end;
  3687. procedure SetChannelI(AValue: Single);
  3688. begin
  3689. pDest^ := AValue * cInv255;
  3690. Inc(pDest);
  3691. end;
  3692. begin
  3693. pDest := PSingle(ADest);
  3694. case AColorFormat of
  3695. GL_RGB:
  3696. for n := 0 to AWidth * AHeight - 1 do
  3697. begin
  3698. SetChannel(ASource[n].R);
  3699. SetChannel(ASource[n].G);
  3700. SetChannel(ASource[n].B);
  3701. end;
  3702. GL_RGB_INTEGER:
  3703. for n := 0 to AWidth * AHeight - 1 do
  3704. begin
  3705. SetChannelI(ASource[n].R);
  3706. SetChannelI(ASource[n].G);
  3707. SetChannelI(ASource[n].B);
  3708. end;
  3709. GL_BGR:
  3710. for n := 0 to AWidth * AHeight - 1 do
  3711. begin
  3712. SetChannel(ASource[n].B);
  3713. SetChannel(ASource[n].G);
  3714. SetChannel(ASource[n].R);
  3715. end;
  3716. GL_BGR_INTEGER:
  3717. for n := 0 to AWidth * AHeight - 1 do
  3718. begin
  3719. SetChannelI(ASource[n].B);
  3720. SetChannelI(ASource[n].G);
  3721. SetChannelI(ASource[n].R);
  3722. end;
  3723. GL_RGBA:
  3724. for n := 0 to AWidth * AHeight - 1 do
  3725. begin
  3726. SetChannel(ASource[n].R);
  3727. SetChannel(ASource[n].G);
  3728. SetChannel(ASource[n].B);
  3729. SetChannel(ASource[n].A);
  3730. end;
  3731. GL_RGBA_INTEGER:
  3732. for n := 0 to AWidth * AHeight - 1 do
  3733. begin
  3734. SetChannelI(ASource[n].R);
  3735. SetChannelI(ASource[n].G);
  3736. SetChannelI(ASource[n].B);
  3737. SetChannelI(ASource[n].A);
  3738. end;
  3739. GL_BGRA:
  3740. for n := 0 to AWidth * AHeight - 1 do
  3741. begin
  3742. SetChannel(ASource[n].B);
  3743. SetChannel(ASource[n].G);
  3744. SetChannel(ASource[n].R);
  3745. SetChannel(ASource[n].A);
  3746. end;
  3747. GL_BGRA_INTEGER:
  3748. for n := 0 to AWidth * AHeight - 1 do
  3749. begin
  3750. SetChannelI(ASource[n].B);
  3751. SetChannelI(ASource[n].G);
  3752. SetChannelI(ASource[n].R);
  3753. SetChannelI(ASource[n].A);
  3754. end;
  3755. GL_ALPHA:
  3756. for n := 0 to AWidth * AHeight - 1 do
  3757. begin
  3758. SetChannel(ASource[n].A);
  3759. end;
  3760. GL_ALPHA_INTEGER:
  3761. for n := 0 to AWidth * AHeight - 1 do
  3762. begin
  3763. SetChannelI(ASource[n].A);
  3764. end;
  3765. GL_LUMINANCE:
  3766. for n := 0 to AWidth * AHeight - 1 do
  3767. begin
  3768. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3769. end;
  3770. GL_LUMINANCE_INTEGER_EXT:
  3771. for n := 0 to AWidth * AHeight - 1 do
  3772. begin
  3773. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3774. end;
  3775. GL_LUMINANCE_ALPHA:
  3776. for n := 0 to AWidth * AHeight - 1 do
  3777. begin
  3778. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3779. SetChannel(ASource[n].A);
  3780. end;
  3781. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3782. for n := 0 to AWidth * AHeight - 1 do
  3783. begin
  3784. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3785. SetChannelI(ASource[n].A);
  3786. end;
  3787. GL_INTENSITY:
  3788. for n := 0 to AWidth * AHeight - 1 do
  3789. begin
  3790. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3791. end;
  3792. GL_RED:
  3793. for n := 0 to AWidth * AHeight - 1 do
  3794. begin
  3795. SetChannel(ASource[n].R);
  3796. end;
  3797. GL_RED_INTEGER:
  3798. for n := 0 to AWidth * AHeight - 1 do
  3799. begin
  3800. SetChannelI(ASource[n].R);
  3801. end;
  3802. GL_GREEN:
  3803. for n := 0 to AWidth * AHeight - 1 do
  3804. begin
  3805. SetChannel(ASource[n].G);
  3806. end;
  3807. GL_GREEN_INTEGER:
  3808. for n := 0 to AWidth * AHeight - 1 do
  3809. begin
  3810. SetChannelI(ASource[n].G);
  3811. end;
  3812. GL_BLUE:
  3813. for n := 0 to AWidth * AHeight - 1 do
  3814. begin
  3815. SetChannel(ASource[n].B);
  3816. end;
  3817. GL_BLUE_INTEGER:
  3818. for n := 0 to AWidth * AHeight - 1 do
  3819. begin
  3820. SetChannelI(ASource[n].B);
  3821. end;
  3822. GL_RG:
  3823. for n := 0 to AWidth * AHeight - 1 do
  3824. begin
  3825. SetChannel(ASource[n].R);
  3826. SetChannel(ASource[n].G);
  3827. end;
  3828. GL_RG_INTEGER:
  3829. for n := 0 to AWidth * AHeight - 1 do
  3830. begin
  3831. SetChannelI(ASource[n].R);
  3832. SetChannelI(ASource[n].G);
  3833. end;
  3834. else
  3835. raise EGLImageUtils.Create(strInvalidType);
  3836. end;
  3837. end;
  3838. procedure ImfToHalf(ASource: PIntermediateFormatArray; ADest: Pointer;
  3839. AColorFormat: Cardinal; AWidth, AHeight: Integer);
  3840. const
  3841. cInv255 = 1.0 / 255.0;
  3842. var
  3843. pDest: PHalfFloat;
  3844. n: Integer;
  3845. procedure SetChannel(AValue: Single);
  3846. begin
  3847. pDest^ := FloatToHalf(AValue * cInv255);
  3848. Inc(pDest);
  3849. end;
  3850. procedure SetChannelI(AValue: Single);
  3851. begin
  3852. pDest^ := FloatToHalf(AValue * cInv255);
  3853. Inc(pDest);
  3854. end;
  3855. begin
  3856. pDest := PHalfFloat(ADest);
  3857. case AColorFormat of
  3858. GL_RGB:
  3859. for n := 0 to AWidth * AHeight - 1 do
  3860. begin
  3861. SetChannel(ASource[n].R);
  3862. SetChannel(ASource[n].G);
  3863. SetChannel(ASource[n].B);
  3864. end;
  3865. GL_RGB_INTEGER:
  3866. for n := 0 to AWidth * AHeight - 1 do
  3867. begin
  3868. SetChannelI(ASource[n].R);
  3869. SetChannelI(ASource[n].G);
  3870. SetChannelI(ASource[n].B);
  3871. end;
  3872. GL_BGR:
  3873. for n := 0 to AWidth * AHeight - 1 do
  3874. begin
  3875. SetChannel(ASource[n].B);
  3876. SetChannel(ASource[n].G);
  3877. SetChannel(ASource[n].R);
  3878. end;
  3879. GL_BGR_INTEGER:
  3880. for n := 0 to AWidth * AHeight - 1 do
  3881. begin
  3882. SetChannelI(ASource[n].B);
  3883. SetChannelI(ASource[n].G);
  3884. SetChannelI(ASource[n].R);
  3885. end;
  3886. GL_RGBA:
  3887. for n := 0 to AWidth * AHeight - 1 do
  3888. begin
  3889. SetChannel(ASource[n].R);
  3890. SetChannel(ASource[n].G);
  3891. SetChannel(ASource[n].B);
  3892. SetChannel(ASource[n].A);
  3893. end;
  3894. GL_RGBA_INTEGER:
  3895. for n := 0 to AWidth * AHeight - 1 do
  3896. begin
  3897. SetChannelI(ASource[n].R);
  3898. SetChannelI(ASource[n].G);
  3899. SetChannelI(ASource[n].B);
  3900. SetChannelI(ASource[n].A);
  3901. end;
  3902. GL_BGRA:
  3903. for n := 0 to AWidth * AHeight - 1 do
  3904. begin
  3905. SetChannel(ASource[n].B);
  3906. SetChannel(ASource[n].G);
  3907. SetChannel(ASource[n].R);
  3908. SetChannel(ASource[n].A);
  3909. end;
  3910. GL_BGRA_INTEGER:
  3911. for n := 0 to AWidth * AHeight - 1 do
  3912. begin
  3913. SetChannelI(ASource[n].B);
  3914. SetChannelI(ASource[n].G);
  3915. SetChannelI(ASource[n].R);
  3916. SetChannelI(ASource[n].A);
  3917. end;
  3918. GL_ALPHA:
  3919. for n := 0 to AWidth * AHeight - 1 do
  3920. begin
  3921. SetChannel(ASource[n].A);
  3922. end;
  3923. GL_ALPHA_INTEGER:
  3924. for n := 0 to AWidth * AHeight - 1 do
  3925. begin
  3926. SetChannelI(ASource[n].A);
  3927. end;
  3928. GL_LUMINANCE:
  3929. for n := 0 to AWidth * AHeight - 1 do
  3930. begin
  3931. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3932. end;
  3933. GL_LUMINANCE_INTEGER_EXT:
  3934. for n := 0 to AWidth * AHeight - 1 do
  3935. begin
  3936. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3937. end;
  3938. GL_LUMINANCE_ALPHA:
  3939. for n := 0 to AWidth * AHeight - 1 do
  3940. begin
  3941. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3942. SetChannel(ASource[n].A);
  3943. end;
  3944. GL_LUMINANCE_ALPHA_INTEGER_EXT:
  3945. for n := 0 to AWidth * AHeight - 1 do
  3946. begin
  3947. SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3948. SetChannelI(ASource[n].A);
  3949. end;
  3950. GL_INTENSITY:
  3951. for n := 0 to AWidth * AHeight - 1 do
  3952. begin
  3953. SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
  3954. end;
  3955. GL_RED:
  3956. for n := 0 to AWidth * AHeight - 1 do
  3957. begin
  3958. SetChannel(ASource[n].R);
  3959. end;
  3960. GL_RED_INTEGER:
  3961. for n := 0 to AWidth * AHeight - 1 do
  3962. begin
  3963. SetChannelI(ASource[n].R);
  3964. end;
  3965. GL_GREEN:
  3966. for n := 0 to AWidth * AHeight - 1 do
  3967. begin
  3968. SetChannel(ASource[n].G);
  3969. end;
  3970. GL_GREEN_INTEGER:
  3971. for n := 0 to AWidth * AHeight - 1 do
  3972. begin
  3973. SetChannelI(ASource[n].G);
  3974. end;
  3975. GL_BLUE:
  3976. for n := 0 to AWidth * AHeight - 1 do
  3977. begin
  3978. SetChannel(ASource[n].B);
  3979. end;
  3980. GL_BLUE_INTEGER:
  3981. for n := 0 to AWidth * AHeight - 1 do
  3982. begin
  3983. SetChannelI(ASource[n].B);
  3984. end;
  3985. GL_RG:
  3986. for n := 0 to AWidth * AHeight - 1 do
  3987. begin
  3988. SetChannel(ASource[n].R);
  3989. SetChannel(ASource[n].G);
  3990. end;
  3991. GL_RG_INTEGER:
  3992. for n := 0 to AWidth * AHeight - 1 do
  3993. begin
  3994. SetChannelI(ASource[n].R);
  3995. SetChannelI(ASource[n].G);
  3996. end;
  3997. else
  3998. raise EGLImageUtils.Create(strInvalidType);
  3999. end;
  4000. end;
  4001. // ------------------------------ Compression
  4002. { function FloatTo565(const AColor: TIntermediateFormat): Integer;
  4003. var
  4004. r, g, b: Integer;
  4005. begin
  4006. // get the components in the correct range
  4007. r := Round( 31.0*AColor.R, 31 );
  4008. g := Round( 63.0*AColor.G, 63 );
  4009. b := Round( 31.0*AColor.B, 31 );
  4010. // pack into a single value
  4011. Result := ( r shl 11 ) or ( g shl 5 ) or b;
  4012. end;
  4013. procedure WriteColourBlock(a, b: Integer; const indices: PByteArray; out block: TU48BitBlock);
  4014. var
  4015. I, J: Byte;
  4016. begin
  4017. // write the endpoints
  4018. block[0][0] := a and $ff;
  4019. block[0][1] := a shr 8;
  4020. block[0][2] := b and $ff;
  4021. block[0][3] := b shr 8;
  4022. // write the indices
  4023. for i := 0 to 3 do
  4024. begin
  4025. J := 4*i;
  4026. block[1][i] = indices[J+0] or ( indices[J+1] shl 2 ) or ( indices[J+2] shl 4 ) or ( indices[J+3] shl 6 );
  4027. end;
  4028. end;
  4029. procedure WriteColourBlock3(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
  4030. var
  4031. i, a, b: Integer;
  4032. remapped: array[0..15] of Byte;
  4033. begin
  4034. // get the packed values
  4035. a := FloatTo565( start );
  4036. b := FloatTo565( end_ );
  4037. // remap the indices
  4038. if a <= b then
  4039. begin
  4040. // use the indices directly
  4041. for i := 0 to 15 do
  4042. remapped[i] := indices[i];
  4043. end
  4044. else
  4045. begin
  4046. // swap a and b
  4047. Swap( a, b );
  4048. for i := 0 to 15 do
  4049. begin
  4050. if indices[i] = 0 then
  4051. remapped[i] := 1
  4052. else if indices[i] = 1 then
  4053. remapped[i] := 0
  4054. else
  4055. remapped[i] := indices[i];
  4056. end;
  4057. end;
  4058. // write the block
  4059. WriteColourBlock( a, b, remapped, block );
  4060. end;
  4061. procedure WriteColourBlock4(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
  4062. var
  4063. i, a, b: Integer;
  4064. remapped: array[0..15] of Byte;
  4065. begin
  4066. // get the packed values
  4067. a := FloatTo565( start );
  4068. b := FloatTo565( end_ );
  4069. // remap the indices
  4070. if a < b then
  4071. begin
  4072. // swap a and b
  4073. Swap( a, b );
  4074. for i := 0 to 15 do
  4075. remapped[i] := ( indices[i] xor $01 ) and $03;
  4076. end
  4077. else if a = b then
  4078. begin
  4079. // use index 0
  4080. for i := 0 to 15 do
  4081. remapped[i] := 0;
  4082. end
  4083. else
  4084. begin
  4085. // use the indices directly
  4086. for i := 0 to 15 do
  4087. remapped[i] := indices[i];
  4088. end;
  4089. // write the block
  4090. WriteColourBlock( a, b, remapped, block );
  4091. end; }
  4092. // ------------------------------ Image filters
  4093. function ImageBoxFilter(Value: Single): Single;
  4094. begin
  4095. if (Value > -0.5) and (Value <= 0.5) then
  4096. Result := 1.0
  4097. else
  4098. Result := 0.0;
  4099. end;
  4100. function ImageTriangleFilter(Value: Single): Single;
  4101. begin
  4102. if Value < 0.0 then
  4103. Value := -Value;
  4104. if Value < 1.0 then
  4105. Result := 1.0 - Value
  4106. else
  4107. Result := 0.0;
  4108. end;
  4109. function ImageHermiteFilter(Value: Single): Single;
  4110. begin
  4111. if Value < 0.0 then
  4112. Value := -Value;
  4113. if Value < 1 then
  4114. Result := (2 * Value - 3) * Sqr(Value) + 1
  4115. else
  4116. Result := 0;
  4117. end;
  4118. function ImageBellFilter(Value: Single): Single;
  4119. begin
  4120. if Value < 0.0 then
  4121. Value := -Value;
  4122. if Value < 0.5 then
  4123. Result := 0.75 - Sqr(Value)
  4124. else if Value < 1.5 then
  4125. begin
  4126. Value := Value - 1.5;
  4127. Result := 0.5 * Sqr(Value);
  4128. end
  4129. else
  4130. Result := 0.0;
  4131. end;
  4132. function ImageSplineFilter(Value: Single): Single;
  4133. var
  4134. temp: Single;
  4135. begin
  4136. if Value < 0.0 then
  4137. Value := -Value;
  4138. if Value < 1.0 then
  4139. begin
  4140. temp := Sqr(Value);
  4141. Result := 0.5 * temp * Value - temp + 2.0 / 3.0;
  4142. end
  4143. else if Value < 2.0 then
  4144. begin
  4145. Value := 2.0 - Value;
  4146. Result := Sqr(Value) * Value / 6.0;
  4147. end
  4148. else
  4149. Result := 0.0;
  4150. end;
  4151. function ImageLanczos3Filter(Value: Single): Single;
  4152. const
  4153. Radius = 3.0;
  4154. begin
  4155. Result := 1;
  4156. if Value = 0 then
  4157. Exit;
  4158. if Value < 0.0 then
  4159. Value := -Value;
  4160. if Value < Radius then
  4161. begin
  4162. Value := Value * pi;
  4163. Result := Radius * Sin(Value) * Sin(Value / Radius) / (Value * Value);
  4164. end
  4165. else
  4166. Result := 0.0;
  4167. end;
  4168. function ImageMitchellFilter(Value: Single): Single;
  4169. const
  4170. B = 1.0 / 3.0;
  4171. C = 1.0 / 3.0;
  4172. var
  4173. temp: Single;
  4174. begin
  4175. if Value < 0.0 then
  4176. Value := -Value;
  4177. temp := Sqr(Value);
  4178. if Value < 1.0 then
  4179. begin
  4180. Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * temp)) +
  4181. ((-18.0 + 12.0 * B + 6.0 * C) * temp) + (6.0 - 2.0 * B));
  4182. Result := Value / 6.0;
  4183. end
  4184. else if Value < 2.0 then
  4185. begin
  4186. Value := (((-B - 6.0 * C) * (Value * temp)) + ((6.0 * B + 30.0 * C) * temp)
  4187. + ((-12.0 * B - 48.0 * C) * Value) + (8.0 * B + 24.0 * C));
  4188. Result := Value / 6.0;
  4189. end
  4190. else
  4191. Result := 0.0;
  4192. end;
  4193. const
  4194. cInvThree = 1.0 / 3.0;
  4195. procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
  4196. begin
  4197. AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
  4198. end;
  4199. procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
  4200. begin
  4201. if (AColor.R = 0.0) and (AColor.B = 0.0) and (AColor.G = 0.0) then
  4202. AColor.A := 0.0
  4203. else
  4204. AColor.A := 255.0;
  4205. end;
  4206. procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
  4207. begin
  4208. AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
  4209. AColor.R := AColor.A;
  4210. AColor.G := AColor.A;
  4211. AColor.B := AColor.A;
  4212. end;
  4213. procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
  4214. begin
  4215. AColor.A := Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
  4216. end;
  4217. procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
  4218. begin
  4219. AColor.A := 255.0;
  4220. end;
  4221. var
  4222. vTopLeftColor: TIntermediateFormat;
  4223. procedure ImageAlphaTopLeftPointColorTransparent
  4224. (var AColor: TIntermediateFormat);
  4225. begin
  4226. if CompareMem(@AColor, @vTopLeftColor, 3 * SizeOf(Single)) then
  4227. AColor.A := 0.0;
  4228. end;
  4229. procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
  4230. begin
  4231. AColor.A := 255.0 - (AColor.R + AColor.B + AColor.G) * cInvThree;
  4232. AColor.R := AColor.A;
  4233. AColor.G := AColor.A;
  4234. AColor.B := AColor.A;
  4235. end;
  4236. procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
  4237. begin
  4238. AColor.A := 255.0 - Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
  4239. end;
  4240. var
  4241. vBottomRightColor: TIntermediateFormat;
  4242. procedure ImageAlphaBottomRightPointColorTransparent
  4243. (var AColor: TIntermediateFormat);
  4244. begin
  4245. if CompareMem(@AColor, @vBottomRightColor, 3 * SizeOf(Single)) then
  4246. AColor.A := 0.0;
  4247. end;
  4248. type
  4249. // Contributor for a pixel
  4250. TContributor = record
  4251. pixel: Integer; // Source pixel
  4252. weight: Single; // Pixel weight
  4253. end;
  4254. TContributorList = array [0 .. MaxInt div (2 * SizeOf(TContributor))
  4255. ] of TContributor;
  4256. PContributorList = ^TContributorList;
  4257. // List of source pixels contributing to a destination pixel
  4258. TCList = record
  4259. n: Integer;
  4260. p: PContributorList;
  4261. end;
  4262. TCListList = array [0 .. MaxInt div (2 * SizeOf(TCList))] of TCList;
  4263. PCListList = ^TCListList;
  4264. // ------------------------------ Data type conversion table
  4265. type
  4266. TConvertTableRec = record
  4267. type_: Cardinal;
  4268. proc1: TConvertToImfProc;
  4269. proc2: TConvertFromInfProc;
  4270. end;
  4271. const
  4272. cConvertTable: array [0 .. 36] of TConvertTableRec =
  4273. ((type_: GL_UNSIGNED_BYTE; proc1: UbyteToImf; proc2: ImfToUbyte),
  4274. (type_: GL_UNSIGNED_BYTE_3_3_2; proc1: Ubyte332ToImf;
  4275. proc2: UnsupportedFromImf),
  4276. (type_: GL_UNSIGNED_BYTE_2_3_3_REV; proc1: Ubyte233RToImf;
  4277. proc2: UnsupportedFromImf),
  4278. (type_: GL_BYTE; proc1: ByteToImf; proc2: ImfToByte),
  4279. (type_: GL_UNSIGNED_SHORT; proc1: UShortToImf; proc2: ImfToUShort),
  4280. (type_: GL_SHORT; proc1: ShortToImf; proc2: ImfToShort),
  4281. (type_: GL_UNSIGNED_INT; proc1: UIntToImf; proc2: ImfToUInt),
  4282. (type_: GL_INT; proc1: IntToImf; proc2: ImfToInt),
  4283. (type_: GL_FLOAT; proc1: FloatToImf; proc2: ImfToFloat),
  4284. (type_: GL_HALF_FLOAT; proc1: HalfFloatToImf; proc2: ImfToHalf),
  4285. (type_: GL_UNSIGNED_INT_8_8_8_8; proc1: UInt8888ToImf;
  4286. proc2: UnsupportedFromImf),
  4287. (type_: GL_UNSIGNED_INT_8_8_8_8_REV; proc1: UInt8888RevToImf;
  4288. proc2: UnsupportedFromImf),
  4289. (type_: GL_UNSIGNED_SHORT_4_4_4_4; proc1: UShort4444ToImf;
  4290. proc2: UnsupportedFromImf),
  4291. (type_: GL_UNSIGNED_SHORT_4_4_4_4_REV; proc1: UShort4444RevToImf;
  4292. proc2: UnsupportedFromImf),
  4293. (type_: GL_UNSIGNED_SHORT_5_6_5; proc1: UShort565ToImf;
  4294. proc2: UnsupportedFromImf),
  4295. (type_: GL_UNSIGNED_SHORT_5_6_5_REV; proc1: UShort565RevToImf;
  4296. proc2: UnsupportedFromImf),
  4297. (type_: GL_UNSIGNED_SHORT_5_5_5_1; proc1: UShort5551ToImf;
  4298. proc2: UnsupportedFromImf),
  4299. (type_: GL_UNSIGNED_SHORT_1_5_5_5_REV; proc1: UShort5551RevToImf;
  4300. proc2: UnsupportedFromImf),
  4301. (type_: GL_UNSIGNED_INT_10_10_10_2; proc1: UInt_10_10_10_2_ToImf;
  4302. proc2: UnsupportedFromImf),
  4303. (type_: GL_UNSIGNED_INT_2_10_10_10_REV; proc1: UInt_10_10_10_2_Rev_ToImf;
  4304. proc2: UnsupportedFromImf),
  4305. (type_: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; proc1: DXT1_ToImf;
  4306. proc2: UnsupportedFromImf),
  4307. (type_: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; proc1: DXT1_ToImf;
  4308. proc2: UnsupportedFromImf),
  4309. (type_: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; proc1: DXT3_ToImf;
  4310. proc2: UnsupportedFromImf),
  4311. (type_: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; proc1: DXT5_ToImf;
  4312. proc2: UnsupportedFromImf),
  4313. (type_: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; proc1: UnsupportedToImf;
  4314. proc2: UnsupportedFromImf),
  4315. (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; proc1: UnsupportedToImf;
  4316. proc2: UnsupportedFromImf),
  4317. (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; proc1: UnsupportedToImf;
  4318. proc2: UnsupportedFromImf),
  4319. (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; proc1: UnsupportedToImf;
  4320. proc2: UnsupportedFromImf),
  4321. (type_: GL_COMPRESSED_LUMINANCE_LATC1_EXT; proc1: LATC1_ToImf;
  4322. proc2: UnsupportedFromImf),
  4323. (type_: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; proc1: SLATC1_ToImf;
  4324. proc2: UnsupportedFromImf),
  4325. (type_: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; proc1: LATC2_ToImf;
  4326. proc2: UnsupportedFromImf),
  4327. (type_: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; proc1: SLATC2_ToImf;
  4328. proc2: UnsupportedFromImf),
  4329. (type_: GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; proc1: UnsupportedToImf;
  4330. proc2: UnsupportedFromImf), (type_: GL_COMPRESSED_RED_RGTC1;
  4331. proc1: RGTC1_ToImf; proc2: UnsupportedFromImf),
  4332. (type_: GL_COMPRESSED_SIGNED_RED_RGTC1; proc1: SRGTC1_ToImf;
  4333. proc2: UnsupportedFromImf),
  4334. (type_: GL_COMPRESSED_RG_RGTC2; proc1: RGTC2_ToImf;
  4335. proc2: UnsupportedFromImf),
  4336. (type_: GL_COMPRESSED_SIGNED_RG_RGTC2; proc1: SRGTC2_ToImf;
  4337. proc2: UnsupportedFromImf));
  4338. procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer;
  4339. ASrcColorFormat, ADstColorFormat: Cardinal;
  4340. ASrcDataType, ADstDataType: Cardinal; AWidth, AHeight: Integer);
  4341. var
  4342. ConvertToIntermediateFormat: TConvertToImfProc;
  4343. ConvertFromIntermediateFormat: TConvertFromInfProc;
  4344. i, size: Integer;
  4345. tempBuf: PIntermediateFormatArray;
  4346. begin
  4347. if AWidth < 1 then
  4348. Exit;
  4349. AHeight := MaxInteger(1, AHeight);
  4350. // Allocate memory
  4351. size := AWidth * AHeight * SizeOf(TIntermediateFormat);
  4352. GetMem(tempBuf, size);
  4353. FillChar(tempBuf^, size, $00);
  4354. // Find function to convert external format to intermediate format
  4355. ConvertToIntermediateFormat := UnsupportedToImf;
  4356. for i := 0 to high(cConvertTable) do
  4357. begin
  4358. if ASrcDataType = cConvertTable[i].type_ then
  4359. begin
  4360. ConvertToIntermediateFormat := cConvertTable[i].proc1;
  4361. break;
  4362. end;
  4363. end;
  4364. try
  4365. ConvertToIntermediateFormat(ASrc, tempBuf, ASrcColorFormat, AWidth,
  4366. AHeight);
  4367. except
  4368. FreeMem(tempBuf);
  4369. raise;
  4370. end;
  4371. // Find function to convert intermediate format to external format
  4372. ConvertFromIntermediateFormat := UnsupportedFromImf;
  4373. for i := 0 to high(cConvertTable) do
  4374. begin
  4375. if ADstDataType = cConvertTable[i].type_ then
  4376. begin
  4377. ConvertFromIntermediateFormat := cConvertTable[i].proc2;
  4378. break;
  4379. end;
  4380. end;
  4381. try
  4382. ConvertFromIntermediateFormat(tempBuf, ADst, ADstColorFormat,
  4383. AWidth, AHeight);
  4384. except
  4385. FreeMem(tempBuf);
  4386. raise;
  4387. end;
  4388. FreeMem(tempBuf);
  4389. end;
  4390. procedure RescaleImage(const ASrc: Pointer; const ADst: Pointer;
  4391. AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
  4392. ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
  4393. var
  4394. ConvertToIntermediateFormat: TConvertToImfProc;
  4395. ConvertFromIntermediateFormat: TConvertFromInfProc;
  4396. i, j, k, n, size: Integer;
  4397. tempBuf1, tempBuf2, SourceLine, DestLine: PIntermediateFormatArray;
  4398. contrib: PCListList;
  4399. xscale, yscale: Single; // Zoom scale factors
  4400. width, fscale, weight: Single; // Filter calculation variables
  4401. center: Single; // Filter calculation variables
  4402. left, right: Integer; // Filter calculation variables
  4403. color1, color2: TIntermediateFormat;
  4404. begin
  4405. if (ASrcWidth < 1) or (ADstWidth < 1) then
  4406. Exit;
  4407. ASrcHeight := MaxInteger(1, ASrcHeight);
  4408. ADstHeight := MaxInteger(1, ADstHeight);
  4409. // Allocate memory
  4410. size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
  4411. GetMem(tempBuf1, size);
  4412. FillChar(tempBuf1^, size, $00);
  4413. // Find function to convert external format to intermediate format
  4414. ConvertToIntermediateFormat := UnsupportedToImf;
  4415. for i := 0 to high(cConvertTable) do
  4416. begin
  4417. if ADataType = cConvertTable[i].type_ then
  4418. begin
  4419. ConvertToIntermediateFormat := cConvertTable[i].proc1;
  4420. ConvertFromIntermediateFormat := cConvertTable[i].proc2;
  4421. break;
  4422. end;
  4423. end;
  4424. try
  4425. ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
  4426. ASrcHeight);
  4427. except
  4428. FreeMem(tempBuf1);
  4429. raise;
  4430. end;
  4431. // Rescale
  4432. if ASrcWidth = 1 then
  4433. xscale := ADstWidth / ASrcWidth
  4434. else
  4435. xscale := (ADstWidth - 1) / (ASrcWidth - 1);
  4436. if ASrcHeight = 1 then
  4437. yscale := ADstHeight / ASrcHeight
  4438. else
  4439. yscale := (ADstHeight - 1) / (ASrcHeight - 1);
  4440. // Pre-calculate filter contributions for a row
  4441. GetMem(contrib, ADstWidth * SizeOf(TCList));
  4442. // Horizontal sub-sampling
  4443. // Scales from bigger to smaller width
  4444. if xscale < 1.0 then
  4445. begin
  4446. width := vImageScaleFilterWidth / xscale;
  4447. fscale := 1.0 / xscale;
  4448. for i := 0 to ADstWidth - 1 do
  4449. begin
  4450. contrib^[i].n := 0;
  4451. GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
  4452. center := i / xscale;
  4453. left := floor(center - width);
  4454. right := ceil(center + width);
  4455. for j := left to right do
  4456. begin
  4457. weight := AFilter((center - j) / fscale) / fscale;
  4458. if weight = 0.0 then
  4459. continue;
  4460. if (j < 0) then
  4461. n := -j
  4462. else if (j >= ASrcWidth) then
  4463. n := ASrcWidth - j + ASrcWidth - 1
  4464. else
  4465. n := j;
  4466. k := contrib^[i].n;
  4467. contrib^[i].n := contrib^[i].n + 1;
  4468. contrib^[i].p^[k].pixel := n;
  4469. contrib^[i].p^[k].weight := weight;
  4470. end;
  4471. end;
  4472. end
  4473. else
  4474. // Horizontal super-sampling
  4475. // Scales from smaller to bigger width
  4476. begin
  4477. for i := 0 to ADstWidth - 1 do
  4478. begin
  4479. contrib^[i].n := 0;
  4480. GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) *
  4481. SizeOf(TContributor));
  4482. center := i / xscale;
  4483. left := floor(center - vImageScaleFilterWidth);
  4484. right := ceil(center + vImageScaleFilterWidth);
  4485. for j := left to right do
  4486. begin
  4487. weight := AFilter(center - j);
  4488. if weight = 0.0 then
  4489. continue;
  4490. if (j < 0) then
  4491. n := -j
  4492. else if (j >= ASrcWidth) then
  4493. n := ASrcWidth - j + ASrcWidth - 1
  4494. else
  4495. n := j;
  4496. k := contrib^[i].n;
  4497. contrib^[i].n := contrib^[i].n + 1;
  4498. contrib^[i].p^[k].pixel := n;
  4499. contrib^[i].p^[k].weight := weight;
  4500. end;
  4501. end;
  4502. end;
  4503. size := ADstWidth * ASrcHeight * SizeOf(TIntermediateFormat);
  4504. GetMem(tempBuf2, size);
  4505. // Apply filter to sample horizontally from Src to Work
  4506. for k := 0 to ASrcHeight - 1 do
  4507. begin
  4508. SourceLine := @tempBuf1[k * ASrcWidth];
  4509. DestLine := @tempBuf2[k * ADstWidth];
  4510. for i := 0 to ADstWidth - 1 do
  4511. begin
  4512. color1 := cSuperBlack;
  4513. for j := 0 to contrib^[i].n - 1 do
  4514. begin
  4515. weight := contrib^[i].p^[j].weight;
  4516. if weight = 0.0 then
  4517. continue;
  4518. color2 := SourceLine[contrib^[i].p^[j].pixel];
  4519. color1.R := color1.R + color2.R * weight;
  4520. color1.G := color1.G + color2.G * weight;
  4521. color1.B := color1.B + color2.B * weight;
  4522. color1.A := color1.A + color2.A * weight;
  4523. end;
  4524. // Set new pixel value
  4525. DestLine[i] := color1;
  4526. end;
  4527. end;
  4528. // Free the memory allocated for horizontal filter weights
  4529. for i := 0 to ADstWidth - 1 do
  4530. FreeMem(contrib^[i].p);
  4531. FreeMem(contrib);
  4532. // Pre-calculate filter contributions for a column
  4533. GetMem(contrib, ADstHeight * SizeOf(TCList));
  4534. // Vertical sub-sampling
  4535. // Scales from bigger to smaller height
  4536. if yscale < 1.0 then
  4537. begin
  4538. width := vImageScaleFilterWidth / yscale;
  4539. fscale := 1.0 / yscale;
  4540. for i := 0 to ADstHeight - 1 do
  4541. begin
  4542. contrib^[i].n := 0;
  4543. GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
  4544. center := i / yscale;
  4545. left := floor(center - width);
  4546. right := ceil(center + width);
  4547. for j := left to right do
  4548. begin
  4549. weight := AFilter((center - j) / fscale) / fscale;
  4550. if weight = 0.0 then
  4551. continue;
  4552. if (j < 0) then
  4553. n := -j
  4554. else if (j >= ASrcHeight) then
  4555. n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
  4556. else
  4557. n := j;
  4558. k := contrib^[i].n;
  4559. contrib^[i].n := contrib^[i].n + 1;
  4560. contrib^[i].p^[k].pixel := n;
  4561. contrib^[i].p^[k].weight := weight;
  4562. end;
  4563. end
  4564. end
  4565. else
  4566. // Vertical super-sampling
  4567. // Scales from smaller to bigger height
  4568. begin
  4569. for i := 0 to ADstHeight - 1 do
  4570. begin
  4571. contrib^[i].n := 0;
  4572. GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) *
  4573. SizeOf(TContributor));
  4574. center := i / yscale;
  4575. left := floor(center - vImageScaleFilterWidth);
  4576. right := ceil(center + vImageScaleFilterWidth);
  4577. for j := left to right do
  4578. begin
  4579. weight := AFilter(center - j);
  4580. if weight = 0.0 then
  4581. continue;
  4582. if j < 0 then
  4583. n := -j
  4584. else if (j >= ASrcHeight) then
  4585. n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
  4586. else
  4587. n := j;
  4588. k := contrib^[i].n;
  4589. contrib^[i].n := contrib^[i].n + 1;
  4590. contrib^[i].p^[k].pixel := n;
  4591. contrib^[i].p^[k].weight := weight;
  4592. end;
  4593. end;
  4594. end;
  4595. size := ADstWidth * ADstHeight * SizeOf(TIntermediateFormat);
  4596. ReallocMem(tempBuf1, size);
  4597. // Apply filter to sample vertically from Work to Dst
  4598. for k := 0 to ADstWidth - 1 do
  4599. begin
  4600. for i := 0 to ADstHeight - 1 do
  4601. begin
  4602. color1 := cSuperBlack;
  4603. for j := 0 to contrib^[i].n - 1 do
  4604. begin
  4605. weight := contrib^[i].p^[j].weight;
  4606. if weight = 0.0 then
  4607. continue;
  4608. color2 := tempBuf2[k + contrib^[i].p^[j].pixel * ADstWidth];
  4609. color1.R := color1.R + color2.R * weight;
  4610. color1.G := color1.G + color2.G * weight;
  4611. color1.B := color1.B + color2.B * weight;
  4612. color1.A := color1.A + color2.A * weight;
  4613. end;
  4614. tempBuf1[k + i * ADstWidth] := color1;
  4615. end;
  4616. end;
  4617. // Free the memory allocated for vertical filter weights
  4618. for i := 0 to ADstHeight - 1 do
  4619. FreeMem(contrib^[i].p);
  4620. FreeMem(contrib);
  4621. FreeMem(tempBuf2);
  4622. // Back to native image format
  4623. try
  4624. ConvertFromIntermediateFormat(tempBuf1, ADst, AColorFormat, ADstWidth,
  4625. ADstHeight);
  4626. except
  4627. FreeMem(tempBuf1);
  4628. raise;
  4629. end;
  4630. FreeMem(tempBuf1);
  4631. end;
  4632. procedure Div2(var Value: Integer); inline;
  4633. begin
  4634. Value := Value div 2;
  4635. if Value = 0 then
  4636. Value := 1;
  4637. end;
  4638. procedure Build2DMipmap(const ASrc: Pointer; const ADst: TPointerArray;
  4639. AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
  4640. ASrcWidth, ASrcHeight: Integer);
  4641. var
  4642. ConvertToIntermediateFormat: TConvertToImfProc;
  4643. ConvertFromIntermediateFormat: TConvertFromInfProc;
  4644. ADstWidth, ADstHeight: Integer;
  4645. i, j, k, n, size, level: Integer;
  4646. tempBuf1, tempBuf2, storePtr, SourceLine, DestLine: PIntermediateFormatArray;
  4647. contrib: PCListList;
  4648. xscale, yscale: Single;
  4649. width, fscale, weight: Single;
  4650. center: Single;
  4651. left, right: Integer;
  4652. color1, color2: TIntermediateFormat;
  4653. tempW, tempH: Integer;
  4654. begin
  4655. if ASrcWidth < 1 then
  4656. Exit;
  4657. ASrcHeight := MaxInteger(1, ASrcHeight);
  4658. // Allocate memory
  4659. tempW := ASrcWidth;
  4660. tempH := ASrcHeight;
  4661. size := 0;
  4662. for level := 0 to High(ADst) + 1 do
  4663. begin
  4664. Inc(size, tempW * tempH * SizeOf(TIntermediateFormat));
  4665. Div2(tempW);
  4666. Div2(tempH);
  4667. end;
  4668. GetMem(tempBuf1, size);
  4669. storePtr := tempBuf1;
  4670. FillChar(tempBuf1^, size, $00);
  4671. GetMem(tempBuf2, ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat));
  4672. // Find function to convert external format to intermediate format
  4673. ConvertToIntermediateFormat := UnsupportedToImf;
  4674. ConvertFromIntermediateFormat := UnsupportedFromImf;
  4675. for i := 0 to high(cConvertTable) do
  4676. begin
  4677. if ADataType = cConvertTable[i].type_ then
  4678. begin
  4679. ConvertToIntermediateFormat := cConvertTable[i].proc1;
  4680. ConvertFromIntermediateFormat := cConvertTable[i].proc2;
  4681. break;
  4682. end;
  4683. end;
  4684. try
  4685. ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
  4686. ASrcHeight);
  4687. except
  4688. FreeMem(tempBuf1);
  4689. raise;
  4690. end;
  4691. contrib := nil;
  4692. tempW := ASrcWidth;
  4693. tempH := ADstHeight;
  4694. try
  4695. // Downsampling
  4696. for level := 0 to High(ADst) do
  4697. begin
  4698. ADstWidth := ASrcWidth;
  4699. ADstHeight := ASrcHeight;
  4700. Div2(ADstWidth);
  4701. Div2(ADstHeight);
  4702. xscale := MaxFloat((ADstWidth - 1) / (ASrcWidth - 1), 0.25);
  4703. yscale := MaxFloat((ADstHeight - 1) / (ASrcHeight - 1), 0.25);
  4704. // Pre-calculate filter contributions for a row
  4705. ReallocMem(contrib, ADstWidth * SizeOf(TCList));
  4706. // Horizontal sub-sampling
  4707. // Scales from bigger to smaller width
  4708. width := vImageScaleFilterWidth / xscale;
  4709. fscale := 1.0 / xscale;
  4710. for i := 0 to ADstWidth - 1 do
  4711. begin
  4712. contrib^[i].n := 0;
  4713. GetMem(contrib^[i].p, Trunc(width * 2.0 + 1.0) * SizeOf(TContributor));
  4714. center := i / xscale;
  4715. left := floor(center - width);
  4716. right := ceil(center + width);
  4717. for j := left to right do
  4718. begin
  4719. weight := AFilter((center - j) / fscale) / fscale;
  4720. if weight = 0.0 then
  4721. continue;
  4722. if (j < 0) then
  4723. n := -j
  4724. else if (j >= ASrcWidth) then
  4725. n := MaxInteger(ASrcWidth - j + ASrcWidth - 1, 0)
  4726. else
  4727. n := j;
  4728. k := contrib^[i].n;
  4729. contrib^[i].n := contrib^[i].n + 1;
  4730. contrib^[i].p^[k].pixel := n;
  4731. contrib^[i].p^[k].weight := weight;
  4732. end;
  4733. end;
  4734. // Apply filter to sample horizontally from Src to Work
  4735. for k := 0 to ASrcHeight - 1 do
  4736. begin
  4737. SourceLine := @tempBuf1[k * ASrcWidth];
  4738. DestLine := @tempBuf2[k * ADstWidth];
  4739. for i := 0 to ADstWidth - 1 do
  4740. begin
  4741. color1 := cSuperBlack;
  4742. for j := 0 to contrib^[i].n - 1 do
  4743. begin
  4744. weight := contrib^[i].p^[j].weight;
  4745. if weight = 0.0 then
  4746. continue;
  4747. color2 := SourceLine[contrib^[i].p^[j].pixel];
  4748. color1.R := color1.R + color2.R * weight;
  4749. color1.G := color1.G + color2.G * weight;
  4750. color1.B := color1.B + color2.B * weight;
  4751. color1.A := color1.A + color2.A * weight;
  4752. end;
  4753. // Set new pixel value
  4754. DestLine[i] := color1;
  4755. end;
  4756. end;
  4757. // Free the memory allocated for horizontal filter weights
  4758. for i := 0 to ADstWidth - 1 do
  4759. FreeMem(contrib^[i].p);
  4760. // Pre-calculate filter contributions for a column
  4761. ReallocMem(contrib, ADstHeight * SizeOf(TCList));
  4762. // Vertical sub-sampling
  4763. // Scales from bigger to smaller height
  4764. width := vImageScaleFilterWidth / yscale;
  4765. fscale := 1.0 / yscale;
  4766. for i := 0 to ADstHeight - 1 do
  4767. begin
  4768. contrib^[i].n := 0;
  4769. GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
  4770. center := i / yscale;
  4771. left := floor(center - width);
  4772. right := ceil(center + width);
  4773. for j := left to right do
  4774. begin
  4775. weight := AFilter((center - j) / fscale) / fscale;
  4776. if weight = 0.0 then
  4777. continue;
  4778. if (j < 0) then
  4779. n := -j
  4780. else if (j >= ASrcHeight) then
  4781. n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
  4782. else
  4783. n := j;
  4784. k := contrib^[i].n;
  4785. contrib^[i].n := contrib^[i].n + 1;
  4786. contrib^[i].p^[k].pixel := n;
  4787. contrib^[i].p^[k].weight := weight;
  4788. end;
  4789. end;
  4790. size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
  4791. Inc(PByte(tempBuf1), size);
  4792. // Apply filter to sample vertically from Work to Dst
  4793. for k := 0 to ADstWidth - 1 do
  4794. begin
  4795. for i := 0 to ADstHeight - 1 do
  4796. begin
  4797. color1 := cSuperBlack;
  4798. for j := 0 to contrib^[i].n - 1 do
  4799. begin
  4800. weight := contrib^[i].p^[j].weight;
  4801. if weight = 0.0 then
  4802. continue;
  4803. n := k + contrib^[i].p^[j].pixel * ADstWidth;
  4804. color2 := tempBuf2[n];
  4805. color1.R := color1.R + color2.R * weight;
  4806. color1.G := color1.G + color2.G * weight;
  4807. color1.B := color1.B + color2.B * weight;
  4808. color1.A := color1.A + color2.A * weight;
  4809. end;
  4810. tempBuf1[k + i * ADstWidth] := color1;
  4811. end;
  4812. end;
  4813. // Free the memory allocated for vertical filter weights
  4814. for i := 0 to ADstHeight - 1 do
  4815. FreeMem(contrib^[i].p);
  4816. ASrcWidth := ADstWidth;
  4817. ASrcHeight := ADstHeight;
  4818. // Back to native image format
  4819. ConvertFromIntermediateFormat(tempBuf1, ADst[level], AColorFormat,
  4820. ASrcWidth, ASrcHeight);
  4821. end;
  4822. finally
  4823. if Assigned(contrib) then
  4824. FreeMem(contrib);
  4825. FreeMem(tempBuf2);
  4826. FreeMem(storePtr);
  4827. end;
  4828. end;
  4829. procedure AlphaGammaBrightCorrection(const ASrc: Pointer;
  4830. AColorFormat: Cardinal; ADataType: Cardinal; ASrcWidth, ASrcHeight: Integer;
  4831. anAlphaProc: TImageAlphaProc; ABrightness: Single; AGamma: Single);
  4832. var
  4833. ConvertToIntermediateFormat: TConvertToImfProc;
  4834. ConvertFromIntermediateFormat: TConvertFromInfProc;
  4835. tempBuf1: PIntermediateFormatArray;
  4836. Size, I: Integer;
  4837. begin
  4838. if ASrcWidth < 1 then
  4839. Exit;
  4840. ASrcHeight := MaxInteger(1, ASrcHeight);
  4841. Size := ASrcWidth * ASrcHeight;
  4842. GetMem(tempBuf1, Size * SizeOf(TIntermediateFormat));
  4843. // Find function to convert external format to intermediate format
  4844. ConvertToIntermediateFormat := UnsupportedToImf;
  4845. ConvertFromIntermediateFormat := UnsupportedFromImf;
  4846. for i := 0 to high(cConvertTable) do
  4847. begin
  4848. if ADataType = cConvertTable[i].type_ then
  4849. begin
  4850. ConvertToIntermediateFormat := cConvertTable[i].proc1;
  4851. ConvertFromIntermediateFormat := cConvertTable[i].proc2;
  4852. break;
  4853. end;
  4854. end;
  4855. try
  4856. ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
  4857. ASrcHeight);
  4858. vTopLeftColor := tempBuf1[0];
  4859. vBottomRightColor := tempBuf1[size - 1];
  4860. if Assigned(anAlphaProc) then
  4861. for i := size - 1 downto 0 do
  4862. anAlphaProc(tempBuf1[i]);
  4863. if ABrightness <> 1.0 then
  4864. for i := size - 1 downto 0 do
  4865. with tempBuf1[i] do
  4866. begin
  4867. R := R * ABrightness;
  4868. G := G * ABrightness;
  4869. B := B * ABrightness;
  4870. end;
  4871. if AGamma <> 1.0 then
  4872. for i := size - 1 downto 0 do
  4873. with tempBuf1[i] do
  4874. begin
  4875. R := Power(R, AGamma);
  4876. G := Power(G, AGamma);
  4877. B := Power(B, AGamma);
  4878. end;
  4879. // Back to native image format
  4880. ConvertFromIntermediateFormat(tempBuf1, ASrc, AColorFormat, ASrcWidth,
  4881. ASrcHeight);
  4882. except
  4883. FreeMem(tempBuf1);
  4884. raise;
  4885. end;
  4886. FreeMem(tempBuf1);
  4887. end;
  4888. function StringToColorAdvancedSafe(const Str: string;
  4889. const Default: TColor): TColor;
  4890. begin
  4891. if not TryStringToColorAdvanced(Str, Result) then
  4892. Result := Default;
  4893. end;
  4894. function StringToColorAdvanced(const Str: string): TColor;
  4895. begin
  4896. if not TryStringToColorAdvanced(Str, Result) then
  4897. raise EGLUtilsException.CreateResFmt(@strInvalidColor, [Str]);
  4898. end;
  4899. function TryStringToColorAdvanced(const Str: string;
  4900. var OutColor: TColor): Boolean;
  4901. var
  4902. Code, i: Integer;
  4903. Temp: string;
  4904. begin
  4905. Result := True;
  4906. Temp := Str;
  4907. val(Temp, i, Code); // to see if it is a number
  4908. if Code = 0 then
  4909. OutColor := TColor(i) // Str = $0000FF
  4910. else
  4911. begin
  4912. if not IdentToColor(Temp, LongInt(OutColor)) then // Str = clRed
  4913. begin
  4914. if AnsiStartsText('clr', Temp) then // Str = clrRed
  4915. begin
  4916. Delete(Temp, 3, 1);
  4917. if not IdentToColor(Temp, LongInt(OutColor)) then
  4918. Result := False;
  4919. end
  4920. else if not IdentToColor('cl' + Temp, LongInt(OutColor)) then // Str = Red
  4921. Result := False;
  4922. end;
  4923. end;
  4924. end;
  4925. //--------------------------------------------------------------------------
  4926. function GetDeviceCapabilities: TDeviceCapabilities;
  4927. var
  4928. device: HDC;
  4929. begin
  4930. device := GetDC(0);
  4931. try
  4932. Result.Xdpi := GetDeviceCaps(device, LOGPIXELSX);
  4933. Result.Ydpi := GetDeviceCaps(device, LOGPIXELSY);
  4934. Result.Depth := GetDeviceCaps(device, BITSPIXEL);
  4935. Result.NumColors := GetDeviceCaps(device, NumColors);
  4936. finally
  4937. ReleaseDC(0, device);
  4938. end;
  4939. end;
  4940. // -------------------------------------------------------------------------
  4941. function GetDeviceLogicalPixelsX(device: HDC): Integer;
  4942. begin
  4943. Result := GetDeviceCapabilities().Xdpi;
  4944. end;
  4945. function GetCurrentColorDepth: Integer;
  4946. begin
  4947. Result := GetDeviceCapabilities().Depth;
  4948. end;
  4949. function PixelFormatToColorBits(aPixelFormat: TPixelFormat): Integer;
  4950. begin
  4951. case aPixelFormat of
  4952. pfCustom{$IFDEF WIN32}, pfDevice{$ENDIF}: // use current color depth
  4953. Result := GetCurrentColorDepth;
  4954. pf1bit:
  4955. Result := 1;
  4956. {$IFDEF WIN32}
  4957. pf4bit:
  4958. Result := 4;
  4959. pf15bit:
  4960. Result := 15;
  4961. {$ENDIF}
  4962. pf8bit:
  4963. Result := 8;
  4964. pf16bit:
  4965. Result := 16;
  4966. pf32bit:
  4967. Result := 32;
  4968. else
  4969. Result := 24;
  4970. end;
  4971. end;
  4972. //-------------------------------------------------------------------------
  4973. procedure InformationDlg(const msg: string);
  4974. begin
  4975. ShowMessage(msg);
  4976. end;
  4977. function QuestionDlg(const msg: string): Boolean;
  4978. begin
  4979. Result := (MessageDlg(msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  4980. end;
  4981. function InputDlg(const aCaption, aPrompt, aDefault: string): string;
  4982. begin
  4983. Result := InputBox(aCaption, aPrompt, aDefault);
  4984. end;
  4985. function SavePictureDialog(var aFileName: string;
  4986. const aTitle: string = ''): Boolean;
  4987. var
  4988. saveDialog: TSavePictureDialog;
  4989. begin
  4990. saveDialog := TSavePictureDialog.Create(nil);
  4991. try
  4992. with saveDialog do
  4993. begin
  4994. Options := [ofHideReadOnly, ofNoReadOnlyReturn];
  4995. if aTitle <> '' then
  4996. Title := aTitle;
  4997. fileName := aFileName;
  4998. Result := Execute;
  4999. if Result then
  5000. aFileName := fileName;
  5001. end;
  5002. finally
  5003. saveDialog.Free;
  5004. end;
  5005. end;
  5006. function OpenPictureDialog(var aFileName: string;
  5007. const aTitle: string = ''): Boolean;
  5008. var
  5009. openDialog: TOpenPictureDialog;
  5010. begin
  5011. openDialog := TOpenPictureDialog.Create(nil);
  5012. try
  5013. with openDialog do
  5014. begin
  5015. Options := [ofHideReadOnly, ofNoReadOnlyReturn];
  5016. if aTitle <> '' then
  5017. Title := aTitle;
  5018. fileName := aFileName;
  5019. Result := Execute;
  5020. if Result then
  5021. aFileName := fileName;
  5022. end;
  5023. finally
  5024. openDialog.Free;
  5025. end;
  5026. end;
  5027. // ----------------------------------------------------------------------------
  5028. end.