1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359 |
- //
- // The graphics engine GXScene https://github.com/glscene
- //
- unit GXS.ImageUtils;
- (* Main purpose is as a fallback in cases where there is no other way to process images *)
- // TODO: Complite InfToXXX
- // TODO: BPTC decompression
- // TODO: S3TC compression
- // TODO: LATC compression
- // TODO: RGTC compression
- // TODO: BPTC compression
- // TODO: Build3DMipmap
- interface
- {$I Stage.Defines.inc}
- uses
- Winapi.Windows,
- Winapi.OpenGL,
- Winapi.OpenGLext,
- System.SysUtils,
- System.UiTypes,
- System.UiConsts,
- System.Classes,
- System.Math,
- FMX.Types,
- FMX.Forms,
- FMX.Dialogs,
- FMX.Graphics,
- FMX.Consts,
- Stage.Strings,
- Stage.VectorGeometry,
- Stage.Utils,
- Stage.TextureFormat;
- var
- vImageScaleFilterWidth: Integer = 5; // Relative sample radius for filtering
- type
- TIntermediateFormat = record
- R, G, B, A: Single;
- end;
- TPointerArray = array of Pointer;
- PRGBA32F = ^TIntermediateFormat;
- TIntermediateFormatArray = array
- [0 .. MaxInt div (2 * SizeOf(TIntermediateFormat))] of TIntermediateFormat;
- PIntermediateFormatArray = ^TIntermediateFormatArray;
- TU48BitBlock = array [0 .. 3, 0 .. 3] of Byte;
- T48BitBlock = array [0 .. 3, 0 .. 3] of SmallInt;
- EGLImageUtils = class(Exception);
- TImageFilterFunction = function(Value: Single): Single;
- TImageAlphaProc = procedure(var AColor: TIntermediateFormat);
- TGraphicClass = class of TBitmap; // in vcl class of TGraphic
- TgxTextLayout = (tlTop, tlCenter, tlBottom); // TglTextLayout
- const
- sAllFilter: string = SMsgDlgAll; ///in VCL -> sAllFilter;
- function ImageBoxFilter(Value: Single): Single;
- function ImageTriangleFilter(Value: Single): Single;
- function ImageHermiteFilter(Value: Single): Single;
- function ImageBellFilter(Value: Single): Single;
- function ImageSplineFilter(Value: Single): Single;
- function ImageLanczos3Filter(Value: Single): Single;
- function ImageMitchellFilter(Value: Single): Single;
- procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
- procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
- procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
- procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
- procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
- procedure ImageAlphaTopLeftPointColorTransparent
- (var AColor: TIntermediateFormat);
- procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
- procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
- procedure ImageAlphaBottomRightPointColorTransparent
- (var AColor: TIntermediateFormat);
- procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer;
- ASrcColorFormat, ADstColorFormat: Cardinal;
- ASrcDataType, ADstDataType: Cardinal; AWidth, AHeight: Integer);
- procedure RescaleImage(const ASrc: Pointer; const ADst: Pointer;
- AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
- ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
- procedure Build2DMipmap(const ASrc: Pointer; const ADst: TPointerArray;
- AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
- ASrcWidth, ASrcHeight: Integer);
- procedure AlphaGammaBrightCorrection(const ASrc: Pointer;
- AColorFormat: Cardinal; ADataType: Cardinal; ASrcWidth, ASrcHeight: Integer;
- anAlphaProc: TImageAlphaProc; ABrightness: Single; AGamma: Single);
- // Converts a string into color
- function StringToColorAdvancedSafe(const Str: string;
- const Default: TColor): TColor;
- // Converts a string into color
- function TryStringToColorAdvanced(const Str: string;
- var OutColor: TColor): Boolean;
- // Converts a string into color
- function StringToColorAdvanced(const Str: string): TColor;
- (* Number of pixels per logical inch along the screen width for the device.
- Under Win32 awaits a HDC and returns its LOGPIXELSX. *)
- function GetDeviceLogicalPixelsX(device: HDC): Integer;
- // Number of bits per pixel for the current desktop resolution.
- function GetCurrentColorDepth: Integer;
- // Returns the number of color bits associated to the given pixel format.
- function PixelFormatToColorBits(aPixelFormat: TPixelFormat): Integer;
- // Returns the bitmap's scanline for the specified row.
- function BitmapScanLine(aBitmap: TBitmap; aRow: Integer): Pointer;
- // Returns the number of CPU cycles since startup. Use the similarly named CPU instruction.
- function GLOKMessageBox(const Text, Caption: string): Integer;
- procedure GLLoadBitmapFromInstance(Instance: LongInt; ABitmap: TBitmap;
- const AName: string);
- // Pops up a simple dialog with msg and an Ok button.
- procedure InformationDlg(const msg: string);
- (* Pops up a simple question dialog with msg and yes/no buttons.
- Returns True if answer was "yes". *)
- function QuestionDlg(const msg: string): Boolean;
- // Posp a simple dialog with a string input.
- function InputDlg(const aCaption, aPrompt, aDefault: string): string;
- // Pops up a simple save picture dialog.
- function SavePictureDialog(var aFileName: string;
- const aTitle: string = ''): Boolean;
- // Pops up a simple open picture dialog.
- function OpenPictureDialog(var aFileName: string;
- const aTitle: string = ''): Boolean;
- implementation // -------------------------------------------------------------
- const
- cSuperBlack: TIntermediateFormat = (R: 0.0; G: 0.0; B: 0.0; A: 0.0);
- type
- TConvertToImfProc = procedure(ASource: Pointer;
- ADest: PIntermediateFormatArray; AColorFormat: Cardinal;
- AWidth, AHeight: Integer);
- TConvertFromInfProc = procedure(ASource: PIntermediateFormatArray;
- ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- TDeviceCapabilities = record
- Xdpi, Ydpi: Integer; // Number of pixels per logical inch.
- Depth: Integer; // The bit depth.
- NumColors: Integer; // Number of entries in the device's color table.
- end;
- //----------------------------------------------------------------------------
- function GLOKMessageBox(const Text, Caption: string): Integer;
- begin
- Application.ProcessMessages;
- // in vcl was Result := Application.MessageBox(PChar(Text), PChar(Caption), MB_OK);
- Result := MB_OK;
- end;
- procedure GLLoadBitmapFromInstance(Instance: LongInt; ABitmap: TBitmap;
- const AName: string);
- begin
- //in vcl was ABitmap.Handle := LoadBitmap(Instance, PChar(AName));
- Instance := LoadBitmap(Instance, PChar(AName));
- end;
- procedure Swap(var A, B: Integer); inline;
- var
- C: Integer;
- begin
- C := A;
- A := B;
- B := C;
- end;
- // ------------------------------ OpenGL format image to RGBA Float
- procedure UnsupportedToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
- AColorFormat: Cardinal; AWidth, AHeight: Integer);
- begin
- raise EGLImageUtils.Create('Unimplemented type of conversion');
- end;
- procedure UbyteToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
- AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^;
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- // {$I ImgUtilCaseGL2Imf.inc}
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure Ubyte332ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- c0, c1, c2, c3: Byte;
- n: Integer;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := $E0 and c0;
- c2 := $E0 and (c0 shl 3);
- c3 := $C0 and (c0 shl 6);
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- end;
- GL_BGR:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure Ubyte233RToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- c0, c1, c2, c3: Byte;
- n: Integer;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c3 := $E0 and c0;
- c2 := $E0 and (c0 shl 3);
- c1 := $C0 and (c0 shl 6);
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- end;
- GL_BGR:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ByteToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PShortInt;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^;
- Inc(pSource);
- end;
- begin
- pSource := PShortInt(ASource);
- case AColorFormat of
- //{$I ImgUtilCaseGL2Imf.inc}
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PWord;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^ / $100;
- Inc(pSource);
- end;
- begin
- pSource := PWord(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ShortToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PSmallInt;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^ / $100;
- Inc(pSource);
- end;
- begin
- pSource := PSmallInt(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UIntToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PLongWord;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^ / $1000000;
- Inc(pSource);
- end;
- begin
- pSource := PLongWord(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure IntToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PLongInt;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^ / $1000000;
- Inc(pSource);
- end;
- begin
- pSource := PLongInt(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure FloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PSingle;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := pSource^ * 255.0;
- Inc(pSource);
- end;
- begin
- pSource := PSingle(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure HalfFloatToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PHalfFloat;
- n: Integer;
- c0: Single;
- function GetChannel: Single;
- begin
- Result := HalfToFloat(pSource^) * 255.0;
- Inc(pSource);
- end;
- begin
- pSource := PHalfFloat(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := 255.0;
- end;
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].B := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].R := GetChannel;
- ADest[n].A := GetChannel;
- end;
- GL_ALPHA, GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := GetChannel;
- end;
- GL_LUMINANCE, GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := 255.0;
- end;
- GL_LUMINANCE_ALPHA, GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := GetChannel;
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- c0 := GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c0;
- ADest[n].B := c0;
- ADest[n].A := c0;
- end;
- GL_RED, GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := 0;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_GREEN, GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- GL_BLUE, GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := 0;
- ADest[n].G := 0;
- ADest[n].B := GetChannel;
- ADest[n].A := 255;
- end;
- GL_RG, GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- ADest[n].R := GetChannel;
- ADest[n].G := GetChannel;
- ADest[n].B := 0;
- ADest[n].A := 255;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UInt8888ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- n: Integer;
- c0, c1, c2, c3: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- Inc(pSource);
- c1 := pSource^;
- Inc(pSource);
- c2 := pSource^;
- Inc(pSource);
- c3 := pSource^;
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c1;
- ADest[n].B := c2;
- ADest[n].A := c3;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c0;
- ADest[n].G := c1;
- ADest[n].R := c2;
- ADest[n].A := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UInt8888RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray;
- AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- n: Integer;
- c0, c1, c2, c3: Byte;
- procedure GetChannel;
- begin
- c3 := pSource^;
- Inc(pSource);
- c2 := pSource^;
- Inc(pSource);
- c1 := pSource^;
- Inc(pSource);
- c0 := pSource^;
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c0;
- ADest[n].G := c1;
- ADest[n].B := c2;
- ADest[n].A := c3;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c0;
- ADest[n].G := c1;
- ADest[n].R := c2;
- ADest[n].A := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort4444ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- n: Integer;
- c0, c1, c2, c3, c4: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c3 := $F0 and (c0 shl 4);
- c4 := $F0 and c0;
- Inc(pSource);
- c0 := pSource^;
- c1 := $F0 and (c0 shl 4);
- c2 := $F0 and c0;
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort4444RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PByte;
- n: Integer;
- c0, c1, c2, c3, c4: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := $F0 and (c0 shl 4);
- c2 := $F0 and c0;
- Inc(pSource);
- c0 := pSource^;
- c3 := $F0 and (c0 shl 4);
- c4 := $F0 and c0;
- Inc(pSource);
- end;
- begin
- pSource := PByte(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort565ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PWord;
- n: Integer;
- c0: Word;
- c1, c2, c3: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c3 := (c0 and $001F) shl 3;
- c2 := (c0 and $07E0) shr 3;
- c1 := (c0 and $F800) shr 8;
- Inc(pSource);
- end;
- begin
- pSource := PWord(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort565RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PWord;
- n: Integer;
- c0: Word;
- c1, c2, c3: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := (c0 and $001F) shl 3;
- c2 := (c0 and $07E0) shr 3;
- c3 := (c0 and $F800) shr 8;
- Inc(pSource);
- end;
- begin
- pSource := PWord(ASource);
- case AColorFormat of
- GL_RGB, GL_RGB_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- end;
- GL_BGR, GL_BGR_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort5551ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PWord;
- n: Integer;
- c0: Word;
- c1, c2, c3, c4: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c4 := (c0 and $001F) shl 3;
- c3 := (c0 and $03E0) shr 2;
- c2 := (c0 and $7C00) shr 7;
- c1 := (c0 and $8000) shr 8;
- Inc(pSource);
- end;
- begin
- pSource := PWord(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UShort5551RevToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PWord;
- n: Integer;
- c0: Word;
- c1, c2, c3, c4: Byte;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := (c0 and $001F) shl 3;
- c2 := (c0 and $03E0) shr 2;
- c3 := (c0 and $7C00) shr 7;
- c4 := (c0 and $8000) shr 8;
- Inc(pSource);
- end;
- begin
- pSource := PWord(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1;
- ADest[n].G := c2;
- ADest[n].B := c3;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1;
- ADest[n].G := c2;
- ADest[n].R := c3;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UInt_10_10_10_2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PLongWord;
- n: Integer;
- c0: LongWord;
- c1, c2, c3, c4: Word;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := (c0 and $000003FF) shl 6;
- c2 := (c0 and $000FFC00) shr 4;
- c3 := (c0 and $3FF00000) shr 14;
- c4 := (c0 and $C0000000) shr 16;
- Inc(pSource);
- end;
- begin
- pSource := PLongWord(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1 / $100;
- ADest[n].G := c2 / $100;
- ADest[n].B := c3 / $100;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1 / $100;
- ADest[n].G := c2 / $100;
- ADest[n].R := c3 / $100;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure UInt_10_10_10_2_Rev_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pSource: PLongWord;
- n: Integer;
- c0: LongWord;
- c1, c2, c3, c4: Word;
- procedure GetChannel;
- begin
- c0 := pSource^;
- c1 := (c0 and $000003FF) shl 6;
- c2 := (c0 and $000FFC00) shr 4;
- c3 := (c0 and $3FF00000) shr 14;
- c4 := (c0 and $C0000000) shr 16;
- Inc(pSource);
- end;
- begin
- pSource := PLongWord(ASource);
- case AColorFormat of
- GL_RGBA, GL_RGBA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].R := c1 / $100;
- ADest[n].G := c2 / $100;
- ADest[n].B := c3 / $100;
- ADest[n].A := c4;
- end;
- GL_BGRA, GL_BGRA_INTEGER:
- for n := 0 to AWidth * AHeight - 1 do
- begin
- GetChannel;
- ADest[n].B := c1 / $100;
- ADest[n].G := c2 / $100;
- ADest[n].R := c3 / $100;
- ADest[n].A := c4;
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
-
- // ------------------------------ Decompression
- procedure DecodeColor565(col: Word; out R, G, B: Byte);
- begin
- R := col and $1F;
- G := (col shr 5) and $3F;
- B := (col shr 11) and $1F;
- end;
- procedure DXT1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, k, select, offset: Integer;
- col0, col1: Word;
- colors: TU48BitBlock;
- bitmask: Cardinal;
- temp: PGLubyte;
- r0, g0, b0, r1, g1, b1: Byte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- col0 := PWord(temp)^;
- Inc(temp, 2);
- col1 := PWord(temp)^;
- Inc(temp, 2);
- bitmask := PCardinal(temp)^;
- Inc(temp, 4);
- DecodeColor565(col0, r0, g0, b0);
- DecodeColor565(col1, r1, g1, b1);
- colors[0][0] := r0 shl 3;
- colors[0][1] := g0 shl 2;
- colors[0][2] := b0 shl 3;
- colors[0][3] := $FF;
- colors[1][0] := r1 shl 3;
- colors[1][1] := g1 shl 2;
- colors[1][2] := b1 shl 3;
- colors[1][3] := $FF;
- if col0 > col1 then
- begin
- colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
- colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
- colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
- colors[2][3] := $FF;
- colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
- colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
- colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
- colors[3][3] := $FF;
- end
- else
- begin
- colors[2][0] := (colors[0][0] + colors[1][0]) div 2;
- colors[2][1] := (colors[0][1] + colors[1][1]) div 2;
- colors[2][2] := (colors[0][2] + colors[1][2]) div 2;
- colors[2][3] := $FF;
- colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
- colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
- colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
- colors[3][3] := 0;
- end;
- k := 0;
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- select := (bitmask and (3 shl (k * 2))) shr (k * 2);
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].B := colors[select][0];
- ADest[offset].G := colors[select][1];
- ADest[offset].R := colors[select][2];
- ADest[offset].A := colors[select][3];
- end;
- Inc(k);
- end;
- end;
- end;
- end;
- end;
- procedure DXT3_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, k, select: Integer;
- col0, col1, wrd: Word;
- colors: TU48BitBlock;
- bitmask, offset: Cardinal;
- temp: PGLubyte;
- r0, g0, b0, r1, g1, b1: Byte;
- alpha: array [0 .. 3] of Word;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- alpha[0] := PWord(temp)^;
- Inc(temp, 2);
- alpha[1] := PWord(temp)^;
- Inc(temp, 2);
- alpha[2] := PWord(temp)^;
- Inc(temp, 2);
- alpha[3] := PWord(temp)^;
- Inc(temp, 2);
- col0 := PWord(temp)^;
- Inc(temp, 2);
- col1 := PWord(temp)^;
- Inc(temp, 2);
- bitmask := PCardinal(temp)^;
- Inc(temp, 4);
- DecodeColor565(col0, r0, g0, b0);
- DecodeColor565(col1, r1, g1, b1);
- colors[0][0] := r0 shl 3;
- colors[0][1] := g0 shl 2;
- colors[0][2] := b0 shl 3;
- colors[0][3] := $FF;
- colors[1][0] := r1 shl 3;
- colors[1][1] := g1 shl 2;
- colors[1][2] := b1 shl 3;
- colors[1][3] := $FF;
- colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
- colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
- colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
- colors[2][3] := $FF;
- colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
- colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
- colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
- colors[3][3] := $FF;
- k := 0;
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- select := (bitmask and (3 shl (k * 2))) shr (k * 2);
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].B := colors[select][0];
- ADest[offset].G := colors[select][1];
- ADest[offset].R := colors[select][2];
- ADest[offset].A := colors[select][3];
- end;
- Inc(k);
- end;
- end;
- for j := 0 to 3 do
- begin
- wrd := alpha[j];
- for i := 0 to 3 do
- begin
- if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- r0 := wrd and $0F;
- ADest[offset].A := r0 or (r0 shl 4);
- end;
- wrd := wrd shr 4;
- end;
- end;
- end;
- end;
- end;
- procedure DXT5_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, k, select, offset: Integer;
- col0, col1: Word;
- colors: TU48BitBlock;
- bits, bitmask: Cardinal;
- temp, alphamask: PGLubyte;
- r0, g0, b0, r1, g1, b1: Byte;
- alphas: array [0 .. 7] of Byte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- alphas[0] := temp^;
- Inc(temp);
- alphas[1] := temp^;
- Inc(temp);
- alphamask := temp;
- Inc(temp, 6);
- col0 := PWord(temp)^;
- Inc(temp, 2);
- col1 := PWord(temp)^;
- Inc(temp, 2);
- bitmask := PCardinal(temp)^;
- Inc(temp, 4);
- DecodeColor565(col0, r0, g0, b0);
- DecodeColor565(col1, r1, g1, b1);
- colors[0][0] := r0 shl 3;
- colors[0][1] := g0 shl 2;
- colors[0][2] := b0 shl 3;
- colors[0][3] := $FF;
- colors[1][0] := r1 shl 3;
- colors[1][1] := g1 shl 2;
- colors[1][2] := b1 shl 3;
- colors[1][3] := $FF;
- colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3;
- colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3;
- colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3;
- colors[2][3] := $FF;
- colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3;
- colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3;
- colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3;
- colors[3][3] := $FF;
- k := 0;
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- select := (bitmask and (3 shl (k * 2))) shr (k * 2);
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].B := colors[select][0];
- ADest[offset].G := colors[select][1];
- ADest[offset].R := colors[select][2];
- end;
- Inc(k);
- end;
- end;
- if (alphas[0] > alphas[1]) then
- begin
- alphas[2] := (6 * alphas[0] + 1 * alphas[1] + 3) div 7;
- alphas[3] := (5 * alphas[0] + 2 * alphas[1] + 3) div 7;
- alphas[4] := (4 * alphas[0] + 3 * alphas[1] + 3) div 7;
- alphas[5] := (3 * alphas[0] + 4 * alphas[1] + 3) div 7;
- alphas[6] := (2 * alphas[0] + 5 * alphas[1] + 3) div 7;
- alphas[7] := (1 * alphas[0] + 6 * alphas[1] + 3) div 7;
- end
- else
- begin
- alphas[2] := (4 * alphas[0] + 1 * alphas[1] + 2) div 5;
- alphas[3] := (3 * alphas[0] + 2 * alphas[1] + 2) div 5;
- alphas[4] := (2 * alphas[0] + 3 * alphas[1] + 2) div 5;
- alphas[5] := (1 * alphas[0] + 4 * alphas[1] + 2) div 5;
- alphas[6] := 0;
- alphas[7] := $FF;
- end;
- bits := PCardinal(alphamask)^;
- for j := 0 to 1 do
- begin
- for i := 0 to 3 do
- begin
- if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].A := alphas[bits and 7];
- end;
- bits := bits shr 3;
- end;
- end;
- Inc(alphamask, 3);
- bits := PCardinal(alphamask)^;
- for j := 2 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if (((4 * x + i) < AWidth) and ((4 * y + j) < AHeight)) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].A := alphas[bits and 7];
- end;
- bits := bits shr 3;
- end;
- end;
- end;
- end;
- end;
- procedure Decode48BitBlock(ACode: Int64; out ABlock: TU48BitBlock); overload;
- var
- x, y: Byte;
- begin
- for y := 0 to 3 do
- for x := 0 to 3 do
- begin
- ABlock[x][y] := Byte(ACode and $03);
- ACode := ACode shr 2;
- end;
- end;
- procedure Decode48BitBlock(ACode: Int64; out ABlock: T48BitBlock); overload;
- var
- x, y: Byte;
- begin
- for y := 0 to 3 do
- for x := 0 to 3 do
- begin
- ABlock[x][y] := SmallInt(ACode and $03);
- ACode := ACode shr 2;
- end;
- end;
- procedure LATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- LUM0, LUM1: Byte;
- lum: Single;
- colors: TU48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- LUM0 := temp^;
- Inc(temp);
- LUM1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := colors[j, i];
- ADest[offset].R := lum;
- ADest[offset].G := lum;
- ADest[offset].B := lum;
- ADest[offset].A := 255.0;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure SLATC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- LUM0, LUM1: SmallInt;
- lum: Single;
- colors: T48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- LUM0 := PSmallInt(temp)^;
- Inc(temp);
- LUM1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := 2 * colors[j, i];
- ADest[offset].R := lum;
- ADest[offset].G := lum;
- ADest[offset].B := lum;
- ADest[offset].A := 127.0;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure LATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- LUM0, LUM1: Byte;
- lum: Single;
- colors: TU48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- LUM0 := temp^;
- Inc(temp);
- LUM1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := colors[j][i];
- ADest[offset].R := lum;
- ADest[offset].G := lum;
- ADest[offset].B := lum;
- end;
- end; // for i
- end; // for j
- LUM0 := temp^;
- Inc(temp);
- LUM1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- ADest[((4 * y + j) * AWidth + (4 * x + i))].A := colors[j][i];
- end;
- end;
- end;
- end;
- end;
- procedure SLATC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- LUM0, LUM1: SmallInt;
- lum: Single;
- colors: T48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- LUM0 := PSmallInt(temp)^;
- Inc(temp);
- LUM1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := 2 * colors[j][i];
- ADest[offset].R := lum;
- ADest[offset].G := lum;
- ADest[offset].B := lum;
- end;
- end;
- end;
- LUM0 := PSmallInt(temp)^;
- Inc(temp);
- LUM1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if LUM0 > LUM1 then
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (6 * LUM0 + LUM1) div 7;
- 3:
- colors[j, i] := (5 * LUM0 + 2 * LUM1) div 7;
- 4:
- colors[j, i] := (4 * LUM0 + 3 * LUM1) div 7;
- 5:
- colors[j, i] := (3 * LUM0 + 4 * LUM1) div 7;
- 6:
- colors[j, i] := (2 * LUM0 + 5 * LUM1) div 7;
- 7:
- colors[j, i] := (LUM0 + 6 * LUM1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := LUM0;
- 1:
- colors[j, i] := LUM1;
- 2:
- colors[j, i] := (4 * LUM0 + LUM1) div 5;
- 3:
- colors[j, i] := (3 * LUM0 + 2 * LUM1) div 5;
- 4:
- colors[j, i] := (2 * LUM0 + 3 * LUM1) div 5;
- 5:
- colors[j, i] := (LUM0 + 4 * LUM1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- ADest[((4 * y + j) * AWidth + (4 * x + i))].A := 2 * colors[j][i];
- end;
- end;
- end;
- end;
- end;
- end;
- procedure RGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- RED0, RED1: Byte;
- lum: Single;
- colors: TU48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- RED0 := temp^;
- Inc(temp);
- RED1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i)) * 4;
- lum := colors[j][i];
- ADest[offset].R := lum;
- ADest[offset].G := 0.0;
- ADest[offset].B := 0.0;
- ADest[offset].A := 255.0;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure SRGTC1_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- RED0, RED1: SmallInt;
- lum: Single;
- colors: T48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- RED0 := PSmallInt(temp)^;
- Inc(temp);
- RED1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := 2 * colors[j][i];
- ADest[offset].R := lum;
- ADest[offset].G := 0.0;
- ADest[offset].B := 0.0;
- ADest[offset].A := 127.0;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure RGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- RED0, RED1: Byte;
- colors: TU48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- RED0 := temp^;
- Inc(temp);
- RED1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].R := colors[j][i];
- ADest[offset].B := 0.0;
- end;
- end;
- end;
- RED0 := temp^;
- Inc(temp);
- RED1 := temp^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := 0;
- 7:
- colors[j, i] := 255;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- ADest[offset].G := colors[j][i];
- ADest[offset].A := 255.0;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure SRGTC2_ToImf(ASource: Pointer; ADest: PIntermediateFormatArray; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- x, y, i, j, offset: Integer;
- RED0, RED1: SmallInt;
- lum: Single;
- colors: T48BitBlock;
- bitmask: Int64;
- temp: PGLubyte;
- begin
- temp := PGLubyte(ASource);
- for y := 0 to (AHeight div 4) - 1 do
- begin
- for x := 0 to (AWidth div 4) - 1 do
- begin
- RED0 := PSmallInt(temp)^;
- Inc(temp);
- RED1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := 2 * colors[j][i];
- ADest[offset].R := lum;
- ADest[offset].B := 0.0;
- end;
- end;
- end;
- RED0 := PSmallInt(temp)^;
- Inc(temp);
- RED1 := PSmallInt(temp)^;
- Inc(temp);
- bitmask := PInt64(temp)^;
- Inc(temp, 6);
- Decode48BitBlock(bitmask, colors);
- for j := 0 to 3 do
- begin
- for i := 0 to 3 do
- begin
- if RED0 > RED1 then
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (6 * RED0 + RED1) div 7;
- 3:
- colors[j, i] := (5 * RED0 + 2 * RED1) div 7;
- 4:
- colors[j, i] := (4 * RED0 + 3 * RED1) div 7;
- 5:
- colors[j, i] := (3 * RED0 + 4 * RED1) div 7;
- 6:
- colors[j, i] := (2 * RED0 + 5 * RED1) div 7;
- 7:
- colors[j, i] := (RED0 + 6 * RED1) div 7;
- end
- else
- case colors[j, i] of
- 0:
- colors[j, i] := RED0;
- 1:
- colors[j, i] := RED1;
- 2:
- colors[j, i] := (4 * RED0 + RED1) div 5;
- 3:
- colors[j, i] := (3 * RED0 + 2 * RED1) div 5;
- 4:
- colors[j, i] := (2 * RED0 + 3 * RED1) div 5;
- 5:
- colors[j, i] := (RED0 + 4 * RED1) div 5;
- 6:
- colors[j, i] := -127;
- 7:
- colors[j, i] := 127;
- end;
- if ((4 * x + i) < AWidth) and ((4 * y + j) < AHeight) then
- begin
- offset := ((4 * y + j) * AWidth + (4 * x + i));
- lum := 2 * colors[j][i];
- ADest[offset].G := lum;
- ADest[offset].A := 127.0;
- end;
- end;
- end;
- end;
- end;
- end;
- // ------------------------------ RGBA Float to OpenGL format image
- procedure UnsupportedFromImf(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- begin
- raise EGLImageUtils.Create('Unimplemented type of conversion');
- end;
- procedure ImfToUbyte(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PByte;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, 0.0, 255.0));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PByte(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToByte(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PShortInt;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, -127.0, 127.0));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PShortInt(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToUShort(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PWord;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, 0.0, 65535.0));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PWord(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToShort(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PSmallInt;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, -32767.0, 32767.0));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PSmallInt(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToUInt(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PLongWord;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, 0.0, $FFFFFFFF));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PLongWord(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToInt(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- var
- pDest: PLongInt;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := Trunc(ClampValue(AValue, -$7FFFFFFF, $7FFFFFFF));
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := Trunc(AValue);
- Inc(pDest);
- end;
- begin
- pDest := PLongInt(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToFloat(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- const
- cInv255 = 1.0 / 255.0;
- var
- pDest: PSingle;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := AValue * cInv255;
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := AValue * cInv255;
- Inc(pDest);
- end;
- begin
- pDest := PSingle(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- procedure ImfToHalf(ASource: PIntermediateFormatArray; ADest: Pointer; AColorFormat: Cardinal; AWidth, AHeight: Integer);
- const
- cInv255 = 1.0 / 255.0;
- var
- pDest: PHalfFloat;
- n: Integer;
- procedure SetChannel(AValue: Single);
- begin
- pDest^ := FloatToHalf(AValue * cInv255);
- Inc(pDest);
- end;
- procedure SetChannelI(AValue: Single);
- begin
- pDest^ := FloatToHalf(AValue * cInv255);
- Inc(pDest);
- end;
- begin
- pDest := PHalfFloat(ADest);
- case AColorFormat of
- GL_RGB:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- end;
- GL_RGB_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- end;
- GL_BGR:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- end;
- GL_BGR_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- end;
- GL_RGBA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].A);
- end;
- GL_RGBA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].A);
- end;
- GL_BGRA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- SetChannel(ASource[n].G);
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].A);
- end;
- GL_BGRA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- SetChannelI(ASource[n].G);
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].A);
- end;
- GL_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].A);
- end;
- GL_ALPHA_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].A);
- end;
- GL_LUMINANCE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_LUMINANCE_ALPHA:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannel(ASource[n].A);
- end;
- GL_LUMINANCE_ALPHA_INTEGER_EXT:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- SetChannelI(ASource[n].A);
- end;
- GL_INTENSITY:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R + ASource[n].G + ASource[n].B / 3.0);
- end;
- GL_RED:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- end;
- GL_RED_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- end;
- GL_GREEN:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].G);
- end;
- GL_GREEN_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].G);
- end;
- GL_BLUE:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].B);
- end;
- GL_BLUE_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].B);
- end;
- GL_RG:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannel(ASource[n].R);
- SetChannel(ASource[n].G);
- end;
- GL_RG_INTEGER:
- for n := 0 to AWidth*AHeight-1 do
- begin
- SetChannelI(ASource[n].R);
- SetChannelI(ASource[n].G);
- end;
- else
- raise EGLImageUtils.Create(strInvalidType);
- end;
- end;
- // ------------------------------ Compression
- { function FloatTo565(const AColor: TIntermediateFormat): Integer;
- var
- r, g, b: Integer;
- begin
- // get the components in the correct range
- r := Round( 31.0*AColor.R, 31 );
- g := Round( 63.0*AColor.G, 63 );
- b := Round( 31.0*AColor.B, 31 );
- // pack into a single value
- Result := ( r shl 11 ) or ( g shl 5 ) or b;
- end;
- procedure WriteColourBlock(a, b: Integer; const indices: PByteArray; out block: TU48BitBlock);
- var
- I, J: Byte;
- begin
- // write the endpoints
- block[0][0] := a and $ff;
- block[0][1] := a shr 8;
- block[0][2] := b and $ff;
- block[0][3] := b shr 8;
- // write the indices
- for i := 0 to 3 do
- begin
- J := 4*i;
- block[1][i] = indices[J+0] or ( indices[J+1] shl 2 ) or ( indices[J+2] shl 4 ) or ( indices[J+3] shl 6 );
- end;
- end;
- procedure WriteColourBlock3(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
- var
- i, a, b: Integer;
- remapped: array[0..15] of Byte;
- begin
- // get the packed values
- a := FloatTo565( start );
- b := FloatTo565( end_ );
- // remap the indices
- if a <= b then
- begin
- // use the indices directly
- for i := 0 to 15 do
- remapped[i] := indices[i];
- end
- else
- begin
- // swap a and b
- Swap( a, b );
- for i := 0 to 15 do
- begin
- if indices[i] = 0 then
- remapped[i] := 1
- else if indices[i] = 1 then
- remapped[i] := 0
- else
- remapped[i] := indices[i];
- end;
- end;
- // write the block
- WriteColourBlock( a, b, remapped, block );
- end;
- procedure WriteColourBlock4(start, end_: TIntermediateFormat; const indices: PByteArray; out block: TU48BitBlock);
- var
- i, a, b: Integer;
- remapped: array[0..15] of Byte;
- begin
- // get the packed values
- a := FloatTo565( start );
- b := FloatTo565( end_ );
- // remap the indices
- if a < b then
- begin
- // swap a and b
- Swap( a, b );
- for i := 0 to 15 do
- remapped[i] := ( indices[i] xor $01 ) and $03;
- end
- else if a = b then
- begin
- // use index 0
- for i := 0 to 15 do
- remapped[i] := 0;
- end
- else
- begin
- // use the indices directly
- for i := 0 to 15 do
- remapped[i] := indices[i];
- end;
- // write the block
- WriteColourBlock( a, b, remapped, block );
- end; }
- // ------------------------------ Image filters
- function ImageBoxFilter(Value: Single): Single;
- begin
- if (Value > -0.5) and (Value <= 0.5) then
- Result := 1.0
- else
- Result := 0.0;
- end;
- function ImageTriangleFilter(Value: Single): Single;
- begin
- if Value < 0.0 then
- Value := -Value;
- if Value < 1.0 then
- Result := 1.0 - Value
- else
- Result := 0.0;
- end;
- function ImageHermiteFilter(Value: Single): Single;
- begin
- if Value < 0.0 then
- Value := -Value;
- if Value < 1 then
- Result := (2 * Value - 3) * Sqr(Value) + 1
- else
- Result := 0;
- end;
- function ImageBellFilter(Value: Single): Single;
- begin
- if Value < 0.0 then
- Value := -Value;
- if Value < 0.5 then
- Result := 0.75 - Sqr(Value)
- else if Value < 1.5 then
- begin
- Value := Value - 1.5;
- Result := 0.5 * Sqr(Value);
- end
- else
- Result := 0.0;
- end;
- function ImageSplineFilter(Value: Single): Single;
- var
- temp: Single;
- begin
- if Value < 0.0 then
- Value := -Value;
- if Value < 1.0 then
- begin
- temp := Sqr(Value);
- Result := 0.5 * temp * Value - temp + 2.0 / 3.0;
- end
- else if Value < 2.0 then
- begin
- Value := 2.0 - Value;
- Result := Sqr(Value) * Value / 6.0;
- end
- else
- Result := 0.0;
- end;
- function ImageLanczos3Filter(Value: Single): Single;
- const
- Radius = 3.0;
- begin
- Result := 1;
- if Value = 0 then
- Exit;
- if Value < 0.0 then
- Value := -Value;
- if Value < Radius then
- begin
- Value := Value * pi;
- Result := Radius * Sin(Value) * Sin(Value / Radius) / (Value * Value);
- end
- else
- Result := 0.0;
- end;
- function ImageMitchellFilter(Value: Single): Single;
- const
- B = 1.0 / 3.0;
- C = 1.0 / 3.0;
- var
- temp: Single;
- begin
- if Value < 0.0 then
- Value := -Value;
- temp := Sqr(Value);
- if Value < 1.0 then
- begin
- 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));
- Result := Value / 6.0;
- end
- else if Value < 2.0 then
- begin
- 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));
- Result := Value / 6.0;
- end
- else
- Result := 0.0;
- end;
- const cInvThree = 1.0/3.0;
- procedure ImageAlphaFromIntensity(var AColor: TIntermediateFormat);
- begin
- AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
- end;
- procedure ImageAlphaSuperBlackTransparent(var AColor: TIntermediateFormat);
- begin
- if (AColor.R = 0.0) and (AColor.B = 0.0) and (AColor.G = 0.0) then
- AColor.A := 0.0
- else
- AColor.A := 255.0;
- end;
- procedure ImageAlphaLuminance(var AColor: TIntermediateFormat);
- begin
- AColor.A := (AColor.R + AColor.B + AColor.G) * cInvThree;
- AColor.R := AColor.A;
- AColor.G := AColor.A;
- AColor.B := AColor.A;
- end;
- procedure ImageAlphaLuminanceSqrt(var AColor: TIntermediateFormat);
- begin
- AColor.A := Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
- end;
- procedure ImageAlphaOpaque(var AColor: TIntermediateFormat);
- begin
- AColor.A := 255.0;
- end;
- var
- vTopLeftColor: TIntermediateFormat;
- procedure ImageAlphaTopLeftPointColorTransparent(var AColor: TIntermediateFormat);
- begin
- if CompareMem(@AColor, @vTopLeftColor, 3*SizeOf(Single)) then
- AColor.A := 0.0;
- end;
- procedure ImageAlphaInverseLuminance(var AColor: TIntermediateFormat);
- begin
- AColor.A := 255.0 - (AColor.R + AColor.B + AColor.G) * cInvThree;
- AColor.R := AColor.A;
- AColor.G := AColor.A;
- AColor.B := AColor.A;
- end;
- procedure ImageAlphaInverseLuminanceSqrt(var AColor: TIntermediateFormat);
- begin
- AColor.A := 255.0 - Sqrt((AColor.R + AColor.B + AColor.G) * cInvThree);
- end;
- var
- vBottomRightColor: TIntermediateFormat;
- procedure ImageAlphaBottomRightPointColorTransparent(var AColor: TIntermediateFormat);
- begin
- if CompareMem(@AColor, @vBottomRightColor, 3*SizeOf(Single)) then
- AColor.A := 0.0;
- end;
- type
- // Contributor for a pixel
- TContributor = record
- pixel: Integer; // Source pixel
- weight: Single; // Pixel weight
- end;
- TContributorList = array [0 .. MaxInt div (2 * SizeOf(TContributor))] of TContributor;
- PContributorList = ^TContributorList;
- // List of source pixels contributing to a destination pixel
- TCList = record
- n: Integer;
- p: PContributorList;
- end;
- TCListList = array [0 .. MaxInt div (2 * SizeOf(TCList))] of TCList;
- PCListList = ^TCListList;
- // ------------------------------ Data type conversion table
- type
- TConvertTableRec = record
- type_: Cardinal;
- proc1: TConvertToImfProc;
- proc2: TConvertFromInfProc;
- end;
- const
- cConvertTable: array [0 .. 36] of TConvertTableRec = (
- (type_: GL_UNSIGNED_BYTE; proc1: UbyteToImf; proc2: ImfToUbyte),
- (type_: GL_UNSIGNED_BYTE_3_3_2; proc1: Ubyte332ToImf; proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_BYTE_2_3_3_REV; proc1: Ubyte233RToImf; proc2: UnsupportedFromImf),
- (type_: GL_BYTE; proc1: ByteToImf; proc2: ImfToByte),
- (type_: GL_UNSIGNED_SHORT; proc1: UShortToImf; proc2: ImfToUShort),
- (type_: GL_SHORT; proc1: ShortToImf; proc2: ImfToShort),
- (type_: GL_UNSIGNED_INT; proc1: UIntToImf; proc2: ImfToUInt),
- (type_: GL_INT; proc1: IntToImf; proc2: ImfToInt),
- (type_: GL_FLOAT; proc1: FloatToImf; proc2: ImfToFloat),
- (type_: GL_HALF_FLOAT; proc1: HalfFloatToImf; proc2: ImfToHalf),
- (type_: GL_UNSIGNED_INT_8_8_8_8; proc1: UInt8888ToImf; proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_INT_8_8_8_8_REV; proc1: UInt8888RevToImf; proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_4_4_4_4; proc1: UShort4444ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_4_4_4_4_REV; proc1: UShort4444RevToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_5_6_5; proc1: UShort565ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_5_6_5_REV; proc1: UShort565RevToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_5_5_5_1; proc1: UShort5551ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_SHORT_1_5_5_5_REV; proc1: UShort5551RevToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_INT_10_10_10_2; proc1: UInt_10_10_10_2_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_UNSIGNED_INT_2_10_10_10_REV; proc1: UInt_10_10_10_2_Rev_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; proc1: DXT1_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; proc1: DXT1_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; proc1: DXT3_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; proc1: DXT5_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_LUMINANCE_LATC1_EXT; proc1: LATC1_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; proc1: SLATC1_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; proc1: LATC2_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; proc1: SLATC2_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_LUMINANCE_ALPHA_ARB; proc1: UnsupportedToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RED_RGTC1; proc1: RGTC1_ToImf; proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SIGNED_RED_RGTC1; proc1: SRGTC1_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_RG_RGTC2; proc1: RGTC2_ToImf;
- proc2: UnsupportedFromImf),
- (type_: GL_COMPRESSED_SIGNED_RG_RGTC2; proc1: SRGTC2_ToImf;
- proc2: UnsupportedFromImf));
- procedure ConvertImage(const ASrc: Pointer; const ADst: Pointer;
- ASrcColorFormat, ADstColorFormat: Cardinal;
- ASrcDataType, ADstDataType: Cardinal; AWidth, AHeight: Integer);
- var
- ConvertToIntermediateFormat: TConvertToImfProc;
- ConvertFromIntermediateFormat: TConvertFromInfProc;
- i, size: Integer;
- tempBuf: PIntermediateFormatArray;
- begin
- if AWidth < 1 then
- Exit;
- AHeight := MaxInteger(1, AHeight);
- // Allocate memory
- size := AWidth * AHeight * SizeOf(TIntermediateFormat);
- GetMem(tempBuf, size);
- FillChar(tempBuf^, size, $00);
- // Find function to convert external format to intermediate format
- ConvertToIntermediateFormat := UnsupportedToImf;
- for i := 0 to high(cConvertTable) do
- begin
- if ASrcDataType = cConvertTable[i].type_ then
- begin
- ConvertToIntermediateFormat := cConvertTable[i].proc1;
- break;
- end;
- end;
- try
- ConvertToIntermediateFormat(ASrc, tempBuf, ASrcColorFormat, AWidth,
- AHeight);
- except
- FreeMem(tempBuf);
- raise;
- end;
- // Find function to convert intermediate format to external format
- ConvertFromIntermediateFormat := UnsupportedFromImf;
- for i := 0 to high(cConvertTable) do
- begin
- if ADstDataType = cConvertTable[i].type_ then
- begin
- ConvertFromIntermediateFormat := cConvertTable[i].proc2;
- break;
- end;
- end;
- try
- ConvertFromIntermediateFormat(tempBuf, ADst, ADstColorFormat,
- AWidth, AHeight);
- except
- FreeMem(tempBuf);
- raise;
- end;
- FreeMem(tempBuf);
- end;
- procedure RescaleImage(const ASrc: Pointer; const ADst: Pointer;
- AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
- ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer);
- var
- ConvertToIntermediateFormat: TConvertToImfProc;
- ConvertFromIntermediateFormat: TConvertFromInfProc;
- i, j, k, n, size: Integer;
- tempBuf1, tempBuf2, SourceLine, DestLine: PIntermediateFormatArray;
- contrib: PCListList;
- xscale, yscale: Single; // Zoom scale factors
- width, fscale, weight: Single; // Filter calculation variables
- center: Single; // Filter calculation variables
- left, right: Integer; // Filter calculation variables
- color1, color2: TIntermediateFormat;
- begin
- if (ASrcWidth < 1) or (ADstWidth < 1) then
- Exit;
- ASrcHeight := MaxInteger(1, ASrcHeight);
- ADstHeight := MaxInteger(1, ADstHeight);
- // Allocate memory
- size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
- GetMem(tempBuf1, size);
- FillChar(tempBuf1^, size, $00);
- // Find function to convert external format to intermediate format
- ConvertToIntermediateFormat := UnsupportedToImf;
- for i := 0 to high(cConvertTable) do
- begin
- if ADataType = cConvertTable[i].type_ then
- begin
- ConvertToIntermediateFormat := cConvertTable[i].proc1;
- ConvertFromIntermediateFormat := cConvertTable[i].proc2;
- break;
- end;
- end;
- try
- ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
- ASrcHeight);
- except
- FreeMem(tempBuf1);
- raise;
- end;
- // Rescale
- if ASrcWidth = 1 then
- xscale := ADstWidth / ASrcWidth
- else
- xscale := (ADstWidth - 1) / (ASrcWidth - 1);
- if ASrcHeight = 1 then
- yscale := ADstHeight / ASrcHeight
- else
- yscale := (ADstHeight - 1) / (ASrcHeight - 1);
- // Pre-calculate filter contributions for a row
- GetMem(contrib, ADstWidth * SizeOf(TCList));
- // Horizontal sub-sampling
- // Scales from bigger to smaller width
- if xscale < 1.0 then
- begin
- width := vImageScaleFilterWidth / xscale;
- fscale := 1.0 / xscale;
- for i := 0 to ADstWidth - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
- center := i / xscale;
- left := floor(center - width);
- right := ceil(center + width);
- for j := left to right do
- begin
- weight := AFilter((center - j) / fscale) / fscale;
- if weight = 0.0 then
- continue;
- if (j < 0) then
- n := -j
- else if (j >= ASrcWidth) then
- n := ASrcWidth - j + ASrcWidth - 1
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end;
- end
- else
- // Horizontal super-sampling
- // Scales from smaller to bigger width
- begin
- for i := 0 to ADstWidth - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) *
- SizeOf(TContributor));
- center := i / xscale;
- left := floor(center - vImageScaleFilterWidth);
- right := ceil(center + vImageScaleFilterWidth);
- for j := left to right do
- begin
- weight := AFilter(center - j);
- if weight = 0.0 then
- continue;
- if (j < 0) then
- n := -j
- else if (j >= ASrcWidth) then
- n := ASrcWidth - j + ASrcWidth - 1
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end;
- end;
- size := ADstWidth * ASrcHeight * SizeOf(TIntermediateFormat);
- GetMem(tempBuf2, size);
- // Apply filter to sample horizontally from Src to Work
- for k := 0 to ASrcHeight - 1 do
- begin
- SourceLine := @tempBuf1[k * ASrcWidth];
- DestLine := @tempBuf2[k * ADstWidth];
- for i := 0 to ADstWidth - 1 do
- begin
- color1 := cSuperBlack;
- for j := 0 to contrib^[i].n - 1 do
- begin
- weight := contrib^[i].p^[j].weight;
- if weight = 0.0 then
- continue;
- color2 := SourceLine[contrib^[i].p^[j].pixel];
- color1.R := color1.R + color2.R * weight;
- color1.G := color1.G + color2.G * weight;
- color1.B := color1.B + color2.B * weight;
- color1.A := color1.A + color2.A * weight;
- end;
- // Set new pixel value
- DestLine[i] := color1;
- end;
- end;
- // Free the memory allocated for horizontal filter weights
- for i := 0 to ADstWidth - 1 do
- FreeMem(contrib^[i].p);
- FreeMem(contrib);
- // Pre-calculate filter contributions for a column
- GetMem(contrib, ADstHeight * SizeOf(TCList));
- // Vertical sub-sampling
- // Scales from bigger to smaller height
- if yscale < 1.0 then
- begin
- width := vImageScaleFilterWidth / yscale;
- fscale := 1.0 / yscale;
- for i := 0 to ADstHeight - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
- center := i / yscale;
- left := floor(center - width);
- right := ceil(center + width);
- for j := left to right do
- begin
- weight := AFilter((center - j) / fscale) / fscale;
- if weight = 0.0 then
- continue;
- if (j < 0) then
- n := -j
- else if (j >= ASrcHeight) then
- n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end
- end
- else
- // Vertical super-sampling
- // Scales from smaller to bigger height
- begin
- for i := 0 to ADstHeight - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(vImageScaleFilterWidth * 2.0 + 1) *
- SizeOf(TContributor));
- center := i / yscale;
- left := floor(center - vImageScaleFilterWidth);
- right := ceil(center + vImageScaleFilterWidth);
- for j := left to right do
- begin
- weight := AFilter(center - j);
- if weight = 0.0 then
- continue;
- if j < 0 then
- n := -j
- else if (j >= ASrcHeight) then
- n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end;
- end;
- size := ADstWidth * ADstHeight * SizeOf(TIntermediateFormat);
- ReallocMem(tempBuf1, size);
- // Apply filter to sample vertically from Work to Dst
- for k := 0 to ADstWidth - 1 do
- begin
- for i := 0 to ADstHeight - 1 do
- begin
- color1 := cSuperBlack;
- for j := 0 to contrib^[i].n - 1 do
- begin
- weight := contrib^[i].p^[j].weight;
- if weight = 0.0 then
- continue;
- color2 := tempBuf2[k + contrib^[i].p^[j].pixel * ADstWidth];
- color1.R := color1.R + color2.R * weight;
- color1.G := color1.G + color2.G * weight;
- color1.B := color1.B + color2.B * weight;
- color1.A := color1.A + color2.A * weight;
- end;
- tempBuf1[k + i * ADstWidth] := color1;
- end;
- end;
- // Free the memory allocated for vertical filter weights
- for i := 0 to ADstHeight - 1 do
- FreeMem(contrib^[i].p);
- FreeMem(contrib);
- FreeMem(tempBuf2);
- // Back to native image format
- try
- ConvertFromIntermediateFormat(tempBuf1, ADst, AColorFormat, ADstWidth,
- ADstHeight);
- except
- FreeMem(tempBuf1);
- raise;
- end;
- FreeMem(tempBuf1);
- end;
- procedure Div2(var Value: Integer); inline;
- begin
- Value := Value div 2;
- if Value = 0 then
- Value := 1;
- end;
- procedure Build2DMipmap(const ASrc: Pointer; const ADst: TPointerArray;
- AColorFormat: Cardinal; ADataType: Cardinal; AFilter: TImageFilterFunction;
- ASrcWidth, ASrcHeight: Integer);
- var
- ConvertToIntermediateFormat: TConvertToImfProc;
- ConvertFromIntermediateFormat: TConvertFromInfProc;
- ADstWidth, ADstHeight: Integer;
- i, j, k, n, size, level: Integer;
- tempBuf1, tempBuf2, storePtr, SourceLine, DestLine: PIntermediateFormatArray;
- contrib: PCListList;
- xscale, yscale: Single;
- width, fscale, weight: Single;
- center: Single;
- left, right: Integer;
- color1, color2: TIntermediateFormat;
- tempW, tempH: Integer;
- begin
- if ASrcWidth < 1 then
- Exit;
- ASrcHeight := MaxInteger(1, ASrcHeight);
- // Allocate memory
- tempW := ASrcWidth;
- tempH := ASrcHeight;
- size := 0;
- for level := 0 to High(ADst) + 1 do
- begin
- Inc(size, tempW * tempH * SizeOf(TIntermediateFormat));
- Div2(tempW);
- Div2(tempH);
- end;
- GetMem(tempBuf1, size);
- storePtr := tempBuf1;
- FillChar(tempBuf1^, size, $00);
- GetMem(tempBuf2, ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat));
- // Find function to convert external format to intermediate format
- ConvertToIntermediateFormat := UnsupportedToImf;
- ConvertFromIntermediateFormat := UnsupportedFromImf;
- for i := 0 to high(cConvertTable) do
- begin
- if ADataType = cConvertTable[i].type_ then
- begin
- ConvertToIntermediateFormat := cConvertTable[i].proc1;
- ConvertFromIntermediateFormat := cConvertTable[i].proc2;
- break;
- end;
- end;
- try
- ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
- ASrcHeight);
- except
- FreeMem(tempBuf1);
- raise;
- end;
- contrib := nil;
- tempW := ASrcWidth;
- tempH := ADstHeight;
- try
- // Downsampling
- for level := 0 to High(ADst) do
- begin
- ADstWidth := ASrcWidth;
- ADstHeight := ASrcHeight;
- Div2(ADstWidth);
- Div2(ADstHeight);
- xscale := MaxFloat((ADstWidth - 1) / (ASrcWidth - 1), 0.25);
- yscale := MaxFloat((ADstHeight - 1) / (ASrcHeight - 1), 0.25);
- // Pre-calculate filter contributions for a row
- ReallocMem(contrib, ADstWidth * SizeOf(TCList));
- // Horizontal sub-sampling
- // Scales from bigger to smaller width
- width := vImageScaleFilterWidth / xscale;
- fscale := 1.0 / xscale;
- for i := 0 to ADstWidth - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(width * 2.0 + 1.0) * SizeOf(TContributor));
- center := i / xscale;
- left := floor(center - width);
- right := ceil(center + width);
- for j := left to right do
- begin
- weight := AFilter((center - j) / fscale) / fscale;
- if weight = 0.0 then
- continue;
- if (j < 0) then
- n := -j
- else if (j >= ASrcWidth) then
- n := MaxInteger(ASrcWidth - j + ASrcWidth - 1, 0)
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end;
- // Apply filter to sample horizontally from Src to Work
- for k := 0 to ASrcHeight - 1 do
- begin
- SourceLine := @tempBuf1[k * ASrcWidth];
- DestLine := @tempBuf2[k * ADstWidth];
- for i := 0 to ADstWidth - 1 do
- begin
- color1 := cSuperBlack;
- for j := 0 to contrib^[i].n - 1 do
- begin
- weight := contrib^[i].p^[j].weight;
- if weight = 0.0 then
- continue;
- color2 := SourceLine[contrib^[i].p^[j].pixel];
- color1.R := color1.R + color2.R * weight;
- color1.G := color1.G + color2.G * weight;
- color1.B := color1.B + color2.B * weight;
- color1.A := color1.A + color2.A * weight;
- end;
- // Set new pixel value
- DestLine[i] := color1;
- end;
- end;
- // Free the memory allocated for horizontal filter weights
- for i := 0 to ADstWidth - 1 do
- FreeMem(contrib^[i].p);
- // Pre-calculate filter contributions for a column
- ReallocMem(contrib, ADstHeight * SizeOf(TCList));
- // Vertical sub-sampling
- // Scales from bigger to smaller height
- width := vImageScaleFilterWidth / yscale;
- fscale := 1.0 / yscale;
- for i := 0 to ADstHeight - 1 do
- begin
- contrib^[i].n := 0;
- GetMem(contrib^[i].p, Trunc(width * 2.0 + 1) * SizeOf(TContributor));
- center := i / yscale;
- left := floor(center - width);
- right := ceil(center + width);
- for j := left to right do
- begin
- weight := AFilter((center - j) / fscale) / fscale;
- if weight = 0.0 then
- continue;
- if (j < 0) then
- n := -j
- else if (j >= ASrcHeight) then
- n := MaxInteger(ASrcHeight - j + ASrcHeight - 1, 0)
- else
- n := j;
- k := contrib^[i].n;
- contrib^[i].n := contrib^[i].n + 1;
- contrib^[i].p^[k].pixel := n;
- contrib^[i].p^[k].weight := weight;
- end;
- end;
- size := ASrcWidth * ASrcHeight * SizeOf(TIntermediateFormat);
- Inc(PByte(tempBuf1), size);
- // Apply filter to sample vertically from Work to Dst
- for k := 0 to ADstWidth - 1 do
- begin
- for i := 0 to ADstHeight - 1 do
- begin
- color1 := cSuperBlack;
- for j := 0 to contrib^[i].n - 1 do
- begin
- weight := contrib^[i].p^[j].weight;
- if weight = 0.0 then
- continue;
- n := k + contrib^[i].p^[j].pixel * ADstWidth;
- color2 := tempBuf2[n];
- color1.R := color1.R + color2.R * weight;
- color1.G := color1.G + color2.G * weight;
- color1.B := color1.B + color2.B * weight;
- color1.A := color1.A + color2.A * weight;
- end;
- tempBuf1[k + i * ADstWidth] := color1;
- end;
- end;
- // Free the memory allocated for vertical filter weights
- for i := 0 to ADstHeight - 1 do
- FreeMem(contrib^[i].p);
- ASrcWidth := ADstWidth;
- ASrcHeight := ADstHeight;
- // Back to native image format
- ConvertFromIntermediateFormat(tempBuf1, ADst[level], AColorFormat,
- ASrcWidth, ASrcHeight);
- end;
- finally
- if Assigned(contrib) then
- FreeMem(contrib);
- FreeMem(tempBuf2);
- FreeMem(storePtr);
- end;
- end;
- procedure AlphaGammaBrightCorrection(const ASrc: Pointer;
- AColorFormat: Cardinal; ADataType: Cardinal; ASrcWidth, ASrcHeight: Integer;
- anAlphaProc: TImageAlphaProc; ABrightness: Single; AGamma: Single);
- var
- ConvertToIntermediateFormat: TConvertToImfProc;
- ConvertFromIntermediateFormat: TConvertFromInfProc;
- tempBuf1: PIntermediateFormatArray;
- Size, I: Integer;
- begin
- if ASrcWidth < 1 then
- Exit;
- ASrcHeight := MaxInteger(1, ASrcHeight);
- Size := ASrcWidth * ASrcHeight;
- GetMem(tempBuf1, Size * SizeOf(TIntermediateFormat));
- // Find function to convert external format to intermediate format
- ConvertToIntermediateFormat := UnsupportedToImf;
- ConvertFromIntermediateFormat := UnsupportedFromImf;
- for i := 0 to high(cConvertTable) do
- begin
- if ADataType = cConvertTable[i].type_ then
- begin
- ConvertToIntermediateFormat := cConvertTable[i].proc1;
- ConvertFromIntermediateFormat := cConvertTable[i].proc2;
- break;
- end;
- end;
- try
- ConvertToIntermediateFormat(ASrc, tempBuf1, AColorFormat, ASrcWidth,
- ASrcHeight);
- vTopLeftColor := tempBuf1[0];
- vBottomRightColor := tempBuf1[Size-1];
- if Assigned(anAlphaProc) then
- for I := Size - 1 downto 0 do
- anAlphaProc(tempBuf1[I]);
- if ABrightness <> 1.0 then
- for I := Size - 1 downto 0 do
- with tempBuf1[I] do
- begin
- R := R * ABrightness;
- G := G * ABrightness;
- B := B * ABrightness;
- end;
- if AGamma <> 1.0 then
- for I := Size - 1 downto 0 do
- with tempBuf1[I] do
- begin
- R := Power(R, AGamma);
- G := Power(G, AGamma);
- B := Power(B, AGamma);
- end;
- // Back to native image format
- ConvertFromIntermediateFormat(tempBuf1, ASrc, AColorFormat, ASrcWidth,
- ASrcHeight);
- except
- FreeMem(tempBuf1);
- raise;
- end;
- FreeMem(tempBuf1);
- end;
- function StringToColorAdvancedSafe(const Str: string;
- const Default: TColor): TColor;
- begin
- if not TryStringToColorAdvanced(Str, Result) then
- Result := Default;
- end;
- function StringToColorAdvanced(const Str: string): TColor;
- begin
- if not TryStringToColorAdvanced(Str, Result) then
- raise EGLUtilsException.CreateResFmt(@strInvalidColor, [Str]);
- end;
- function TryStringToColorAdvanced(const Str: string;
- var OutColor: TColor): Boolean;
- var
- Code, i: Integer;
- Temp: string;
- begin
- Result := True;
- Temp := Str;
- val(Temp, i, Code); // to see if it is a number
- if Code = 0 then
- OutColor := TColor(i) // Str = $0000FF
- else
- begin
- if not IdentToColor(Temp, LongInt(OutColor)) then // Str = clRed
- begin
- if AnsiStartsText('clr', Temp) then // Str = clrRed
- begin
- Delete(Temp, 3, 1);
- if not IdentToColor(Temp, LongInt(OutColor)) then
- Result := False;
- end
- else if not IdentToColor('cl' + Temp, LongInt(OutColor)) then // Str = Red
- Result := False;
- end;
- end;
- end;
- //--------------------------------------------------------------------------
- function GetDeviceCapabilities: TDeviceCapabilities;
- var
- device: HDC;
- begin
- device := GetDC(0);
- try
- Result.Xdpi := GetDeviceCaps(device, LOGPIXELSX);
- Result.Ydpi := GetDeviceCaps(device, LOGPIXELSY);
- Result.Depth := GetDeviceCaps(device, BITSPIXEL);
- Result.NumColors := GetDeviceCaps(device, NumColors);
- finally
- ReleaseDC(0, device);
- end;
- end;
- // -------------------------------------------------------------------------
- function GetDeviceLogicalPixelsX(device: HDC): Integer;
- begin
- Result := GetDeviceCapabilities().Xdpi;
- end;
- function GetCurrentColorDepth: Integer;
- begin
- Result := GetDeviceCapabilities().Depth;
- end;
- function PixelFormatToColorBits(aPixelFormat: TPixelFormat): Integer;
- begin
- case aPixelFormat of
- TPixelFormat.None: Result := GetCurrentColorDepth; // use current color depth
- TPixelFormat.BGR5_A1: Result := 1;
- TPixelFormat.BGRA4: Result := 4;
- TPixelFormat.RGBA: Result := 8;
- TPixelFormat.RGBA16: Result := 16;
- TPixelFormat.RGBA32F: Result := 32;
- else
- Result := 24;
- end;
- end;
- function BitmapScanLine(aBitmap: TBitmap; aRow: Integer): Pointer;
- var
- BitmapData : TBitmapData;
- begin
- aBitmap.Map(TMapAccess.ReadWrite, BitmapData);
- Result := BitmapData.GetScanline(aRow); //in VCL the Result := aBitmap.ScanLine[aRow];
- end;
- //-------------------------------------------------------------------------
- procedure InformationDlg(const msg: string);
- begin
- ShowMessage(msg);
- end;
- function QuestionDlg(const msg: string): Boolean;
- begin
- // in vcl Result := (MessageDlg(msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
- Result := (MessageDlg(msg, TMsgDlgType.mtConfirmation,
- [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0) = mrYes);
- end;
- function InputDlg(const aCaption, aPrompt, aDefault: string): string;
- begin
- Result := InputBox(aCaption, aPrompt, aDefault); // Use FMX.DialogService
- end;
- function SavePictureDialog(var aFileName: string;
- const aTitle: string = ''): Boolean;
- var
- saveDialog: TSaveDialog; // in vcl TSavePictureDialog;
- begin
- saveDialog := TSaveDialog.Create(nil);
- try
- with saveDialog do
- begin
- Options := [TOpenOption.ofHideReadOnly, TOpenOption.ofNoReadOnlyReturn];
- if aTitle <> '' then
- Title := aTitle;
- fileName := aFileName;
- Result := Execute;
- if Result then
- aFileName := fileName;
- end;
- finally
- saveDialog.Free;
- end;
- end;
- function OpenPictureDialog(var aFileName: string;
- const aTitle: string = ''): Boolean;
- var
- openDialog: TOpenDialog; // in vcl TOpenPictureDialog;
- begin
- openDialog := TOpenDialog.Create(nil);
- try
- with openDialog do
- begin
- Options := [TOpenOption.ofHideReadOnly, TOpenOption.ofNoReadOnlyReturn];
- if aTitle <> '' then
- Title := aTitle;
- fileName := aFileName;
- Result := Execute;
- if Result then
- aFileName := fileName;
- end;
- finally
- openDialog.Free;
- end;
- end;
- // ----------------------------------------------------------------------------
- end.
|