GXS.ImageUtils.pas 143 KB

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