You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

glBitmap.pas 316 KiB

10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
10 年之前
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887
  1. { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  2. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  3. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  4. The contents of this file are used with permission, subject to
  5. the Mozilla Public License Version 1.1 (the "License"); you may
  6. not use this file except in compliance with the License. You may
  7. obtain a copy of the License at
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9. The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  10. to manage OpenGL texture objects. Below you can find a list of the main
  11. functionality of this classes:
  12. - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  13. - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  14. - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  15. - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  16. - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  17. - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  18. - upload texture data to video card
  19. - download texture data from video card
  20. - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  21. unit glBitmap;
  22. {$I glBitmapConf.inc}
  23. // Delphi Versions
  24. {$IFDEF fpc}
  25. {$MODE Delphi}
  26. {$IFDEF CPUI386}
  27. {$DEFINE CPU386}
  28. {$ASMMODE INTEL}
  29. {$ENDIF}
  30. {$IFNDEF WINDOWS}
  31. {$linklib c}
  32. {$ENDIF}
  33. {$ENDIF}
  34. // Operation System
  35. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  36. {$DEFINE GLB_WIN}
  37. {$ELSEIF DEFINED(LINUX)}
  38. {$DEFINE GLB_LINUX}
  39. {$IFEND}
  40. // OpenGL ES
  41. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  42. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  43. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  44. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  45. // checking define combinations
  46. //SDL Image
  47. {$IFDEF GLB_SDL_IMAGE}
  48. {$IFNDEF GLB_SDL}
  49. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  50. {$DEFINE GLB_SDL}
  51. {$ENDIF}
  52. {$IFDEF GLB_LAZ_PNG}
  53. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  54. {$undef GLB_LAZ_PNG}
  55. {$ENDIF}
  56. {$IFDEF GLB_PNGIMAGE}
  57. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  58. {$undef GLB_PNGIMAGE}
  59. {$ENDIF}
  60. {$IFDEF GLB_LAZ_JPEG}
  61. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  62. {$undef GLB_LAZ_JPEG}
  63. {$ENDIF}
  64. {$IFDEF GLB_DELPHI_JPEG}
  65. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  66. {$undef GLB_DELPHI_JPEG}
  67. {$ENDIF}
  68. {$IFDEF GLB_LIB_PNG}
  69. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  70. {$undef GLB_LIB_PNG}
  71. {$ENDIF}
  72. {$IFDEF GLB_LIB_JPEG}
  73. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  74. {$undef GLB_LIB_JPEG}
  75. {$ENDIF}
  76. {$DEFINE GLB_SUPPORT_PNG_READ}
  77. {$DEFINE GLB_SUPPORT_JPEG_READ}
  78. {$ENDIF}
  79. // Lazarus TPortableNetworkGraphic
  80. {$IFDEF GLB_LAZ_PNG}
  81. {$IFNDEF GLB_LAZARUS}
  82. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  83. {$DEFINE GLB_LAZARUS}
  84. {$ENDIF}
  85. {$IFDEF GLB_PNGIMAGE}
  86. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  87. {$undef GLB_PNGIMAGE}
  88. {$ENDIF}
  89. {$IFDEF GLB_LIB_PNG}
  90. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  91. {$undef GLB_LIB_PNG}
  92. {$ENDIF}
  93. {$DEFINE GLB_SUPPORT_PNG_READ}
  94. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  95. {$ENDIF}
  96. // PNG Image
  97. {$IFDEF GLB_PNGIMAGE}
  98. {$IFDEF GLB_LIB_PNG}
  99. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  100. {$undef GLB_LIB_PNG}
  101. {$ENDIF}
  102. {$DEFINE GLB_SUPPORT_PNG_READ}
  103. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  104. {$ENDIF}
  105. // libPNG
  106. {$IFDEF GLB_LIB_PNG}
  107. {$DEFINE GLB_SUPPORT_PNG_READ}
  108. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  109. {$ENDIF}
  110. // Lazarus TJPEGImage
  111. {$IFDEF GLB_LAZ_JPEG}
  112. {$IFNDEF GLB_LAZARUS}
  113. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  114. {$DEFINE GLB_LAZARUS}
  115. {$ENDIF}
  116. {$IFDEF GLB_DELPHI_JPEG}
  117. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  118. {$undef GLB_DELPHI_JPEG}
  119. {$ENDIF}
  120. {$IFDEF GLB_LIB_JPEG}
  121. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  122. {$undef GLB_LIB_JPEG}
  123. {$ENDIF}
  124. {$DEFINE GLB_SUPPORT_JPEG_READ}
  125. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  126. {$ENDIF}
  127. // JPEG Image
  128. {$IFDEF GLB_DELPHI_JPEG}
  129. {$IFDEF GLB_LIB_JPEG}
  130. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  131. {$undef GLB_LIB_JPEG}
  132. {$ENDIF}
  133. {$DEFINE GLB_SUPPORT_JPEG_READ}
  134. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  135. {$ENDIF}
  136. // libJPEG
  137. {$IFDEF GLB_LIB_JPEG}
  138. {$DEFINE GLB_SUPPORT_JPEG_READ}
  139. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  140. {$ENDIF}
  141. // general options
  142. {$EXTENDEDSYNTAX ON}
  143. {$LONGSTRINGS ON}
  144. {$ALIGN ON}
  145. {$IFNDEF FPC}
  146. {$OPTIMIZATION ON}
  147. {$ENDIF}
  148. {$UNDEF GLB_LAZARUS}
  149. interface
  150. uses
  151. {$IFDEF OPENGL_ES} dglOpenGLES,
  152. {$ELSE} dglOpenGL, {$ENDIF}
  153. {$IF DEFINED(GLB_WIN) AND
  154. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  155. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  156. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  157. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  158. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  159. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  160. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  161. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  162. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  163. Classes, SysUtils;
  164. type
  165. {$IFNDEF fpc}
  166. QWord = System.UInt64;
  167. PQWord = ^QWord;
  168. PtrInt = Longint;
  169. PtrUInt = DWord;
  170. {$ENDIF}
  171. { type that describes the format of the data stored in a texture.
  172. the name of formats is composed of the following constituents:
  173. - multiple channels:
  174. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  175. - width of the chanel in bit (4, 8, 16, ...)
  176. - data type (e.g. ub, us, ui)
  177. - number of elements of data types }
  178. TglBitmapFormat = (
  179. tfEmpty = 0,
  180. tfAlpha4ub1, //< 1 x unsigned byte
  181. tfAlpha8ub1, //< 1 x unsigned byte
  182. tfAlpha16us1, //< 1 x unsigned short
  183. tfLuminance4ub1, //< 1 x unsigned byte
  184. tfLuminance8ub1, //< 1 x unsigned byte
  185. tfLuminance16us1, //< 1 x unsigned short
  186. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  187. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  188. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  189. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  190. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  191. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  192. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  193. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  194. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  195. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  196. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  197. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  198. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  199. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  200. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  201. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  202. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  203. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  204. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  205. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  206. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  207. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  208. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  209. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  210. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  211. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  212. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  213. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  214. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  215. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  216. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  217. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  218. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  219. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  220. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  221. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  222. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  223. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  224. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  225. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  226. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  227. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  228. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  229. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  230. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  231. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  232. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  233. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  234. tfDepth16us1, //< 1 x unsigned short (depth)
  235. tfDepth24ui1, //< 1 x unsigned int (depth)
  236. tfDepth32ui1, //< 1 x unsigned int (depth)
  237. tfS3tcDtx1RGBA,
  238. tfS3tcDtx3RGBA,
  239. tfS3tcDtx5RGBA
  240. );
  241. { type to define suitable file formats }
  242. TglBitmapFileType = (
  243. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  244. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  245. ftDDS, //< Direct Draw Surface file (DDS)
  246. ftTGA, //< Targa Image File (TGA)
  247. ftBMP, //< Windows Bitmap File (BMP)
  248. ftRAW); //< glBitmap RAW file format
  249. TglBitmapFileTypes = set of TglBitmapFileType;
  250. { possible mipmap types }
  251. TglBitmapMipMap = (
  252. mmNone, //< no mipmaps
  253. mmMipmap, //< normal mipmaps
  254. mmMipmapGlu); //< mipmaps generated with glu functions
  255. { possible normal map functions }
  256. TglBitmapNormalMapFunc = (
  257. nm4Samples,
  258. nmSobel,
  259. nm3x3,
  260. nm5x5);
  261. ////////////////////////////////////////////////////////////////////////////////////////////////////
  262. EglBitmap = class(Exception); //< glBitmap exception
  263. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  264. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  265. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  266. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  267. public
  268. constructor Create(const aFormat: TglBitmapFormat); overload;
  269. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  270. end;
  271. ////////////////////////////////////////////////////////////////////////////////////////////////////
  272. { record that stores 4 unsigned integer values }
  273. TglBitmapRec4ui = packed record
  274. case Integer of
  275. 0: (r, g, b, a: Cardinal);
  276. 1: (arr: array[0..3] of Cardinal);
  277. end;
  278. { record that stores 4 unsigned byte values }
  279. TglBitmapRec4ub = packed record
  280. case Integer of
  281. 0: (r, g, b, a: Byte);
  282. 1: (arr: array[0..3] of Byte);
  283. end;
  284. { record that stores 4 unsigned long integer values }
  285. TglBitmapRec4ul = packed record
  286. case Integer of
  287. 0: (r, g, b, a: QWord);
  288. 1: (arr: array[0..3] of QWord);
  289. end;
  290. { structure to store pixel data in }
  291. TglBitmapPixelData = packed record
  292. Data: TglBitmapRec4ui; //< color data for each color channel
  293. Range: TglBitmapRec4ui; //< maximal color value for each channel
  294. Format: TglBitmapFormat; //< format of the pixel
  295. end;
  296. PglBitmapPixelData = ^TglBitmapPixelData;
  297. TglBitmapSizeFields = set of (ffX, ffY);
  298. TglBitmapSize = packed record
  299. Fields: TglBitmapSizeFields;
  300. X: Word;
  301. Y: Word;
  302. end;
  303. TglBitmapPixelPosition = TglBitmapSize;
  304. { describes the properties of a given texture data format }
  305. TglBitmapFormatDescriptor = class(TObject)
  306. private
  307. // cached properties
  308. fBytesPerPixel: Single; //< number of bytes for each pixel
  309. fChannelCount: Integer; //< number of color channels
  310. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  311. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  312. { @return @true if the format has a red color channel, @false otherwise }
  313. function GetHasRed: Boolean;
  314. { @return @true if the format has a green color channel, @false otherwise }
  315. function GetHasGreen: Boolean;
  316. { @return @true if the format has a blue color channel, @false otherwise }
  317. function GetHasBlue: Boolean;
  318. { @return @true if the format has a alpha color channel, @false otherwise }
  319. function GetHasAlpha: Boolean;
  320. { @return @true if the format has any color color channel, @false otherwise }
  321. function GetHasColor: Boolean;
  322. { @return @true if the format is a grayscale format, @false otherwise }
  323. function GetIsGrayscale: Boolean;
  324. { @return @true if the format is supported by OpenGL, @false otherwise }
  325. function GetHasOpenGLSupport: Boolean;
  326. protected
  327. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  328. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  329. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  330. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  331. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  332. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  333. fBitsPerPixel: Integer; //< number of bits per pixel
  334. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  335. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  336. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  337. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  338. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  339. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  340. { set values for this format descriptor }
  341. procedure SetValues; virtual;
  342. { calculate cached values }
  343. procedure CalcValues;
  344. public
  345. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  346. property ChannelCount: Integer read fChannelCount; //< number of color channels
  347. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  348. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  349. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  350. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  351. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  352. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  353. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  354. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  355. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  356. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  357. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  358. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  359. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  360. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  361. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  362. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  363. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  364. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  365. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  366. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  367. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  368. property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
  369. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  370. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  371. { constructor }
  372. constructor Create;
  373. public
  374. { get the format descriptor by a given OpenGL internal format
  375. @param aInternalFormat OpenGL internal format to get format descriptor for
  376. @returns suitable format descriptor or tfEmpty-Descriptor }
  377. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  378. end;
  379. ////////////////////////////////////////////////////////////////////////////////////////////////////
  380. TglBitmapData = class;
  381. { structure to store data for converting in }
  382. TglBitmapFunctionRec = record
  383. Sender: TglBitmapData; //< texture object that stores the data to convert
  384. Size: TglBitmapSize; //< size of the texture
  385. Position: TglBitmapPixelPosition; //< position of the currently pixel
  386. Source: TglBitmapPixelData; //< pixel data of the current pixel
  387. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  388. Args: Pointer; //< user defined args that was passed to the convert function
  389. end;
  390. { callback to use for converting texture data }
  391. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  393. { class to store texture data in. used to load, save and
  394. manipulate data before assigned to texture object
  395. all operations on a data object can be done from a background thread }
  396. TglBitmapData = class
  397. private { fields }
  398. fData: PByte; //< texture data
  399. fDimension: TglBitmapSize; //< pixel size of the data
  400. fFormat: TglBitmapFormat; //< format the texture data is stored in
  401. fFilename: String; //< file the data was load from
  402. fScanlines: array of PByte; //< pointer to begin of each line
  403. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  404. private { getter / setter }
  405. { @returns the format descriptor suitable to the texture data format }
  406. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  407. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  408. function GetWidth: Integer;
  409. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  410. function GetHeight: Integer;
  411. { get scanline at index aIndex
  412. @returns Pointer to start of line or @nil }
  413. function GetScanlines(const aIndex: Integer): PByte;
  414. { set new value for the data format. only possible if new format has the same pixel size.
  415. if you want to convert the texture data, see ConvertTo function }
  416. procedure SetFormat(const aValue: TglBitmapFormat);
  417. private { internal misc }
  418. { splits a resource identifier into the resource and it's type
  419. @param aResource resource identifier to split and store name in
  420. @param aResType type of the resource }
  421. procedure PrepareResType(var aResource: String; var aResType: PChar);
  422. { updates scanlines array }
  423. procedure UpdateScanlines;
  424. private { internal load and save }
  425. {$IFDEF GLB_SUPPORT_PNG_READ}
  426. { try to load a PNG from a stream
  427. @param aStream stream to load PNG from
  428. @returns @true on success, @false otherwise }
  429. function LoadPNG(const aStream: TStream): Boolean; virtual;
  430. {$ENDIF}
  431. {$ifdef GLB_SUPPORT_PNG_WRITE}
  432. { save texture data as PNG to stream
  433. @param aStream stream to save data to}
  434. procedure SavePNG(const aStream: TStream); virtual;
  435. {$ENDIF}
  436. {$IFDEF GLB_SUPPORT_JPEG_READ}
  437. { try to load a JPEG from a stream
  438. @param aStream stream to load JPEG from
  439. @returns @true on success, @false otherwise }
  440. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  441. {$ENDIF}
  442. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  443. { save texture data as JPEG to stream
  444. @param aStream stream to save data to}
  445. procedure SaveJPEG(const aStream: TStream); virtual;
  446. {$ENDIF}
  447. { try to load a RAW image from a stream
  448. @param aStream stream to load RAW image from
  449. @returns @true on success, @false otherwise }
  450. function LoadRAW(const aStream: TStream): Boolean;
  451. { save texture data as RAW image to stream
  452. @param aStream stream to save data to}
  453. procedure SaveRAW(const aStream: TStream);
  454. { try to load a BMP from a stream
  455. @param aStream stream to load BMP from
  456. @returns @true on success, @false otherwise }
  457. function LoadBMP(const aStream: TStream): Boolean;
  458. { save texture data as BMP to stream
  459. @param aStream stream to save data to}
  460. procedure SaveBMP(const aStream: TStream);
  461. { try to load a TGA from a stream
  462. @param aStream stream to load TGA from
  463. @returns @true on success, @false otherwise }
  464. function LoadTGA(const aStream: TStream): Boolean;
  465. { save texture data as TGA to stream
  466. @param aStream stream to save data to}
  467. procedure SaveTGA(const aStream: TStream);
  468. { try to load a DDS from a stream
  469. @param aStream stream to load DDS from
  470. @returns @true on success, @false otherwise }
  471. function LoadDDS(const aStream: TStream): Boolean;
  472. { save texture data as DDS to stream
  473. @param aStream stream to save data to}
  474. procedure SaveDDS(const aStream: TStream);
  475. public { properties }
  476. property Data: PByte read fData; //< texture data (be carefull with this!)
  477. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  478. property Filename: String read fFilename; //< file the data was loaded from
  479. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  480. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  481. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  482. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  483. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  484. public { flip }
  485. { flip texture horizontal
  486. @returns @true in success, @false otherwise }
  487. function FlipHorz: Boolean; virtual;
  488. { flip texture vertical
  489. @returns @true in success, @false otherwise }
  490. function FlipVert: Boolean; virtual;
  491. public { load }
  492. { load a texture from a file
  493. @param aFilename file to load texuture from }
  494. procedure LoadFromFile(const aFilename: String);
  495. { load a texture from a stream
  496. @param aStream stream to load texture from }
  497. procedure LoadFromStream(const aStream: TStream); virtual;
  498. { use a function to generate texture data
  499. @param aSize size of the texture
  500. @param aFormat format of the texture data
  501. @param aFunc callback to use for generation
  502. @param aArgs user defined paramaters (use at will) }
  503. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  504. { load a texture from a resource
  505. @param aInstance resource handle
  506. @param aResource resource indentifier
  507. @param aResType resource type (if known) }
  508. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  509. { load a texture from a resource id
  510. @param aInstance resource handle
  511. @param aResource resource ID
  512. @param aResType resource type }
  513. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  514. public { save }
  515. { save texture data to a file
  516. @param aFilename filename to store texture in
  517. @param aFileType file type to store data into }
  518. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  519. { save texture data to a stream
  520. @param aFilename filename to store texture in
  521. @param aFileType file type to store data into }
  522. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  523. public { convert }
  524. { convert texture data using a user defined callback
  525. @param aFunc callback to use for converting
  526. @param aCreateTemp create a temporary buffer to use for converting
  527. @param aArgs user defined paramters (use at will)
  528. @returns @true if converting was successful, @false otherwise }
  529. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  530. { convert texture data using a user defined callback
  531. @param aSource glBitmap to read data from
  532. @param aFunc callback to use for converting
  533. @param aCreateTemp create a temporary buffer to use for converting
  534. @param aFormat format of the new data
  535. @param aArgs user defined paramters (use at will)
  536. @returns @true if converting was successful, @false otherwise }
  537. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  538. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  539. { convert texture data using a specific format
  540. @param aFormat new format of texture data
  541. @returns @true if converting was successful, @false otherwise }
  542. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  543. {$IFDEF GLB_SDL}
  544. public { SDL }
  545. { assign texture data to SDL surface
  546. @param aSurface SDL surface to write data to
  547. @returns @true on success, @false otherwise }
  548. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  549. { assign texture data from SDL surface
  550. @param aSurface SDL surface to read data from
  551. @returns @true on success, @false otherwise }
  552. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  553. { assign alpha channel data to SDL surface
  554. @param aSurface SDL surface to write alpha channel data to
  555. @returns @true on success, @false otherwise }
  556. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  557. { assign alpha channel data from SDL surface
  558. @param aSurface SDL surface to read data from
  559. @param aFunc callback to use for converting
  560. @param aArgs user defined parameters (use at will)
  561. @returns @true on success, @false otherwise }
  562. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  563. {$ENDIF}
  564. {$IFDEF GLB_DELPHI}
  565. public { Delphi }
  566. { assign texture data to TBitmap object
  567. @param aBitmap TBitmap to write data to
  568. @returns @true on success, @false otherwise }
  569. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  570. { assign texture data from TBitmap object
  571. @param aBitmap TBitmap to read data from
  572. @returns @true on success, @false otherwise }
  573. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  574. { assign alpha channel data to TBitmap object
  575. @param aBitmap TBitmap to write data to
  576. @returns @true on success, @false otherwise }
  577. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  578. { assign alpha channel data from TBitmap object
  579. @param aBitmap TBitmap to read data from
  580. @param aFunc callback to use for converting
  581. @param aArgs user defined parameters (use at will)
  582. @returns @true on success, @false otherwise }
  583. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  584. {$ENDIF}
  585. {$IFDEF GLB_LAZARUS}
  586. public { Lazarus }
  587. { assign texture data to TLazIntfImage object
  588. @param aImage TLazIntfImage to write data to
  589. @returns @true on success, @false otherwise }
  590. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  591. { assign texture data from TLazIntfImage object
  592. @param aImage TLazIntfImage to read data from
  593. @returns @true on success, @false otherwise }
  594. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  595. { assign alpha channel data to TLazIntfImage object
  596. @param aImage TLazIntfImage to write data to
  597. @returns @true on success, @false otherwise }
  598. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  599. { assign alpha channel data from TLazIntfImage object
  600. @param aImage TLazIntfImage to read data from
  601. @param aFunc callback to use for converting
  602. @param aArgs user defined parameters (use at will)
  603. @returns @true on success, @false otherwise }
  604. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  605. {$ENDIF}
  606. public { Alpha }
  607. { load alpha channel data from resource
  608. @param aInstance resource handle
  609. @param aResource resource ID
  610. @param aResType resource type
  611. @param aFunc callback to use for converting
  612. @param aArgs user defined parameters (use at will)
  613. @returns @true on success, @false otherwise }
  614. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  615. { load alpha channel data from resource ID
  616. @param aInstance resource handle
  617. @param aResourceID resource ID
  618. @param aResType resource type
  619. @param aFunc callback to use for converting
  620. @param aArgs user defined parameters (use at will)
  621. @returns @true on success, @false otherwise }
  622. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  623. { add alpha channel data from function
  624. @param aFunc callback to get data from
  625. @param aArgs user defined parameters (use at will)
  626. @returns @true on success, @false otherwise }
  627. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  628. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  629. @param aFilename file to load alpha channel data from
  630. @param aFunc callback to use for converting
  631. @param aArgs SetFormat user defined parameters (use at will)
  632. @returns @true on success, @false otherwise }
  633. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  634. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  635. @param aStream stream to load alpha channel data from
  636. @param aFunc callback to use for converting
  637. @param aArgs user defined parameters (use at will)
  638. @returns @true on success, @false otherwise }
  639. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  640. { add alpha channel data from existing glBitmap object
  641. @param aBitmap TglBitmap to copy alpha channel data from
  642. @param aFunc callback to use for converting
  643. @param aArgs user defined parameters (use at will)
  644. @returns @true on success, @false otherwise }
  645. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  646. { add alpha to pixel if the pixels color is greter than the given color value
  647. @param aRed red threshold (0-255)
  648. @param aGreen green threshold (0-255)
  649. @param aBlue blue threshold (0-255)
  650. @param aDeviatation accepted deviatation (0-255)
  651. @returns @true on success, @false otherwise }
  652. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  653. { add alpha to pixel if the pixels color is greter than the given color value
  654. @param aRed red threshold (0-Range.r)
  655. @param aGreen green threshold (0-Range.g)
  656. @param aBlue blue threshold (0-Range.b)
  657. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  658. @returns @true on success, @false otherwise }
  659. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  660. { add alpha to pixel if the pixels color is greter than the given color value
  661. @param aRed red threshold (0.0-1.0)
  662. @param aGreen green threshold (0.0-1.0)
  663. @param aBlue blue threshold (0.0-1.0)
  664. @param aDeviatation accepted deviatation (0.0-1.0)
  665. @returns @true on success, @false otherwise }
  666. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  667. { add a constand alpha value to all pixels
  668. @param aAlpha alpha value to add (0-255)
  669. @returns @true on success, @false otherwise }
  670. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  671. { add a constand alpha value to all pixels
  672. @param aAlpha alpha value to add (0-max(Range.rgb))
  673. @returns @true on success, @false otherwise }
  674. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  675. { add a constand alpha value to all pixels
  676. @param aAlpha alpha value to add (0.0-1.0)
  677. @returns @true on success, @false otherwise }
  678. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  679. { remove alpha channel
  680. @returns @true on success, @false otherwise }
  681. function RemoveAlpha: Boolean; virtual;
  682. public { fill }
  683. { fill complete texture with one color
  684. @param aRed red color for border (0-255)
  685. @param aGreen green color for border (0-255)
  686. @param aBlue blue color for border (0-255)
  687. @param aAlpha alpha color for border (0-255) }
  688. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  689. { fill complete texture with one color
  690. @param aRed red color for border (0-Range.r)
  691. @param aGreen green color for border (0-Range.g)
  692. @param aBlue blue color for border (0-Range.b)
  693. @param aAlpha alpha color for border (0-Range.a) }
  694. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  695. { fill complete texture with one color
  696. @param aRed red color for border (0.0-1.0)
  697. @param aGreen green color for border (0.0-1.0)
  698. @param aBlue blue color for border (0.0-1.0)
  699. @param aAlpha alpha color for border (0.0-1.0) }
  700. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  701. public { Misc }
  702. { set data pointer of texture data
  703. @param aData pointer to new texture data
  704. @param aFormat format of the data stored at aData
  705. @param aWidth width of the texture data
  706. @param aHeight height of the texture data }
  707. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  708. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  709. { create a clone of the current object
  710. @returns clone of this object}
  711. function Clone: TglBitmapData;
  712. { invert color data (bitwise not)
  713. @param aRed invert red channel
  714. @param aGreen invert green channel
  715. @param aBlue invert blue channel
  716. @param aAlpha invert alpha channel }
  717. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  718. { create normal map from texture data
  719. @param aFunc normal map function to generate normalmap with
  720. @param aScale scale of the normale stored in the normal map
  721. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  722. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  723. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  724. public { constructor }
  725. { constructor - creates a texutre data object }
  726. constructor Create; overload;
  727. { constructor - creates a texture data object and loads it from a file
  728. @param aFilename file to load texture from }
  729. constructor Create(const aFileName: String); overload;
  730. { constructor - creates a texture data object and loads it from a stream
  731. @param aStream stream to load texture from }
  732. constructor Create(const aStream: TStream); overload;
  733. { constructor - creates a texture data object with the given size, format and data
  734. @param aSize size of the texture
  735. @param aFormat format of the given data
  736. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  737. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  738. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  739. @param aSize size of the texture
  740. @param aFormat format of the given data
  741. @param aFunc callback to use for generating the data
  742. @param aArgs user defined parameters (use at will) }
  743. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  744. { constructor - creates a texture data object and loads it from a resource
  745. @param aInstance resource handle
  746. @param aResource resource indentifier
  747. @param aResType resource type (if known) }
  748. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  749. { constructor - creates a texture data object and loads it from a resource
  750. @param aInstance resource handle
  751. @param aResourceID resource ID
  752. @param aResType resource type (if known) }
  753. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  754. { destructor }
  755. destructor Destroy; override;
  756. end;
  757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  758. { base class for all glBitmap classes. used to manage OpenGL texture objects
  759. all operations on a bitmap object must be done from the render thread }
  760. TglBitmap = class
  761. protected
  762. fID: GLuint; //< name of the OpenGL texture object
  763. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  764. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  765. // texture properties
  766. fFilterMin: GLenum; //< min filter to apply to the texture
  767. fFilterMag: GLenum; //< mag filter to apply to the texture
  768. fWrapS: GLenum; //< texture wrapping for x axis
  769. fWrapT: GLenum; //< texture wrapping for y axis
  770. fWrapR: GLenum; //< texture wrapping for z axis
  771. fAnisotropic: Integer; //< anisotropic level
  772. fBorderColor: array[0..3] of Single; //< color of the texture border
  773. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  774. //Swizzle
  775. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  776. {$IFEND}
  777. {$IFNDEF OPENGL_ES}
  778. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  779. {$ENDIF}
  780. fDimension: TglBitmapSize; //< size of this texture
  781. fMipMap: TglBitmapMipMap; //< mipmap type
  782. // CustomData
  783. fCustomData: Pointer; //< user defined data
  784. fCustomName: String; //< user defined name
  785. fCustomNameW: WideString; //< user defined name
  786. protected
  787. { @returns the actual width of the texture }
  788. function GetWidth: Integer; virtual;
  789. { @returns the actual height of the texture }
  790. function GetHeight: Integer; virtual;
  791. protected
  792. { set a new value for fCustomData }
  793. procedure SetCustomData(const aValue: Pointer);
  794. { set a new value for fCustomName }
  795. procedure SetCustomName(const aValue: String);
  796. { set a new value for fCustomNameW }
  797. procedure SetCustomNameW(const aValue: WideString);
  798. { set new value for fDeleteTextureOnFree }
  799. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  800. { set name of OpenGL texture object }
  801. procedure SetID(const aValue: Cardinal);
  802. { set new value for fMipMap }
  803. procedure SetMipMap(const aValue: TglBitmapMipMap);
  804. { set new value for target }
  805. procedure SetTarget(const aValue: Cardinal);
  806. { set new value for fAnisotrophic }
  807. procedure SetAnisotropic(const aValue: Integer);
  808. protected
  809. { create OpenGL texture object (delete exisiting object if exists) }
  810. procedure CreateID;
  811. { setup texture parameters }
  812. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  813. protected
  814. property Width: Integer read GetWidth; //< the actual width of the texture
  815. property Height: Integer read GetHeight; //< the actual height of the texture
  816. public
  817. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  818. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  819. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  820. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  821. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  822. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  823. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  824. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  825. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  826. {$IFNDEF OPENGL_ES}
  827. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  828. {$ENDIF}
  829. { this method is called after the constructor and sets the default values of this object }
  830. procedure AfterConstruction; override;
  831. { this method is called before the destructor and does some cleanup }
  832. procedure BeforeDestruction; override;
  833. public
  834. {$IFNDEF OPENGL_ES}
  835. { set the new value for texture border color
  836. @param aRed red color for border (0.0-1.0)
  837. @param aGreen green color for border (0.0-1.0)
  838. @param aBlue blue color for border (0.0-1.0)
  839. @param aAlpha alpha color for border (0.0-1.0) }
  840. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  841. {$ENDIF}
  842. public
  843. { set new texture filer
  844. @param aMin min filter
  845. @param aMag mag filter }
  846. procedure SetFilter(const aMin, aMag: GLenum);
  847. { set new texture wrapping
  848. @param S texture wrapping for x axis
  849. @param T texture wrapping for y axis
  850. @param R texture wrapping for z axis }
  851. procedure SetWrap(
  852. const S: GLenum = GL_CLAMP_TO_EDGE;
  853. const T: GLenum = GL_CLAMP_TO_EDGE;
  854. const R: GLenum = GL_CLAMP_TO_EDGE);
  855. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  856. { set new swizzle
  857. @param r swizzle for red channel
  858. @param g swizzle for green channel
  859. @param b swizzle for blue channel
  860. @param a swizzle for alpha channel }
  861. procedure SetSwizzle(const r, g, b, a: GLenum);
  862. {$IFEND}
  863. public
  864. { bind texture
  865. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  866. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  867. { bind texture
  868. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  869. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  870. { upload texture data from given data object to video card
  871. @param aData texture data object that contains the actual data
  872. @param aCheckSize check size before upload and throw exception if something is wrong }
  873. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  874. {$IFNDEF OPENGL_ES}
  875. { download texture data from video card and store it into given data object
  876. @returns @true when download was successfull, @false otherwise }
  877. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  878. {$ENDIF}
  879. public
  880. { constructor - creates an empty texture }
  881. constructor Create; overload;
  882. { constructor - creates an texture object and uploads the given data }
  883. constructor Create(const aData: TglBitmapData); overload;
  884. end;
  885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  886. {$IF NOT DEFINED(OPENGL_ES)}
  887. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  888. all operations on a bitmap object must be done from the render thread }
  889. TglBitmap1D = class(TglBitmap)
  890. protected
  891. { upload the texture data to video card
  892. @param aDataObj texture data object that contains the actual data
  893. @param aBuildWithGlu use glu functions to build mipmaps }
  894. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  895. public
  896. property Width; //< actual with of the texture
  897. { this method is called after constructor and initializes the object }
  898. procedure AfterConstruction; override;
  899. { upload texture data from given data object to video card
  900. @param aData texture data object that contains the actual data
  901. @param aCheckSize check size before upload and throw exception if something is wrong }
  902. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  903. end;
  904. {$IFEND}
  905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  906. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  907. all operations on a bitmap object must be done from the render thread }
  908. TglBitmap2D = class(TglBitmap)
  909. protected
  910. { upload the texture data to video card
  911. @param aDataObj texture data object that contains the actual data
  912. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  913. @param aBuildWithGlu use glu functions to build mipmaps }
  914. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  915. {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  916. public
  917. property Width; //< actual width of the texture
  918. property Height; //< actual height of the texture
  919. { this method is called after constructor and initializes the object }
  920. procedure AfterConstruction; override;
  921. { upload texture data from given data object to video card
  922. @param aData texture data object that contains the actual data
  923. @param aCheckSize check size before upload and throw exception if something is wrong }
  924. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  925. public
  926. { copy a part of the frame buffer to the texture
  927. @param aTop topmost pixel to copy
  928. @param aLeft leftmost pixel to copy
  929. @param aRight rightmost pixel to copy
  930. @param aBottom bottommost pixel to copy
  931. @param aFormat format to store data in
  932. @param aDataObj texture data object to store the data in }
  933. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  934. end;
  935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  936. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  937. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  938. all operations on a bitmap object must be done from the render thread }
  939. TglBitmapCubeMap = class(TglBitmap2D)
  940. protected
  941. {$IFNDEF OPENGL_ES}
  942. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  943. {$ENDIF}
  944. public
  945. { this method is called after constructor and initializes the object }
  946. procedure AfterConstruction; override;
  947. { upload texture data from given data object to video card
  948. @param aData texture data object that contains the actual data
  949. @param aCheckSize check size before upload and throw exception if something is wrong }
  950. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  951. { upload texture data from given data object to video card
  952. @param aData texture data object that contains the actual data
  953. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  954. @param aCheckSize check size before upload and throw exception if something is wrong }
  955. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  956. { bind texture
  957. @param aEnableTexCoordsGen enable cube map generator
  958. @param aEnableTextureUnit enable texture unit }
  959. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  960. { unbind texture
  961. @param aDisableTexCoordsGen disable cube map generator
  962. @param aDisableTextureUnit disable texture unit }
  963. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  964. end;
  965. {$IFEND}
  966. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  968. { wrapper class for cube normal maps
  969. all operations on a bitmap object must be done from the render thread }
  970. TglBitmapNormalMap = class(TglBitmapCubeMap)
  971. public
  972. { this method is called after constructor and initializes the object }
  973. procedure AfterConstruction; override;
  974. { create cube normal map from texture data and upload it to video card
  975. @param aSize size of each cube map texture
  976. @param aCheckSize check size before upload and throw exception if something is wrong }
  977. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  978. end;
  979. {$IFEND}
  980. const
  981. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  982. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  983. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  984. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  985. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  986. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  987. procedure glBitmapSetDefaultWrap(
  988. const S: Cardinal = GL_CLAMP_TO_EDGE;
  989. const T: Cardinal = GL_CLAMP_TO_EDGE;
  990. const R: Cardinal = GL_CLAMP_TO_EDGE);
  991. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  992. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  993. {$IFEND}
  994. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  995. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  996. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  997. function glBitmapGetDefaultFormat: TglBitmapFormat;
  998. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  999. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1000. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1001. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1002. {$IFEND}
  1003. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1004. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1005. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1006. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1007. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1008. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1009. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1010. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1011. {$IFDEF GLB_DELPHI}
  1012. function CreateGrayPalette: HPALETTE;
  1013. {$ENDIF}
  1014. implementation
  1015. uses
  1016. Math, syncobjs, typinfo
  1017. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1018. var
  1019. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1020. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1021. glBitmapDefaultFormat: TglBitmapFormat;
  1022. glBitmapDefaultMipmap: TglBitmapMipMap;
  1023. glBitmapDefaultFilterMin: Cardinal;
  1024. glBitmapDefaultFilterMag: Cardinal;
  1025. glBitmapDefaultWrapS: Cardinal;
  1026. glBitmapDefaultWrapT: Cardinal;
  1027. glBitmapDefaultWrapR: Cardinal;
  1028. glDefaultSwizzle: array[0..3] of GLenum;
  1029. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1030. type
  1031. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1032. public
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1034. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1035. function CreateMappingData: Pointer; virtual;
  1036. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1037. function IsEmpty: Boolean; virtual;
  1038. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1039. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1040. constructor Create; virtual;
  1041. public
  1042. class procedure Init;
  1043. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1044. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1045. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1046. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1047. class procedure Clear;
  1048. class procedure Finalize;
  1049. end;
  1050. TFormatDescriptorClass = class of TFormatDescriptor;
  1051. TfdEmpty = class(TFormatDescriptor);
  1052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1053. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1054. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1055. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1056. end;
  1057. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1058. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1059. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1060. end;
  1061. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1062. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1063. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1064. end;
  1065. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1066. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1067. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1068. end;
  1069. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1072. end;
  1073. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. end;
  1077. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1078. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1079. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1080. end;
  1081. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1082. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1083. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1084. end;
  1085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1086. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1087. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1088. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1089. end;
  1090. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1091. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1092. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1093. end;
  1094. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1095. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1096. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1097. end;
  1098. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1099. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1100. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1101. end;
  1102. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1103. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1104. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1105. end;
  1106. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1107. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1108. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1109. end;
  1110. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. end;
  1114. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. end;
  1118. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1119. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1120. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1121. end;
  1122. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. end;
  1126. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1127. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1128. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1129. end;
  1130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1131. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1132. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1133. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1134. end;
  1135. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. end;
  1139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1140. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1141. procedure SetValues; override;
  1142. end;
  1143. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1144. procedure SetValues; override;
  1145. end;
  1146. TfdAlpha16us1 = class(TfdAlphaUS1)
  1147. procedure SetValues; override;
  1148. end;
  1149. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1150. procedure SetValues; override;
  1151. end;
  1152. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1153. procedure SetValues; override;
  1154. end;
  1155. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1156. procedure SetValues; override;
  1157. end;
  1158. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1159. procedure SetValues; override;
  1160. end;
  1161. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1162. procedure SetValues; override;
  1163. end;
  1164. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1165. procedure SetValues; override;
  1166. end;
  1167. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1168. procedure SetValues; override;
  1169. end;
  1170. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1171. procedure SetValues; override;
  1172. end;
  1173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1174. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1175. procedure SetValues; override;
  1176. end;
  1177. TfdRGBX4us1 = class(TfdUniversalUS1)
  1178. procedure SetValues; override;
  1179. end;
  1180. TfdXRGB4us1 = class(TfdUniversalUS1)
  1181. procedure SetValues; override;
  1182. end;
  1183. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1184. procedure SetValues; override;
  1185. end;
  1186. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1187. procedure SetValues; override;
  1188. end;
  1189. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1190. procedure SetValues; override;
  1191. end;
  1192. TfdRGB8ub3 = class(TfdRGBub3)
  1193. procedure SetValues; override;
  1194. end;
  1195. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1196. procedure SetValues; override;
  1197. end;
  1198. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1199. procedure SetValues; override;
  1200. end;
  1201. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1202. procedure SetValues; override;
  1203. end;
  1204. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1205. procedure SetValues; override;
  1206. end;
  1207. TfdRGB16us3 = class(TfdRGBus3)
  1208. procedure SetValues; override;
  1209. end;
  1210. TfdRGBA4us1 = class(TfdUniversalUS1)
  1211. procedure SetValues; override;
  1212. end;
  1213. TfdARGB4us1 = class(TfdUniversalUS1)
  1214. procedure SetValues; override;
  1215. end;
  1216. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1217. procedure SetValues; override;
  1218. end;
  1219. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1220. procedure SetValues; override;
  1221. end;
  1222. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1223. procedure SetValues; override;
  1224. end;
  1225. TfdARGB8ui1 = class(TfdUniversalUI1)
  1226. procedure SetValues; override;
  1227. end;
  1228. TfdRGBA8ub4 = class(TfdRGBAub4)
  1229. procedure SetValues; override;
  1230. end;
  1231. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1232. procedure SetValues; override;
  1233. end;
  1234. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1235. procedure SetValues; override;
  1236. end;
  1237. TfdRGBA16us4 = class(TfdRGBAus4)
  1238. procedure SetValues; override;
  1239. end;
  1240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1241. TfdBGRX4us1 = class(TfdUniversalUS1)
  1242. procedure SetValues; override;
  1243. end;
  1244. TfdXBGR4us1 = class(TfdUniversalUS1)
  1245. procedure SetValues; override;
  1246. end;
  1247. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1248. procedure SetValues; override;
  1249. end;
  1250. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1251. procedure SetValues; override;
  1252. end;
  1253. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1254. procedure SetValues; override;
  1255. end;
  1256. TfdBGR8ub3 = class(TfdBGRub3)
  1257. procedure SetValues; override;
  1258. end;
  1259. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1260. procedure SetValues; override;
  1261. end;
  1262. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1263. procedure SetValues; override;
  1264. end;
  1265. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1266. procedure SetValues; override;
  1267. end;
  1268. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1269. procedure SetValues; override;
  1270. end;
  1271. TfdBGR16us3 = class(TfdBGRus3)
  1272. procedure SetValues; override;
  1273. end;
  1274. TfdBGRA4us1 = class(TfdUniversalUS1)
  1275. procedure SetValues; override;
  1276. end;
  1277. TfdABGR4us1 = class(TfdUniversalUS1)
  1278. procedure SetValues; override;
  1279. end;
  1280. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1281. procedure SetValues; override;
  1282. end;
  1283. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1284. procedure SetValues; override;
  1285. end;
  1286. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1287. procedure SetValues; override;
  1288. end;
  1289. TfdABGR8ui1 = class(TfdUniversalUI1)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdBGRA8ub4 = class(TfdBGRAub4)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdBGRA16us4 = class(TfdBGRAus4)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdDepth16us1 = class(TfdDepthUS1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdDepth24ui1 = class(TfdDepthUI1)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdDepth32ui1 = class(TfdDepthUI1)
  1311. procedure SetValues; override;
  1312. end;
  1313. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1314. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1315. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1316. procedure SetValues; override;
  1317. end;
  1318. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1319. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1320. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1321. procedure SetValues; override;
  1322. end;
  1323. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1324. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1325. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1326. procedure SetValues; override;
  1327. end;
  1328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1329. TbmpBitfieldFormat = class(TFormatDescriptor)
  1330. public
  1331. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1332. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1333. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1334. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1335. end;
  1336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1337. TbmpColorTableEnty = packed record
  1338. b, g, r, a: Byte;
  1339. end;
  1340. TbmpColorTable = array of TbmpColorTableEnty;
  1341. TbmpColorTableFormat = class(TFormatDescriptor)
  1342. private
  1343. fColorTable: TbmpColorTable;
  1344. protected
  1345. procedure SetValues; override;
  1346. public
  1347. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1348. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1349. procedure CalcValues;
  1350. procedure CreateColorTable;
  1351. function CreateMappingData: Pointer; override;
  1352. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1353. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1354. destructor Destroy; override;
  1355. end;
  1356. const
  1357. LUMINANCE_WEIGHT_R = 0.30;
  1358. LUMINANCE_WEIGHT_G = 0.59;
  1359. LUMINANCE_WEIGHT_B = 0.11;
  1360. ALPHA_WEIGHT_R = 0.30;
  1361. ALPHA_WEIGHT_G = 0.59;
  1362. ALPHA_WEIGHT_B = 0.11;
  1363. DEPTH_WEIGHT_R = 0.333333333;
  1364. DEPTH_WEIGHT_G = 0.333333333;
  1365. DEPTH_WEIGHT_B = 0.333333333;
  1366. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1367. TfdEmpty,
  1368. TfdAlpha4ub1,
  1369. TfdAlpha8ub1,
  1370. TfdAlpha16us1,
  1371. TfdLuminance4ub1,
  1372. TfdLuminance8ub1,
  1373. TfdLuminance16us1,
  1374. TfdLuminance4Alpha4ub2,
  1375. TfdLuminance6Alpha2ub2,
  1376. TfdLuminance8Alpha8ub2,
  1377. TfdLuminance12Alpha4us2,
  1378. TfdLuminance16Alpha16us2,
  1379. TfdR3G3B2ub1,
  1380. TfdRGBX4us1,
  1381. TfdXRGB4us1,
  1382. TfdR5G6B5us1,
  1383. TfdRGB5X1us1,
  1384. TfdX1RGB5us1,
  1385. TfdRGB8ub3,
  1386. TfdRGBX8ui1,
  1387. TfdXRGB8ui1,
  1388. TfdRGB10X2ui1,
  1389. TfdX2RGB10ui1,
  1390. TfdRGB16us3,
  1391. TfdRGBA4us1,
  1392. TfdARGB4us1,
  1393. TfdRGB5A1us1,
  1394. TfdA1RGB5us1,
  1395. TfdRGBA8ui1,
  1396. TfdARGB8ui1,
  1397. TfdRGBA8ub4,
  1398. TfdRGB10A2ui1,
  1399. TfdA2RGB10ui1,
  1400. TfdRGBA16us4,
  1401. TfdBGRX4us1,
  1402. TfdXBGR4us1,
  1403. TfdB5G6R5us1,
  1404. TfdBGR5X1us1,
  1405. TfdX1BGR5us1,
  1406. TfdBGR8ub3,
  1407. TfdBGRX8ui1,
  1408. TfdXBGR8ui1,
  1409. TfdBGR10X2ui1,
  1410. TfdX2BGR10ui1,
  1411. TfdBGR16us3,
  1412. TfdBGRA4us1,
  1413. TfdABGR4us1,
  1414. TfdBGR5A1us1,
  1415. TfdA1BGR5us1,
  1416. TfdBGRA8ui1,
  1417. TfdABGR8ui1,
  1418. TfdBGRA8ub4,
  1419. TfdBGR10A2ui1,
  1420. TfdA2BGR10ui1,
  1421. TfdBGRA16us4,
  1422. TfdDepth16us1,
  1423. TfdDepth24ui1,
  1424. TfdDepth32ui1,
  1425. TfdS3tcDtx1RGBA,
  1426. TfdS3tcDtx3RGBA,
  1427. TfdS3tcDtx5RGBA
  1428. );
  1429. var
  1430. FormatDescriptorCS: TCriticalSection;
  1431. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1433. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1434. begin
  1435. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1436. end;
  1437. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1438. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1439. begin
  1440. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1441. end;
  1442. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1443. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1444. begin
  1445. result.Fields := [];
  1446. if (X >= 0) then
  1447. result.Fields := result.Fields + [ffX];
  1448. if (Y >= 0) then
  1449. result.Fields := result.Fields + [ffY];
  1450. result.X := Max(0, X);
  1451. result.Y := Max(0, Y);
  1452. end;
  1453. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1454. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1455. begin
  1456. result := glBitmapSize(X, Y);
  1457. end;
  1458. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1459. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1460. begin
  1461. result.r := r;
  1462. result.g := g;
  1463. result.b := b;
  1464. result.a := a;
  1465. end;
  1466. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1467. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1468. begin
  1469. result.r := r;
  1470. result.g := g;
  1471. result.b := b;
  1472. result.a := a;
  1473. end;
  1474. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1475. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1476. begin
  1477. result.r := r;
  1478. result.g := g;
  1479. result.b := b;
  1480. result.a := a;
  1481. end;
  1482. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1483. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1484. var
  1485. i: Integer;
  1486. begin
  1487. result := false;
  1488. for i := 0 to high(r1.arr) do
  1489. if (r1.arr[i] <> r2.arr[i]) then
  1490. exit;
  1491. result := true;
  1492. end;
  1493. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1494. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1495. var
  1496. i: Integer;
  1497. begin
  1498. result := false;
  1499. for i := 0 to high(r1.arr) do
  1500. if (r1.arr[i] <> r2.arr[i]) then
  1501. exit;
  1502. result := true;
  1503. end;
  1504. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1505. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1506. var
  1507. desc: TFormatDescriptor;
  1508. p, tmp: PByte;
  1509. x, y, i: Integer;
  1510. md: Pointer;
  1511. px: TglBitmapPixelData;
  1512. begin
  1513. result := nil;
  1514. desc := TFormatDescriptor.Get(aFormat);
  1515. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1516. exit;
  1517. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1518. md := desc.CreateMappingData;
  1519. try
  1520. tmp := p;
  1521. desc.PreparePixel(px);
  1522. for y := 0 to 4 do
  1523. for x := 0 to 4 do begin
  1524. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1525. for i := 0 to 3 do begin
  1526. if ((y < 3) and (y = i)) or
  1527. ((y = 3) and (i < 3)) or
  1528. ((y = 4) and (i = 3))
  1529. then
  1530. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1531. else if ((y < 4) and (i = 3)) or
  1532. ((y = 4) and (i < 3))
  1533. then
  1534. px.Data.arr[i] := px.Range.arr[i]
  1535. else
  1536. px.Data.arr[i] := 0; //px.Range.arr[i];
  1537. end;
  1538. desc.Map(px, tmp, md);
  1539. end;
  1540. finally
  1541. desc.FreeMappingData(md);
  1542. end;
  1543. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1544. end;
  1545. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1546. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1547. begin
  1548. result.r := r;
  1549. result.g := g;
  1550. result.b := b;
  1551. result.a := a;
  1552. end;
  1553. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1554. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1555. begin
  1556. result := [];
  1557. if (aFormat in [
  1558. //8bpp
  1559. tfAlpha4ub1, tfAlpha8ub1,
  1560. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1561. //16bpp
  1562. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1563. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1564. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1565. //24bpp
  1566. tfBGR8ub3, tfRGB8ub3,
  1567. //32bpp
  1568. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1569. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1570. then
  1571. result := result + [ ftBMP ];
  1572. if (aFormat in [
  1573. //8bbp
  1574. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1575. //16bbp
  1576. tfAlpha16us1, tfLuminance16us1,
  1577. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1578. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1579. //24bbp
  1580. tfBGR8ub3,
  1581. //32bbp
  1582. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1583. tfDepth24ui1, tfDepth32ui1])
  1584. then
  1585. result := result + [ftTGA];
  1586. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1587. result := result + [ftDDS];
  1588. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1589. if aFormat in [
  1590. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1591. tfRGB8ub3, tfRGBA8ui1,
  1592. tfBGR8ub3, tfBGRA8ui1] then
  1593. result := result + [ftPNG];
  1594. {$ENDIF}
  1595. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1596. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1597. result := result + [ftJPEG];
  1598. {$ENDIF}
  1599. end;
  1600. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1601. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1602. begin
  1603. while (aNumber and 1) = 0 do
  1604. aNumber := aNumber shr 1;
  1605. result := aNumber = 1;
  1606. end;
  1607. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1608. function GetTopMostBit(aBitSet: QWord): Integer;
  1609. begin
  1610. result := 0;
  1611. while aBitSet > 0 do begin
  1612. inc(result);
  1613. aBitSet := aBitSet shr 1;
  1614. end;
  1615. end;
  1616. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1617. function CountSetBits(aBitSet: QWord): Integer;
  1618. begin
  1619. result := 0;
  1620. while aBitSet > 0 do begin
  1621. if (aBitSet and 1) = 1 then
  1622. inc(result);
  1623. aBitSet := aBitSet shr 1;
  1624. end;
  1625. end;
  1626. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1627. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1628. begin
  1629. result := Trunc(
  1630. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1631. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1632. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1633. end;
  1634. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1635. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1636. begin
  1637. result := Trunc(
  1638. DEPTH_WEIGHT_R * aPixel.Data.r +
  1639. DEPTH_WEIGHT_G * aPixel.Data.g +
  1640. DEPTH_WEIGHT_B * aPixel.Data.b);
  1641. end;
  1642. {$IFDEF GLB_SDL_IMAGE}
  1643. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1644. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1646. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1647. begin
  1648. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1649. end;
  1650. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1651. begin
  1652. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1653. end;
  1654. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1655. begin
  1656. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1657. end;
  1658. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1659. begin
  1660. result := 0;
  1661. end;
  1662. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1663. begin
  1664. result := SDL_AllocRW;
  1665. if result = nil then
  1666. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1667. result^.seek := glBitmapRWseek;
  1668. result^.read := glBitmapRWread;
  1669. result^.write := glBitmapRWwrite;
  1670. result^.close := glBitmapRWclose;
  1671. result^.unknown.data1 := Stream;
  1672. end;
  1673. {$ENDIF}
  1674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1675. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1676. begin
  1677. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1678. end;
  1679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1680. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1681. begin
  1682. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1683. end;
  1684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1685. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1686. begin
  1687. glBitmapDefaultMipmap := aValue;
  1688. end;
  1689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1690. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1691. begin
  1692. glBitmapDefaultFormat := aFormat;
  1693. end;
  1694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1695. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1696. begin
  1697. glBitmapDefaultFilterMin := aMin;
  1698. glBitmapDefaultFilterMag := aMag;
  1699. end;
  1700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1701. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1702. begin
  1703. glBitmapDefaultWrapS := S;
  1704. glBitmapDefaultWrapT := T;
  1705. glBitmapDefaultWrapR := R;
  1706. end;
  1707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1708. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1709. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1710. begin
  1711. glDefaultSwizzle[0] := r;
  1712. glDefaultSwizzle[1] := g;
  1713. glDefaultSwizzle[2] := b;
  1714. glDefaultSwizzle[3] := a;
  1715. end;
  1716. {$IFEND}
  1717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1718. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1719. begin
  1720. result := glBitmapDefaultDeleteTextureOnFree;
  1721. end;
  1722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1723. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1724. begin
  1725. result := glBitmapDefaultFreeDataAfterGenTextures;
  1726. end;
  1727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1728. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1729. begin
  1730. result := glBitmapDefaultMipmap;
  1731. end;
  1732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1733. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1734. begin
  1735. result := glBitmapDefaultFormat;
  1736. end;
  1737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1738. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1739. begin
  1740. aMin := glBitmapDefaultFilterMin;
  1741. aMag := glBitmapDefaultFilterMag;
  1742. end;
  1743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1744. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1745. begin
  1746. S := glBitmapDefaultWrapS;
  1747. T := glBitmapDefaultWrapT;
  1748. R := glBitmapDefaultWrapR;
  1749. end;
  1750. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1752. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1753. begin
  1754. r := glDefaultSwizzle[0];
  1755. g := glDefaultSwizzle[1];
  1756. b := glDefaultSwizzle[2];
  1757. a := glDefaultSwizzle[3];
  1758. end;
  1759. {$IFEND}
  1760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1763. function TFormatDescriptor.CreateMappingData: Pointer;
  1764. begin
  1765. result := nil;
  1766. end;
  1767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1768. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1769. begin
  1770. //DUMMY
  1771. end;
  1772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1773. function TFormatDescriptor.IsEmpty: Boolean;
  1774. begin
  1775. result := (fFormat = tfEmpty);
  1776. end;
  1777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1779. var
  1780. i: Integer;
  1781. m: TglBitmapRec4ul;
  1782. begin
  1783. result := false;
  1784. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1785. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1786. m := Mask;
  1787. for i := 0 to 3 do
  1788. if (aMask.arr[i] <> m.arr[i]) then
  1789. exit;
  1790. result := true;
  1791. end;
  1792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1793. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1794. begin
  1795. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1796. aPixel.Data := Range;
  1797. aPixel.Format := fFormat;
  1798. aPixel.Range := Range;
  1799. end;
  1800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1801. constructor TFormatDescriptor.Create;
  1802. begin
  1803. inherited Create;
  1804. end;
  1805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1808. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1809. begin
  1810. aData^ := aPixel.Data.a;
  1811. inc(aData);
  1812. end;
  1813. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1814. begin
  1815. aPixel.Data.r := 0;
  1816. aPixel.Data.g := 0;
  1817. aPixel.Data.b := 0;
  1818. aPixel.Data.a := aData^;
  1819. inc(aData);
  1820. end;
  1821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1822. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1825. begin
  1826. aData^ := LuminanceWeight(aPixel);
  1827. inc(aData);
  1828. end;
  1829. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1830. begin
  1831. aPixel.Data.r := aData^;
  1832. aPixel.Data.g := aData^;
  1833. aPixel.Data.b := aData^;
  1834. aPixel.Data.a := 0;
  1835. inc(aData);
  1836. end;
  1837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1841. var
  1842. i: Integer;
  1843. begin
  1844. aData^ := 0;
  1845. for i := 0 to 3 do
  1846. if (Range.arr[i] > 0) then
  1847. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1848. inc(aData);
  1849. end;
  1850. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1851. var
  1852. i: Integer;
  1853. begin
  1854. for i := 0 to 3 do
  1855. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1856. inc(aData);
  1857. end;
  1858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1859. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1862. begin
  1863. inherited Map(aPixel, aData, aMapData);
  1864. aData^ := aPixel.Data.a;
  1865. inc(aData);
  1866. end;
  1867. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1868. begin
  1869. inherited Unmap(aData, aPixel, aMapData);
  1870. aPixel.Data.a := aData^;
  1871. inc(aData);
  1872. end;
  1873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1874. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1877. begin
  1878. aData^ := aPixel.Data.r;
  1879. inc(aData);
  1880. aData^ := aPixel.Data.g;
  1881. inc(aData);
  1882. aData^ := aPixel.Data.b;
  1883. inc(aData);
  1884. end;
  1885. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1886. begin
  1887. aPixel.Data.r := aData^;
  1888. inc(aData);
  1889. aPixel.Data.g := aData^;
  1890. inc(aData);
  1891. aPixel.Data.b := aData^;
  1892. inc(aData);
  1893. aPixel.Data.a := 0;
  1894. end;
  1895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1899. begin
  1900. aData^ := aPixel.Data.b;
  1901. inc(aData);
  1902. aData^ := aPixel.Data.g;
  1903. inc(aData);
  1904. aData^ := aPixel.Data.r;
  1905. inc(aData);
  1906. end;
  1907. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1908. begin
  1909. aPixel.Data.b := aData^;
  1910. inc(aData);
  1911. aPixel.Data.g := aData^;
  1912. inc(aData);
  1913. aPixel.Data.r := aData^;
  1914. inc(aData);
  1915. aPixel.Data.a := 0;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1920. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1921. begin
  1922. inherited Map(aPixel, aData, aMapData);
  1923. aData^ := aPixel.Data.a;
  1924. inc(aData);
  1925. end;
  1926. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1927. begin
  1928. inherited Unmap(aData, aPixel, aMapData);
  1929. aPixel.Data.a := aData^;
  1930. inc(aData);
  1931. end;
  1932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1933. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1936. begin
  1937. inherited Map(aPixel, aData, aMapData);
  1938. aData^ := aPixel.Data.a;
  1939. inc(aData);
  1940. end;
  1941. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1942. begin
  1943. inherited Unmap(aData, aPixel, aMapData);
  1944. aPixel.Data.a := aData^;
  1945. inc(aData);
  1946. end;
  1947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1951. begin
  1952. PWord(aData)^ := aPixel.Data.a;
  1953. inc(aData, 2);
  1954. end;
  1955. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1956. begin
  1957. aPixel.Data.r := 0;
  1958. aPixel.Data.g := 0;
  1959. aPixel.Data.b := 0;
  1960. aPixel.Data.a := PWord(aData)^;
  1961. inc(aData, 2);
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1967. begin
  1968. PWord(aData)^ := LuminanceWeight(aPixel);
  1969. inc(aData, 2);
  1970. end;
  1971. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1972. begin
  1973. aPixel.Data.r := PWord(aData)^;
  1974. aPixel.Data.g := PWord(aData)^;
  1975. aPixel.Data.b := PWord(aData)^;
  1976. aPixel.Data.a := 0;
  1977. inc(aData, 2);
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1983. var
  1984. i: Integer;
  1985. begin
  1986. PWord(aData)^ := 0;
  1987. for i := 0 to 3 do
  1988. if (Range.arr[i] > 0) then
  1989. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1990. inc(aData, 2);
  1991. end;
  1992. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1993. var
  1994. i: Integer;
  1995. begin
  1996. for i := 0 to 3 do
  1997. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  1998. inc(aData, 2);
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2003. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2004. begin
  2005. PWord(aData)^ := DepthWeight(aPixel);
  2006. inc(aData, 2);
  2007. end;
  2008. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2009. begin
  2010. aPixel.Data.r := PWord(aData)^;
  2011. aPixel.Data.g := PWord(aData)^;
  2012. aPixel.Data.b := PWord(aData)^;
  2013. aPixel.Data.a := PWord(aData)^;;
  2014. inc(aData, 2);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2020. begin
  2021. inherited Map(aPixel, aData, aMapData);
  2022. PWord(aData)^ := aPixel.Data.a;
  2023. inc(aData, 2);
  2024. end;
  2025. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2026. begin
  2027. inherited Unmap(aData, aPixel, aMapData);
  2028. aPixel.Data.a := PWord(aData)^;
  2029. inc(aData, 2);
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2035. begin
  2036. PWord(aData)^ := aPixel.Data.r;
  2037. inc(aData, 2);
  2038. PWord(aData)^ := aPixel.Data.g;
  2039. inc(aData, 2);
  2040. PWord(aData)^ := aPixel.Data.b;
  2041. inc(aData, 2);
  2042. end;
  2043. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2044. begin
  2045. aPixel.Data.r := PWord(aData)^;
  2046. inc(aData, 2);
  2047. aPixel.Data.g := PWord(aData)^;
  2048. inc(aData, 2);
  2049. aPixel.Data.b := PWord(aData)^;
  2050. inc(aData, 2);
  2051. aPixel.Data.a := 0;
  2052. end;
  2053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2057. begin
  2058. PWord(aData)^ := aPixel.Data.b;
  2059. inc(aData, 2);
  2060. PWord(aData)^ := aPixel.Data.g;
  2061. inc(aData, 2);
  2062. PWord(aData)^ := aPixel.Data.r;
  2063. inc(aData, 2);
  2064. end;
  2065. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2066. begin
  2067. aPixel.Data.b := PWord(aData)^;
  2068. inc(aData, 2);
  2069. aPixel.Data.g := PWord(aData)^;
  2070. inc(aData, 2);
  2071. aPixel.Data.r := PWord(aData)^;
  2072. inc(aData, 2);
  2073. aPixel.Data.a := 0;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2078. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2079. begin
  2080. inherited Map(aPixel, aData, aMapData);
  2081. PWord(aData)^ := aPixel.Data.a;
  2082. inc(aData, 2);
  2083. end;
  2084. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2085. begin
  2086. inherited Unmap(aData, aPixel, aMapData);
  2087. aPixel.Data.a := PWord(aData)^;
  2088. inc(aData, 2);
  2089. end;
  2090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2091. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2093. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2094. begin
  2095. PWord(aData)^ := aPixel.Data.a;
  2096. inc(aData, 2);
  2097. inherited Map(aPixel, aData, aMapData);
  2098. end;
  2099. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2100. begin
  2101. aPixel.Data.a := PWord(aData)^;
  2102. inc(aData, 2);
  2103. inherited Unmap(aData, aPixel, aMapData);
  2104. end;
  2105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2109. begin
  2110. inherited Map(aPixel, aData, aMapData);
  2111. PWord(aData)^ := aPixel.Data.a;
  2112. inc(aData, 2);
  2113. end;
  2114. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2115. begin
  2116. inherited Unmap(aData, aPixel, aMapData);
  2117. aPixel.Data.a := PWord(aData)^;
  2118. inc(aData, 2);
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2123. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2124. begin
  2125. PWord(aData)^ := aPixel.Data.a;
  2126. inc(aData, 2);
  2127. inherited Map(aPixel, aData, aMapData);
  2128. end;
  2129. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2130. begin
  2131. aPixel.Data.a := PWord(aData)^;
  2132. inc(aData, 2);
  2133. inherited Unmap(aData, aPixel, aMapData);
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2139. var
  2140. i: Integer;
  2141. begin
  2142. PCardinal(aData)^ := 0;
  2143. for i := 0 to 3 do
  2144. if (Range.arr[i] > 0) then
  2145. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2146. inc(aData, 4);
  2147. end;
  2148. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2149. var
  2150. i: Integer;
  2151. begin
  2152. for i := 0 to 3 do
  2153. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2154. inc(aData, 2);
  2155. end;
  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2160. begin
  2161. PCardinal(aData)^ := DepthWeight(aPixel);
  2162. inc(aData, 4);
  2163. end;
  2164. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2165. begin
  2166. aPixel.Data.r := PCardinal(aData)^;
  2167. aPixel.Data.g := PCardinal(aData)^;
  2168. aPixel.Data.b := PCardinal(aData)^;
  2169. aPixel.Data.a := PCardinal(aData)^;
  2170. inc(aData, 4);
  2171. end;
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. procedure TfdAlpha4ub1.SetValues;
  2176. begin
  2177. inherited SetValues;
  2178. fBitsPerPixel := 8;
  2179. fFormat := tfAlpha4ub1;
  2180. fWithAlpha := tfAlpha4ub1;
  2181. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2182. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2183. {$IFNDEF OPENGL_ES}
  2184. fOpenGLFormat := tfAlpha4ub1;
  2185. fglFormat := GL_ALPHA;
  2186. fglInternalFormat := GL_ALPHA4;
  2187. fglDataFormat := GL_UNSIGNED_BYTE;
  2188. {$ELSE}
  2189. fOpenGLFormat := tfAlpha8ub1;
  2190. {$ENDIF}
  2191. end;
  2192. procedure TfdAlpha8ub1.SetValues;
  2193. begin
  2194. inherited SetValues;
  2195. fBitsPerPixel := 8;
  2196. fFormat := tfAlpha8ub1;
  2197. fWithAlpha := tfAlpha8ub1;
  2198. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2199. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2200. fOpenGLFormat := tfAlpha8ub1;
  2201. fglFormat := GL_ALPHA;
  2202. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2203. fglDataFormat := GL_UNSIGNED_BYTE;
  2204. end;
  2205. procedure TfdAlpha16us1.SetValues;
  2206. begin
  2207. inherited SetValues;
  2208. fBitsPerPixel := 16;
  2209. fFormat := tfAlpha16us1;
  2210. fWithAlpha := tfAlpha16us1;
  2211. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2212. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2213. {$IFNDEF OPENGL_ES}
  2214. fOpenGLFormat := tfAlpha16us1;
  2215. fglFormat := GL_ALPHA;
  2216. fglInternalFormat := GL_ALPHA16;
  2217. fglDataFormat := GL_UNSIGNED_SHORT;
  2218. {$ELSE}
  2219. fOpenGLFormat := tfAlpha8ub1;
  2220. {$ENDIF}
  2221. end;
  2222. procedure TfdLuminance4ub1.SetValues;
  2223. begin
  2224. inherited SetValues;
  2225. fBitsPerPixel := 8;
  2226. fFormat := tfLuminance4ub1;
  2227. fWithAlpha := tfLuminance4Alpha4ub2;
  2228. fWithoutAlpha := tfLuminance4ub1;
  2229. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2230. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2231. {$IFNDEF OPENGL_ES}
  2232. fOpenGLFormat := tfLuminance4ub1;
  2233. fglFormat := GL_LUMINANCE;
  2234. fglInternalFormat := GL_LUMINANCE4;
  2235. fglDataFormat := GL_UNSIGNED_BYTE;
  2236. {$ELSE}
  2237. fOpenGLFormat := tfLuminance8ub1;
  2238. {$ENDIF}
  2239. end;
  2240. procedure TfdLuminance8ub1.SetValues;
  2241. begin
  2242. inherited SetValues;
  2243. fBitsPerPixel := 8;
  2244. fFormat := tfLuminance8ub1;
  2245. fWithAlpha := tfLuminance8Alpha8ub2;
  2246. fWithoutAlpha := tfLuminance8ub1;
  2247. fOpenGLFormat := tfLuminance8ub1;
  2248. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2249. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2250. fglFormat := GL_LUMINANCE;
  2251. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2252. fglDataFormat := GL_UNSIGNED_BYTE;
  2253. end;
  2254. procedure TfdLuminance16us1.SetValues;
  2255. begin
  2256. inherited SetValues;
  2257. fBitsPerPixel := 16;
  2258. fFormat := tfLuminance16us1;
  2259. fWithAlpha := tfLuminance16Alpha16us2;
  2260. fWithoutAlpha := tfLuminance16us1;
  2261. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2262. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2263. {$IFNDEF OPENGL_ES}
  2264. fOpenGLFormat := tfLuminance16us1;
  2265. fglFormat := GL_LUMINANCE;
  2266. fglInternalFormat := GL_LUMINANCE16;
  2267. fglDataFormat := GL_UNSIGNED_SHORT;
  2268. {$ELSE}
  2269. fOpenGLFormat := tfLuminance8ub1;
  2270. {$ENDIF}
  2271. end;
  2272. procedure TfdLuminance4Alpha4ub2.SetValues;
  2273. begin
  2274. inherited SetValues;
  2275. fBitsPerPixel := 16;
  2276. fFormat := tfLuminance4Alpha4ub2;
  2277. fWithAlpha := tfLuminance4Alpha4ub2;
  2278. fWithoutAlpha := tfLuminance4ub1;
  2279. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2280. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2281. {$IFNDEF OPENGL_ES}
  2282. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2283. fglFormat := GL_LUMINANCE_ALPHA;
  2284. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2285. fglDataFormat := GL_UNSIGNED_BYTE;
  2286. {$ELSE}
  2287. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2288. {$ENDIF}
  2289. end;
  2290. procedure TfdLuminance6Alpha2ub2.SetValues;
  2291. begin
  2292. inherited SetValues;
  2293. fBitsPerPixel := 16;
  2294. fFormat := tfLuminance6Alpha2ub2;
  2295. fWithAlpha := tfLuminance6Alpha2ub2;
  2296. fWithoutAlpha := tfLuminance8ub1;
  2297. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2298. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2299. {$IFNDEF OPENGL_ES}
  2300. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2301. fglFormat := GL_LUMINANCE_ALPHA;
  2302. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2303. fglDataFormat := GL_UNSIGNED_BYTE;
  2304. {$ELSE}
  2305. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2306. {$ENDIF}
  2307. end;
  2308. procedure TfdLuminance8Alpha8ub2.SetValues;
  2309. begin
  2310. inherited SetValues;
  2311. fBitsPerPixel := 16;
  2312. fFormat := tfLuminance8Alpha8ub2;
  2313. fWithAlpha := tfLuminance8Alpha8ub2;
  2314. fWithoutAlpha := tfLuminance8ub1;
  2315. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2316. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2317. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2318. fglFormat := GL_LUMINANCE_ALPHA;
  2319. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2320. fglDataFormat := GL_UNSIGNED_BYTE;
  2321. end;
  2322. procedure TfdLuminance12Alpha4us2.SetValues;
  2323. begin
  2324. inherited SetValues;
  2325. fBitsPerPixel := 32;
  2326. fFormat := tfLuminance12Alpha4us2;
  2327. fWithAlpha := tfLuminance12Alpha4us2;
  2328. fWithoutAlpha := tfLuminance16us1;
  2329. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2330. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2331. {$IFNDEF OPENGL_ES}
  2332. fOpenGLFormat := tfLuminance12Alpha4us2;
  2333. fglFormat := GL_LUMINANCE_ALPHA;
  2334. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2335. fglDataFormat := GL_UNSIGNED_SHORT;
  2336. {$ELSE}
  2337. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2338. {$ENDIF}
  2339. end;
  2340. procedure TfdLuminance16Alpha16us2.SetValues;
  2341. begin
  2342. inherited SetValues;
  2343. fBitsPerPixel := 32;
  2344. fFormat := tfLuminance16Alpha16us2;
  2345. fWithAlpha := tfLuminance16Alpha16us2;
  2346. fWithoutAlpha := tfLuminance16us1;
  2347. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2348. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2349. {$IFNDEF OPENGL_ES}
  2350. fOpenGLFormat := tfLuminance16Alpha16us2;
  2351. fglFormat := GL_LUMINANCE_ALPHA;
  2352. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2353. fglDataFormat := GL_UNSIGNED_SHORT;
  2354. {$ELSE}
  2355. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2356. {$ENDIF}
  2357. end;
  2358. procedure TfdR3G3B2ub1.SetValues;
  2359. begin
  2360. inherited SetValues;
  2361. fBitsPerPixel := 8;
  2362. fFormat := tfR3G3B2ub1;
  2363. fWithAlpha := tfRGBA4us1;
  2364. fWithoutAlpha := tfR3G3B2ub1;
  2365. fRGBInverted := tfEmpty;
  2366. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2367. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2368. {$IFNDEF OPENGL_ES}
  2369. fOpenGLFormat := tfR3G3B2ub1;
  2370. fglFormat := GL_RGB;
  2371. fglInternalFormat := GL_R3_G3_B2;
  2372. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2373. {$ELSE}
  2374. fOpenGLFormat := tfR5G6B5us1;
  2375. {$ENDIF}
  2376. end;
  2377. procedure TfdRGBX4us1.SetValues;
  2378. begin
  2379. inherited SetValues;
  2380. fBitsPerPixel := 16;
  2381. fFormat := tfRGBX4us1;
  2382. fWithAlpha := tfRGBA4us1;
  2383. fWithoutAlpha := tfRGBX4us1;
  2384. fRGBInverted := tfBGRX4us1;
  2385. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2386. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2387. {$IFNDEF OPENGL_ES}
  2388. fOpenGLFormat := tfRGBX4us1;
  2389. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2390. fglInternalFormat := GL_RGB4;
  2391. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2392. {$ELSE}
  2393. fOpenGLFormat := tfR5G6B5us1;
  2394. {$ENDIF}
  2395. end;
  2396. procedure TfdXRGB4us1.SetValues;
  2397. begin
  2398. inherited SetValues;
  2399. fBitsPerPixel := 16;
  2400. fFormat := tfXRGB4us1;
  2401. fWithAlpha := tfARGB4us1;
  2402. fWithoutAlpha := tfXRGB4us1;
  2403. fRGBInverted := tfXBGR4us1;
  2404. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2405. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2406. {$IFNDEF OPENGL_ES}
  2407. fOpenGLFormat := tfXRGB4us1;
  2408. fglFormat := GL_BGRA;
  2409. fglInternalFormat := GL_RGB4;
  2410. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2411. {$ELSE}
  2412. fOpenGLFormat := tfR5G6B5us1;
  2413. {$ENDIF}
  2414. end;
  2415. procedure TfdR5G6B5us1.SetValues;
  2416. begin
  2417. inherited SetValues;
  2418. fBitsPerPixel := 16;
  2419. fFormat := tfR5G6B5us1;
  2420. fWithAlpha := tfRGB5A1us1;
  2421. fWithoutAlpha := tfR5G6B5us1;
  2422. fRGBInverted := tfB5G6R5us1;
  2423. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2424. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2425. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2426. fOpenGLFormat := tfR5G6B5us1;
  2427. fglFormat := GL_RGB;
  2428. fglInternalFormat := GL_RGB565;
  2429. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2430. {$ELSE}
  2431. fOpenGLFormat := tfRGB8ub3;
  2432. {$IFEND}
  2433. end;
  2434. procedure TfdRGB5X1us1.SetValues;
  2435. begin
  2436. inherited SetValues;
  2437. fBitsPerPixel := 16;
  2438. fFormat := tfRGB5X1us1;
  2439. fWithAlpha := tfRGB5A1us1;
  2440. fWithoutAlpha := tfRGB5X1us1;
  2441. fRGBInverted := tfBGR5X1us1;
  2442. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2443. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2444. {$IFNDEF OPENGL_ES}
  2445. fOpenGLFormat := tfRGB5X1us1;
  2446. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2447. fglInternalFormat := GL_RGB5;
  2448. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2449. {$ELSE}
  2450. fOpenGLFormat := tfR5G6B5us1;
  2451. {$ENDIF}
  2452. end;
  2453. procedure TfdX1RGB5us1.SetValues;
  2454. begin
  2455. inherited SetValues;
  2456. fBitsPerPixel := 16;
  2457. fFormat := tfX1RGB5us1;
  2458. fWithAlpha := tfA1RGB5us1;
  2459. fWithoutAlpha := tfX1RGB5us1;
  2460. fRGBInverted := tfX1BGR5us1;
  2461. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2462. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2463. {$IFNDEF OPENGL_ES}
  2464. fOpenGLFormat := tfX1RGB5us1;
  2465. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2466. fglInternalFormat := GL_RGB5;
  2467. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2468. {$ELSE}
  2469. fOpenGLFormat := tfR5G6B5us1;
  2470. {$ENDIF}
  2471. end;
  2472. procedure TfdRGB8ub3.SetValues;
  2473. begin
  2474. inherited SetValues;
  2475. fBitsPerPixel := 24;
  2476. fFormat := tfRGB8ub3;
  2477. fWithAlpha := tfRGBA8ub4;
  2478. fWithoutAlpha := tfRGB8ub3;
  2479. fRGBInverted := tfBGR8ub3;
  2480. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2481. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2482. fOpenGLFormat := tfRGB8ub3;
  2483. fglFormat := GL_RGB;
  2484. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2485. fglDataFormat := GL_UNSIGNED_BYTE;
  2486. end;
  2487. procedure TfdRGBX8ui1.SetValues;
  2488. begin
  2489. inherited SetValues;
  2490. fBitsPerPixel := 32;
  2491. fFormat := tfRGBX8ui1;
  2492. fWithAlpha := tfRGBA8ui1;
  2493. fWithoutAlpha := tfRGBX8ui1;
  2494. fRGBInverted := tfBGRX8ui1;
  2495. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2496. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2497. {$IFNDEF OPENGL_ES}
  2498. fOpenGLFormat := tfRGBX8ui1;
  2499. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2500. fglInternalFormat := GL_RGB8;
  2501. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2502. {$ELSE}
  2503. fOpenGLFormat := tfRGB8ub3;
  2504. {$ENDIF}
  2505. end;
  2506. procedure TfdXRGB8ui1.SetValues;
  2507. begin
  2508. inherited SetValues;
  2509. fBitsPerPixel := 32;
  2510. fFormat := tfXRGB8ui1;
  2511. fWithAlpha := tfXRGB8ui1;
  2512. fWithoutAlpha := tfXRGB8ui1;
  2513. fOpenGLFormat := tfXRGB8ui1;
  2514. fRGBInverted := tfXBGR8ui1;
  2515. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2516. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2517. {$IFNDEF OPENGL_ES}
  2518. fOpenGLFormat := tfXRGB8ui1;
  2519. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2520. fglInternalFormat := GL_RGB8;
  2521. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2522. {$ELSE}
  2523. fOpenGLFormat := tfRGB8ub3;
  2524. {$ENDIF}
  2525. end;
  2526. procedure TfdRGB10X2ui1.SetValues;
  2527. begin
  2528. inherited SetValues;
  2529. fBitsPerPixel := 32;
  2530. fFormat := tfRGB10X2ui1;
  2531. fWithAlpha := tfRGB10A2ui1;
  2532. fWithoutAlpha := tfRGB10X2ui1;
  2533. fRGBInverted := tfBGR10X2ui1;
  2534. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2535. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2536. {$IFNDEF OPENGL_ES}
  2537. fOpenGLFormat := tfRGB10X2ui1;
  2538. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2539. fglInternalFormat := GL_RGB10;
  2540. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2541. {$ELSE}
  2542. fOpenGLFormat := tfRGB16us3;
  2543. {$ENDIF}
  2544. end;
  2545. procedure TfdX2RGB10ui1.SetValues;
  2546. begin
  2547. inherited SetValues;
  2548. fBitsPerPixel := 32;
  2549. fFormat := tfX2RGB10ui1;
  2550. fWithAlpha := tfA2RGB10ui1;
  2551. fWithoutAlpha := tfX2RGB10ui1;
  2552. fRGBInverted := tfX2BGR10ui1;
  2553. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2554. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2555. {$IFNDEF OPENGL_ES}
  2556. fOpenGLFormat := tfX2RGB10ui1;
  2557. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2558. fglInternalFormat := GL_RGB10;
  2559. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2560. {$ELSE}
  2561. fOpenGLFormat := tfRGB16us3;
  2562. {$ENDIF}
  2563. end;
  2564. procedure TfdRGB16us3.SetValues;
  2565. begin
  2566. inherited SetValues;
  2567. fBitsPerPixel := 48;
  2568. fFormat := tfRGB16us3;
  2569. fWithAlpha := tfRGBA16us4;
  2570. fWithoutAlpha := tfRGB16us3;
  2571. fRGBInverted := tfBGR16us3;
  2572. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2573. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2574. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2575. fOpenGLFormat := tfRGB16us3;
  2576. fglFormat := GL_RGB;
  2577. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2578. fglDataFormat := GL_UNSIGNED_SHORT;
  2579. {$ELSE}
  2580. fOpenGLFormat := tfRGB8ub3;
  2581. {$IFEND}
  2582. end;
  2583. procedure TfdRGBA4us1.SetValues;
  2584. begin
  2585. inherited SetValues;
  2586. fBitsPerPixel := 16;
  2587. fFormat := tfRGBA4us1;
  2588. fWithAlpha := tfRGBA4us1;
  2589. fWithoutAlpha := tfRGBX4us1;
  2590. fOpenGLFormat := tfRGBA4us1;
  2591. fRGBInverted := tfBGRA4us1;
  2592. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2593. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2594. fglFormat := GL_RGBA;
  2595. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2596. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2597. end;
  2598. procedure TfdARGB4us1.SetValues;
  2599. begin
  2600. inherited SetValues;
  2601. fBitsPerPixel := 16;
  2602. fFormat := tfARGB4us1;
  2603. fWithAlpha := tfARGB4us1;
  2604. fWithoutAlpha := tfXRGB4us1;
  2605. fRGBInverted := tfABGR4us1;
  2606. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2607. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2608. {$IFNDEF OPENGL_ES}
  2609. fOpenGLFormat := tfARGB4us1;
  2610. fglFormat := GL_BGRA;
  2611. fglInternalFormat := GL_RGBA4;
  2612. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2613. {$ELSE}
  2614. fOpenGLFormat := tfRGBA4us1;
  2615. {$ENDIF}
  2616. end;
  2617. procedure TfdRGB5A1us1.SetValues;
  2618. begin
  2619. inherited SetValues;
  2620. fBitsPerPixel := 16;
  2621. fFormat := tfRGB5A1us1;
  2622. fWithAlpha := tfRGB5A1us1;
  2623. fWithoutAlpha := tfRGB5X1us1;
  2624. fOpenGLFormat := tfRGB5A1us1;
  2625. fRGBInverted := tfBGR5A1us1;
  2626. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2627. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2628. fglFormat := GL_RGBA;
  2629. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2630. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2631. end;
  2632. procedure TfdA1RGB5us1.SetValues;
  2633. begin
  2634. inherited SetValues;
  2635. fBitsPerPixel := 16;
  2636. fFormat := tfA1RGB5us1;
  2637. fWithAlpha := tfA1RGB5us1;
  2638. fWithoutAlpha := tfX1RGB5us1;
  2639. fRGBInverted := tfA1BGR5us1;
  2640. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2641. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2642. {$IFNDEF OPENGL_ES}
  2643. fOpenGLFormat := tfA1RGB5us1;
  2644. fglFormat := GL_BGRA;
  2645. fglInternalFormat := GL_RGB5_A1;
  2646. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2647. {$ELSE}
  2648. fOpenGLFormat := tfRGB5A1us1;
  2649. {$ENDIF}
  2650. end;
  2651. procedure TfdRGBA8ui1.SetValues;
  2652. begin
  2653. inherited SetValues;
  2654. fBitsPerPixel := 32;
  2655. fFormat := tfRGBA8ui1;
  2656. fWithAlpha := tfRGBA8ui1;
  2657. fWithoutAlpha := tfRGBX8ui1;
  2658. fRGBInverted := tfBGRA8ui1;
  2659. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2660. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2661. {$IFNDEF OPENGL_ES}
  2662. fOpenGLFormat := tfRGBA8ui1;
  2663. fglFormat := GL_RGBA;
  2664. fglInternalFormat := GL_RGBA8;
  2665. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2666. {$ELSE}
  2667. fOpenGLFormat := tfRGBA8ub4;
  2668. {$ENDIF}
  2669. end;
  2670. procedure TfdARGB8ui1.SetValues;
  2671. begin
  2672. inherited SetValues;
  2673. fBitsPerPixel := 32;
  2674. fFormat := tfARGB8ui1;
  2675. fWithAlpha := tfARGB8ui1;
  2676. fWithoutAlpha := tfXRGB8ui1;
  2677. fRGBInverted := tfABGR8ui1;
  2678. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2679. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2680. {$IFNDEF OPENGL_ES}
  2681. fOpenGLFormat := tfARGB8ui1;
  2682. fglFormat := GL_BGRA;
  2683. fglInternalFormat := GL_RGBA8;
  2684. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2685. {$ELSE}
  2686. fOpenGLFormat := tfRGBA8ub4;
  2687. {$ENDIF}
  2688. end;
  2689. procedure TfdRGBA8ub4.SetValues;
  2690. begin
  2691. inherited SetValues;
  2692. fBitsPerPixel := 32;
  2693. fFormat := tfRGBA8ub4;
  2694. fWithAlpha := tfRGBA8ub4;
  2695. fWithoutAlpha := tfRGB8ub3;
  2696. fOpenGLFormat := tfRGBA8ub4;
  2697. fRGBInverted := tfBGRA8ub4;
  2698. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2699. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2700. fglFormat := GL_RGBA;
  2701. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2702. fglDataFormat := GL_UNSIGNED_BYTE;
  2703. end;
  2704. procedure TfdRGB10A2ui1.SetValues;
  2705. begin
  2706. inherited SetValues;
  2707. fBitsPerPixel := 32;
  2708. fFormat := tfRGB10A2ui1;
  2709. fWithAlpha := tfRGB10A2ui1;
  2710. fWithoutAlpha := tfRGB10X2ui1;
  2711. fRGBInverted := tfBGR10A2ui1;
  2712. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2713. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2714. {$IFNDEF OPENGL_ES}
  2715. fOpenGLFormat := tfRGB10A2ui1;
  2716. fglFormat := GL_RGBA;
  2717. fglInternalFormat := GL_RGB10_A2;
  2718. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2719. {$ELSE}
  2720. fOpenGLFormat := tfA2RGB10ui1;
  2721. {$ENDIF}
  2722. end;
  2723. procedure TfdA2RGB10ui1.SetValues;
  2724. begin
  2725. inherited SetValues;
  2726. fBitsPerPixel := 32;
  2727. fFormat := tfA2RGB10ui1;
  2728. fWithAlpha := tfA2RGB10ui1;
  2729. fWithoutAlpha := tfX2RGB10ui1;
  2730. fRGBInverted := tfA2BGR10ui1;
  2731. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2732. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2733. {$IF NOT DEFINED(OPENGL_ES)}
  2734. fOpenGLFormat := tfA2RGB10ui1;
  2735. fglFormat := GL_BGRA;
  2736. fglInternalFormat := GL_RGB10_A2;
  2737. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2738. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2739. fOpenGLFormat := tfA2RGB10ui1;
  2740. fglFormat := GL_RGBA;
  2741. fglInternalFormat := GL_RGB10_A2;
  2742. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2743. {$ELSE}
  2744. fOpenGLFormat := tfRGBA8ui1;
  2745. {$IFEND}
  2746. end;
  2747. procedure TfdRGBA16us4.SetValues;
  2748. begin
  2749. inherited SetValues;
  2750. fBitsPerPixel := 64;
  2751. fFormat := tfRGBA16us4;
  2752. fWithAlpha := tfRGBA16us4;
  2753. fWithoutAlpha := tfRGB16us3;
  2754. fRGBInverted := tfBGRA16us4;
  2755. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2756. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2757. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2758. fOpenGLFormat := tfRGBA16us4;
  2759. fglFormat := GL_RGBA;
  2760. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2761. fglDataFormat := GL_UNSIGNED_SHORT;
  2762. {$ELSE}
  2763. fOpenGLFormat := tfRGBA8ub4;
  2764. {$IFEND}
  2765. end;
  2766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2769. procedure TfdBGRX4us1.SetValues;
  2770. begin
  2771. inherited SetValues;
  2772. fBitsPerPixel := 16;
  2773. fFormat := tfBGRX4us1;
  2774. fWithAlpha := tfBGRA4us1;
  2775. fWithoutAlpha := tfBGRX4us1;
  2776. fRGBInverted := tfRGBX4us1;
  2777. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2778. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2779. {$IFNDEF OPENGL_ES}
  2780. fOpenGLFormat := tfBGRX4us1;
  2781. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2782. fglInternalFormat := GL_RGB4;
  2783. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2784. {$ELSE}
  2785. fOpenGLFormat := tfR5G6B5us1;
  2786. {$ENDIF}
  2787. end;
  2788. procedure TfdXBGR4us1.SetValues;
  2789. begin
  2790. inherited SetValues;
  2791. fBitsPerPixel := 16;
  2792. fFormat := tfXBGR4us1;
  2793. fWithAlpha := tfABGR4us1;
  2794. fWithoutAlpha := tfXBGR4us1;
  2795. fRGBInverted := tfXRGB4us1;
  2796. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2797. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2798. {$IFNDEF OPENGL_ES}
  2799. fOpenGLFormat := tfXBGR4us1;
  2800. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2801. fglInternalFormat := GL_RGB4;
  2802. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2803. {$ELSE}
  2804. fOpenGLFormat := tfR5G6B5us1;
  2805. {$ENDIF}
  2806. end;
  2807. procedure TfdB5G6R5us1.SetValues;
  2808. begin
  2809. inherited SetValues;
  2810. fBitsPerPixel := 16;
  2811. fFormat := tfB5G6R5us1;
  2812. fWithAlpha := tfBGR5A1us1;
  2813. fWithoutAlpha := tfB5G6R5us1;
  2814. fRGBInverted := tfR5G6B5us1;
  2815. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2816. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2817. {$IFNDEF OPENGL_ES}
  2818. fOpenGLFormat := tfB5G6R5us1;
  2819. fglFormat := GL_RGB;
  2820. fglInternalFormat := GL_RGB565;
  2821. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2822. {$ELSE}
  2823. fOpenGLFormat := tfR5G6B5us1;
  2824. {$ENDIF}
  2825. end;
  2826. procedure TfdBGR5X1us1.SetValues;
  2827. begin
  2828. inherited SetValues;
  2829. fBitsPerPixel := 16;
  2830. fFormat := tfBGR5X1us1;
  2831. fWithAlpha := tfBGR5A1us1;
  2832. fWithoutAlpha := tfBGR5X1us1;
  2833. fRGBInverted := tfRGB5X1us1;
  2834. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2835. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2836. {$IFNDEF OPENGL_ES}
  2837. fOpenGLFormat := tfBGR5X1us1;
  2838. fglFormat := GL_BGRA;
  2839. fglInternalFormat := GL_RGB5;
  2840. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2841. {$ELSE}
  2842. fOpenGLFormat := tfR5G6B5us1;
  2843. {$ENDIF}
  2844. end;
  2845. procedure TfdX1BGR5us1.SetValues;
  2846. begin
  2847. inherited SetValues;
  2848. fBitsPerPixel := 16;
  2849. fFormat := tfX1BGR5us1;
  2850. fWithAlpha := tfA1BGR5us1;
  2851. fWithoutAlpha := tfX1BGR5us1;
  2852. fRGBInverted := tfX1RGB5us1;
  2853. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2854. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2855. {$IFNDEF OPENGL_ES}
  2856. fOpenGLFormat := tfX1BGR5us1;
  2857. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2858. fglInternalFormat := GL_RGB5;
  2859. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2860. {$ELSE}
  2861. fOpenGLFormat := tfR5G6B5us1;
  2862. {$ENDIF}
  2863. end;
  2864. procedure TfdBGR8ub3.SetValues;
  2865. begin
  2866. inherited SetValues;
  2867. fBitsPerPixel := 24;
  2868. fFormat := tfBGR8ub3;
  2869. fWithAlpha := tfBGRA8ub4;
  2870. fWithoutAlpha := tfBGR8ub3;
  2871. fRGBInverted := tfRGB8ub3;
  2872. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2873. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2874. {$IFNDEF OPENGL_ES}
  2875. fOpenGLFormat := tfBGR8ub3;
  2876. fglFormat := GL_BGR;
  2877. fglInternalFormat := GL_RGB8;
  2878. fglDataFormat := GL_UNSIGNED_BYTE;
  2879. {$ELSE}
  2880. fOpenGLFormat := tfRGB8ub3;
  2881. {$ENDIF}
  2882. end;
  2883. procedure TfdBGRX8ui1.SetValues;
  2884. begin
  2885. inherited SetValues;
  2886. fBitsPerPixel := 32;
  2887. fFormat := tfBGRX8ui1;
  2888. fWithAlpha := tfBGRA8ui1;
  2889. fWithoutAlpha := tfBGRX8ui1;
  2890. fRGBInverted := tfRGBX8ui1;
  2891. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2892. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2893. {$IFNDEF OPENGL_ES}
  2894. fOpenGLFormat := tfBGRX8ui1;
  2895. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2896. fglInternalFormat := GL_RGB8;
  2897. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2898. {$ELSE}
  2899. fOpenGLFormat := tfRGB8ub3;
  2900. {$ENDIF}
  2901. end;
  2902. procedure TfdXBGR8ui1.SetValues;
  2903. begin
  2904. inherited SetValues;
  2905. fBitsPerPixel := 32;
  2906. fFormat := tfXBGR8ui1;
  2907. fWithAlpha := tfABGR8ui1;
  2908. fWithoutAlpha := tfXBGR8ui1;
  2909. fRGBInverted := tfXRGB8ui1;
  2910. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2911. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2912. {$IFNDEF OPENGL_ES}
  2913. fOpenGLFormat := tfXBGR8ui1;
  2914. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2915. fglInternalFormat := GL_RGB8;
  2916. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2917. {$ELSE}
  2918. fOpenGLFormat := tfRGB8ub3;
  2919. {$ENDIF}
  2920. end;
  2921. procedure TfdBGR10X2ui1.SetValues;
  2922. begin
  2923. inherited SetValues;
  2924. fBitsPerPixel := 32;
  2925. fFormat := tfBGR10X2ui1;
  2926. fWithAlpha := tfBGR10A2ui1;
  2927. fWithoutAlpha := tfBGR10X2ui1;
  2928. fRGBInverted := tfRGB10X2ui1;
  2929. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2930. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2931. {$IFNDEF OPENGL_ES}
  2932. fOpenGLFormat := tfBGR10X2ui1;
  2933. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2934. fglInternalFormat := GL_RGB10;
  2935. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2936. {$ELSE}
  2937. fOpenGLFormat := tfRGB16us3;
  2938. {$ENDIF}
  2939. end;
  2940. procedure TfdX2BGR10ui1.SetValues;
  2941. begin
  2942. inherited SetValues;
  2943. fBitsPerPixel := 32;
  2944. fFormat := tfX2BGR10ui1;
  2945. fWithAlpha := tfA2BGR10ui1;
  2946. fWithoutAlpha := tfX2BGR10ui1;
  2947. fRGBInverted := tfX2RGB10ui1;
  2948. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2949. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2950. {$IFNDEF OPENGL_ES}
  2951. fOpenGLFormat := tfX2BGR10ui1;
  2952. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2953. fglInternalFormat := GL_RGB10;
  2954. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2955. {$ELSE}
  2956. fOpenGLFormat := tfRGB16us3;
  2957. {$ENDIF}
  2958. end;
  2959. procedure TfdBGR16us3.SetValues;
  2960. begin
  2961. inherited SetValues;
  2962. fBitsPerPixel := 48;
  2963. fFormat := tfBGR16us3;
  2964. fWithAlpha := tfBGRA16us4;
  2965. fWithoutAlpha := tfBGR16us3;
  2966. fRGBInverted := tfRGB16us3;
  2967. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2968. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2969. {$IFNDEF OPENGL_ES}
  2970. fOpenGLFormat := tfBGR16us3;
  2971. fglFormat := GL_BGR;
  2972. fglInternalFormat := GL_RGB16;
  2973. fglDataFormat := GL_UNSIGNED_SHORT;
  2974. {$ELSE}
  2975. fOpenGLFormat := tfRGB16us3;
  2976. {$ENDIF}
  2977. end;
  2978. procedure TfdBGRA4us1.SetValues;
  2979. begin
  2980. inherited SetValues;
  2981. fBitsPerPixel := 16;
  2982. fFormat := tfBGRA4us1;
  2983. fWithAlpha := tfBGRA4us1;
  2984. fWithoutAlpha := tfBGRX4us1;
  2985. fRGBInverted := tfRGBA4us1;
  2986. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2987. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2988. {$IFNDEF OPENGL_ES}
  2989. fOpenGLFormat := tfBGRA4us1;
  2990. fglFormat := GL_BGRA;
  2991. fglInternalFormat := GL_RGBA4;
  2992. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2993. {$ELSE}
  2994. fOpenGLFormat := tfRGBA4us1;
  2995. {$ENDIF}
  2996. end;
  2997. procedure TfdABGR4us1.SetValues;
  2998. begin
  2999. inherited SetValues;
  3000. fBitsPerPixel := 16;
  3001. fFormat := tfABGR4us1;
  3002. fWithAlpha := tfABGR4us1;
  3003. fWithoutAlpha := tfXBGR4us1;
  3004. fRGBInverted := tfARGB4us1;
  3005. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3006. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3007. {$IFNDEF OPENGL_ES}
  3008. fOpenGLFormat := tfABGR4us1;
  3009. fglFormat := GL_RGBA;
  3010. fglInternalFormat := GL_RGBA4;
  3011. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3012. {$ELSE}
  3013. fOpenGLFormat := tfRGBA4us1;
  3014. {$ENDIF}
  3015. end;
  3016. procedure TfdBGR5A1us1.SetValues;
  3017. begin
  3018. inherited SetValues;
  3019. fBitsPerPixel := 16;
  3020. fFormat := tfBGR5A1us1;
  3021. fWithAlpha := tfBGR5A1us1;
  3022. fWithoutAlpha := tfBGR5X1us1;
  3023. fRGBInverted := tfRGB5A1us1;
  3024. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3025. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3026. {$IFNDEF OPENGL_ES}
  3027. fOpenGLFormat := tfBGR5A1us1;
  3028. fglFormat := GL_BGRA;
  3029. fglInternalFormat := GL_RGB5_A1;
  3030. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3031. {$ELSE}
  3032. fOpenGLFormat := tfRGB5A1us1;
  3033. {$ENDIF}
  3034. end;
  3035. procedure TfdA1BGR5us1.SetValues;
  3036. begin
  3037. inherited SetValues;
  3038. fBitsPerPixel := 16;
  3039. fFormat := tfA1BGR5us1;
  3040. fWithAlpha := tfA1BGR5us1;
  3041. fWithoutAlpha := tfX1BGR5us1;
  3042. fRGBInverted := tfA1RGB5us1;
  3043. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3044. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3045. {$IFNDEF OPENGL_ES}
  3046. fOpenGLFormat := tfA1BGR5us1;
  3047. fglFormat := GL_RGBA;
  3048. fglInternalFormat := GL_RGB5_A1;
  3049. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3050. {$ELSE}
  3051. fOpenGLFormat := tfRGB5A1us1;
  3052. {$ENDIF}
  3053. end;
  3054. procedure TfdBGRA8ui1.SetValues;
  3055. begin
  3056. inherited SetValues;
  3057. fBitsPerPixel := 32;
  3058. fFormat := tfBGRA8ui1;
  3059. fWithAlpha := tfBGRA8ui1;
  3060. fWithoutAlpha := tfBGRX8ui1;
  3061. fRGBInverted := tfRGBA8ui1;
  3062. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3063. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3064. {$IFNDEF OPENGL_ES}
  3065. fOpenGLFormat := tfBGRA8ui1;
  3066. fglFormat := GL_BGRA;
  3067. fglInternalFormat := GL_RGBA8;
  3068. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3069. {$ELSE}
  3070. fOpenGLFormat := tfRGBA8ub4;
  3071. {$ENDIF}
  3072. end;
  3073. procedure TfdABGR8ui1.SetValues;
  3074. begin
  3075. inherited SetValues;
  3076. fBitsPerPixel := 32;
  3077. fFormat := tfABGR8ui1;
  3078. fWithAlpha := tfABGR8ui1;
  3079. fWithoutAlpha := tfXBGR8ui1;
  3080. fRGBInverted := tfARGB8ui1;
  3081. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3082. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3083. {$IFNDEF OPENGL_ES}
  3084. fOpenGLFormat := tfABGR8ui1;
  3085. fglFormat := GL_RGBA;
  3086. fglInternalFormat := GL_RGBA8;
  3087. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3088. {$ELSE}
  3089. fOpenGLFormat := tfRGBA8ub4
  3090. {$ENDIF}
  3091. end;
  3092. procedure TfdBGRA8ub4.SetValues;
  3093. begin
  3094. inherited SetValues;
  3095. fBitsPerPixel := 32;
  3096. fFormat := tfBGRA8ub4;
  3097. fWithAlpha := tfBGRA8ub4;
  3098. fWithoutAlpha := tfBGR8ub3;
  3099. fRGBInverted := tfRGBA8ub4;
  3100. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3101. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3102. {$IFNDEF OPENGL_ES}
  3103. fOpenGLFormat := tfBGRA8ub4;
  3104. fglFormat := GL_BGRA;
  3105. fglInternalFormat := GL_RGBA8;
  3106. fglDataFormat := GL_UNSIGNED_BYTE;
  3107. {$ELSE}
  3108. fOpenGLFormat := tfRGBA8ub4;
  3109. {$ENDIF}
  3110. end;
  3111. procedure TfdBGR10A2ui1.SetValues;
  3112. begin
  3113. inherited SetValues;
  3114. fBitsPerPixel := 32;
  3115. fFormat := tfBGR10A2ui1;
  3116. fWithAlpha := tfBGR10A2ui1;
  3117. fWithoutAlpha := tfBGR10X2ui1;
  3118. fRGBInverted := tfRGB10A2ui1;
  3119. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3120. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3121. {$IFNDEF OPENGL_ES}
  3122. fOpenGLFormat := tfBGR10A2ui1;
  3123. fglFormat := GL_BGRA;
  3124. fglInternalFormat := GL_RGB10_A2;
  3125. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3126. {$ELSE}
  3127. fOpenGLFormat := tfA2RGB10ui1;
  3128. {$ENDIF}
  3129. end;
  3130. procedure TfdA2BGR10ui1.SetValues;
  3131. begin
  3132. inherited SetValues;
  3133. fBitsPerPixel := 32;
  3134. fFormat := tfA2BGR10ui1;
  3135. fWithAlpha := tfA2BGR10ui1;
  3136. fWithoutAlpha := tfX2BGR10ui1;
  3137. fRGBInverted := tfA2RGB10ui1;
  3138. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3139. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3140. {$IFNDEF OPENGL_ES}
  3141. fOpenGLFormat := tfA2BGR10ui1;
  3142. fglFormat := GL_RGBA;
  3143. fglInternalFormat := GL_RGB10_A2;
  3144. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3145. {$ELSE}
  3146. fOpenGLFormat := tfA2RGB10ui1;
  3147. {$ENDIF}
  3148. end;
  3149. procedure TfdBGRA16us4.SetValues;
  3150. begin
  3151. inherited SetValues;
  3152. fBitsPerPixel := 64;
  3153. fFormat := tfBGRA16us4;
  3154. fWithAlpha := tfBGRA16us4;
  3155. fWithoutAlpha := tfBGR16us3;
  3156. fRGBInverted := tfRGBA16us4;
  3157. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3158. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3159. {$IFNDEF OPENGL_ES}
  3160. fOpenGLFormat := tfBGRA16us4;
  3161. fglFormat := GL_BGRA;
  3162. fglInternalFormat := GL_RGBA16;
  3163. fglDataFormat := GL_UNSIGNED_SHORT;
  3164. {$ELSE}
  3165. fOpenGLFormat := tfRGBA16us4;
  3166. {$ENDIF}
  3167. end;
  3168. procedure TfdDepth16us1.SetValues;
  3169. begin
  3170. inherited SetValues;
  3171. fBitsPerPixel := 16;
  3172. fFormat := tfDepth16us1;
  3173. fWithoutAlpha := tfDepth16us1;
  3174. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3175. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3176. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3177. fOpenGLFormat := tfDepth16us1;
  3178. fglFormat := GL_DEPTH_COMPONENT;
  3179. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3180. fglDataFormat := GL_UNSIGNED_SHORT;
  3181. {$IFEND}
  3182. end;
  3183. procedure TfdDepth24ui1.SetValues;
  3184. begin
  3185. inherited SetValues;
  3186. fBitsPerPixel := 32;
  3187. fFormat := tfDepth24ui1;
  3188. fWithoutAlpha := tfDepth24ui1;
  3189. fOpenGLFormat := tfDepth24ui1;
  3190. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3191. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3192. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3193. fOpenGLFormat := tfDepth24ui1;
  3194. fglFormat := GL_DEPTH_COMPONENT;
  3195. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3196. fglDataFormat := GL_UNSIGNED_INT;
  3197. {$IFEND}
  3198. end;
  3199. procedure TfdDepth32ui1.SetValues;
  3200. begin
  3201. inherited SetValues;
  3202. fBitsPerPixel := 32;
  3203. fFormat := tfDepth32ui1;
  3204. fWithoutAlpha := tfDepth32ui1;
  3205. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3206. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3207. {$IF NOT DEFINED(OPENGL_ES)}
  3208. fOpenGLFormat := tfDepth32ui1;
  3209. fglFormat := GL_DEPTH_COMPONENT;
  3210. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3211. fglDataFormat := GL_UNSIGNED_INT;
  3212. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3213. fOpenGLFormat := tfDepth24ui1;
  3214. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3215. fOpenGLFormat := tfDepth16us1;
  3216. {$IFEND}
  3217. end;
  3218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3219. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3222. begin
  3223. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3224. end;
  3225. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3226. begin
  3227. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3228. end;
  3229. procedure TfdS3tcDtx1RGBA.SetValues;
  3230. begin
  3231. inherited SetValues;
  3232. fFormat := tfS3tcDtx1RGBA;
  3233. fWithAlpha := tfS3tcDtx1RGBA;
  3234. fUncompressed := tfRGB5A1us1;
  3235. fBitsPerPixel := 4;
  3236. fIsCompressed := true;
  3237. {$IFNDEF OPENGL_ES}
  3238. fOpenGLFormat := tfS3tcDtx1RGBA;
  3239. fglFormat := GL_COMPRESSED_RGBA;
  3240. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3241. fglDataFormat := GL_UNSIGNED_BYTE;
  3242. {$ELSE}
  3243. fOpenGLFormat := fUncompressed;
  3244. {$ENDIF}
  3245. end;
  3246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3247. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3249. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3250. begin
  3251. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3252. end;
  3253. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3254. begin
  3255. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3256. end;
  3257. procedure TfdS3tcDtx3RGBA.SetValues;
  3258. begin
  3259. inherited SetValues;
  3260. fFormat := tfS3tcDtx3RGBA;
  3261. fWithAlpha := tfS3tcDtx3RGBA;
  3262. fUncompressed := tfRGBA8ub4;
  3263. fBitsPerPixel := 8;
  3264. fIsCompressed := true;
  3265. {$IFNDEF OPENGL_ES}
  3266. fOpenGLFormat := tfS3tcDtx3RGBA;
  3267. fglFormat := GL_COMPRESSED_RGBA;
  3268. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3269. fglDataFormat := GL_UNSIGNED_BYTE;
  3270. {$ELSE}
  3271. fOpenGLFormat := fUncompressed;
  3272. {$ENDIF}
  3273. end;
  3274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3275. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3277. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3278. begin
  3279. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3280. end;
  3281. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3282. begin
  3283. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3284. end;
  3285. procedure TfdS3tcDtx5RGBA.SetValues;
  3286. begin
  3287. inherited SetValues;
  3288. fFormat := tfS3tcDtx3RGBA;
  3289. fWithAlpha := tfS3tcDtx3RGBA;
  3290. fUncompressed := tfRGBA8ub4;
  3291. fBitsPerPixel := 8;
  3292. fIsCompressed := true;
  3293. {$IFNDEF OPENGL_ES}
  3294. fOpenGLFormat := tfS3tcDtx3RGBA;
  3295. fglFormat := GL_COMPRESSED_RGBA;
  3296. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3297. fglDataFormat := GL_UNSIGNED_BYTE;
  3298. {$ELSE}
  3299. fOpenGLFormat := fUncompressed;
  3300. {$ENDIF}
  3301. end;
  3302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3303. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3305. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3306. begin
  3307. result := (fPrecision.r > 0);
  3308. end;
  3309. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3310. begin
  3311. result := (fPrecision.g > 0);
  3312. end;
  3313. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3314. begin
  3315. result := (fPrecision.b > 0);
  3316. end;
  3317. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3318. begin
  3319. result := (fPrecision.a > 0);
  3320. end;
  3321. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3322. begin
  3323. result := HasRed or HasGreen or HasBlue;
  3324. end;
  3325. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3326. begin
  3327. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3328. end;
  3329. function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
  3330. begin
  3331. result := (OpenGLFormat = Format);
  3332. end;
  3333. procedure TglBitmapFormatDescriptor.SetValues;
  3334. begin
  3335. fFormat := tfEmpty;
  3336. fWithAlpha := tfEmpty;
  3337. fWithoutAlpha := tfEmpty;
  3338. fOpenGLFormat := tfEmpty;
  3339. fRGBInverted := tfEmpty;
  3340. fUncompressed := tfEmpty;
  3341. fBitsPerPixel := 0;
  3342. fIsCompressed := false;
  3343. fglFormat := 0;
  3344. fglInternalFormat := 0;
  3345. fglDataFormat := 0;
  3346. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3347. FillChar(fShift, 0, SizeOf(fShift));
  3348. end;
  3349. procedure TglBitmapFormatDescriptor.CalcValues;
  3350. var
  3351. i: Integer;
  3352. begin
  3353. fBytesPerPixel := fBitsPerPixel / 8;
  3354. fChannelCount := 0;
  3355. for i := 0 to 3 do begin
  3356. if (fPrecision.arr[i] > 0) then
  3357. inc(fChannelCount);
  3358. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3359. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3360. end;
  3361. end;
  3362. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3363. var
  3364. w, h: Integer;
  3365. begin
  3366. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3367. w := Max(1, aSize.X);
  3368. h := Max(1, aSize.Y);
  3369. result := GetSize(w, h);
  3370. end else
  3371. result := 0;
  3372. end;
  3373. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3374. begin
  3375. result := 0;
  3376. if (aWidth <= 0) or (aHeight <= 0) then
  3377. exit;
  3378. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3379. end;
  3380. constructor TglBitmapFormatDescriptor.Create;
  3381. begin
  3382. inherited Create;
  3383. SetValues;
  3384. CalcValues;
  3385. end;
  3386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3387. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3388. var
  3389. f: TglBitmapFormat;
  3390. begin
  3391. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3392. result := TFormatDescriptor.Get(f);
  3393. if (result.glInternalFormat = aInternalFormat) then
  3394. exit;
  3395. end;
  3396. result := TFormatDescriptor.Get(tfEmpty);
  3397. end;
  3398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3401. class procedure TFormatDescriptor.Init;
  3402. begin
  3403. if not Assigned(FormatDescriptorCS) then
  3404. FormatDescriptorCS := TCriticalSection.Create;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3408. begin
  3409. FormatDescriptorCS.Enter;
  3410. try
  3411. result := FormatDescriptors[aFormat];
  3412. if not Assigned(result) then begin
  3413. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3414. FormatDescriptors[aFormat] := result;
  3415. end;
  3416. finally
  3417. FormatDescriptorCS.Leave;
  3418. end;
  3419. end;
  3420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3421. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3422. begin
  3423. result := Get(Get(aFormat).WithAlpha);
  3424. end;
  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3426. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3427. var
  3428. ft: TglBitmapFormat;
  3429. begin
  3430. // find matching format with OpenGL support
  3431. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3432. result := Get(ft);
  3433. if (result.MaskMatch(aMask)) and
  3434. (result.glFormat <> 0) and
  3435. (result.glInternalFormat <> 0) and
  3436. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3437. then
  3438. exit;
  3439. end;
  3440. // find matching format without OpenGL Support
  3441. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3442. result := Get(ft);
  3443. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3444. exit;
  3445. end;
  3446. result := TFormatDescriptor.Get(tfEmpty);
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3450. var
  3451. ft: TglBitmapFormat;
  3452. begin
  3453. // find matching format with OpenGL support
  3454. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3455. result := Get(ft);
  3456. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3457. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3458. (result.glFormat <> 0) and
  3459. (result.glInternalFormat <> 0) and
  3460. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3461. then
  3462. exit;
  3463. end;
  3464. // find matching format without OpenGL Support
  3465. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3466. result := Get(ft);
  3467. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3468. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3469. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3470. exit;
  3471. end;
  3472. result := TFormatDescriptor.Get(tfEmpty);
  3473. end;
  3474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3475. class procedure TFormatDescriptor.Clear;
  3476. var
  3477. f: TglBitmapFormat;
  3478. begin
  3479. FormatDescriptorCS.Enter;
  3480. try
  3481. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3482. FreeAndNil(FormatDescriptors[f]);
  3483. finally
  3484. FormatDescriptorCS.Leave;
  3485. end;
  3486. end;
  3487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3488. class procedure TFormatDescriptor.Finalize;
  3489. begin
  3490. Clear;
  3491. FreeAndNil(FormatDescriptorCS);
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3496. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3497. var
  3498. i: Integer;
  3499. begin
  3500. for i := 0 to 3 do begin
  3501. fShift.arr[i] := 0;
  3502. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3503. aMask.arr[i] := aMask.arr[i] shr 1;
  3504. inc(fShift.arr[i]);
  3505. end;
  3506. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3507. end;
  3508. fBitsPerPixel := aBPP;
  3509. CalcValues;
  3510. end;
  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3512. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3513. begin
  3514. fBitsPerPixel := aBBP;
  3515. fPrecision := aPrec;
  3516. fShift := aShift;
  3517. CalcValues;
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3521. var
  3522. data: QWord;
  3523. begin
  3524. data :=
  3525. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3526. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3527. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3528. ((aPixel.Data.a and Range.a) shl Shift.a);
  3529. case BitsPerPixel of
  3530. 8: aData^ := data;
  3531. 16: PWord(aData)^ := data;
  3532. 32: PCardinal(aData)^ := data;
  3533. 64: PQWord(aData)^ := data;
  3534. else
  3535. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3536. end;
  3537. inc(aData, Round(BytesPerPixel));
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3541. var
  3542. data: QWord;
  3543. i: Integer;
  3544. begin
  3545. case BitsPerPixel of
  3546. 8: data := aData^;
  3547. 16: data := PWord(aData)^;
  3548. 32: data := PCardinal(aData)^;
  3549. 64: data := PQWord(aData)^;
  3550. else
  3551. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3552. end;
  3553. for i := 0 to 3 do
  3554. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3555. inc(aData, Round(BytesPerPixel));
  3556. end;
  3557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3558. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3560. procedure TbmpColorTableFormat.SetValues;
  3561. begin
  3562. inherited SetValues;
  3563. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3564. end;
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3567. begin
  3568. fFormat := aFormat;
  3569. fBitsPerPixel := aBPP;
  3570. fPrecision := aPrec;
  3571. fShift := aShift;
  3572. CalcValues;
  3573. end;
  3574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3575. procedure TbmpColorTableFormat.CalcValues;
  3576. begin
  3577. inherited CalcValues;
  3578. end;
  3579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3580. procedure TbmpColorTableFormat.CreateColorTable;
  3581. var
  3582. i: Integer;
  3583. begin
  3584. SetLength(fColorTable, 256);
  3585. if not HasColor then begin
  3586. // alpha
  3587. for i := 0 to High(fColorTable) do begin
  3588. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3589. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3590. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3591. fColorTable[i].a := 0;
  3592. end;
  3593. end else begin
  3594. // normal
  3595. for i := 0 to High(fColorTable) do begin
  3596. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3597. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3598. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3599. fColorTable[i].a := 0;
  3600. end;
  3601. end;
  3602. end;
  3603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3604. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3605. begin
  3606. result := Pointer(0);
  3607. end;
  3608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3609. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3610. begin
  3611. if (BitsPerPixel <> 8) then
  3612. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3613. if not HasColor then
  3614. // alpha
  3615. aData^ := aPixel.Data.a
  3616. else
  3617. // normal
  3618. aData^ := Round(
  3619. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3620. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3621. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3622. inc(aData);
  3623. end;
  3624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3625. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3626. function ReadValue: Byte;
  3627. var
  3628. i: PtrUInt;
  3629. begin
  3630. if (BitsPerPixel = 8) then begin
  3631. result := aData^;
  3632. inc(aData);
  3633. end else begin
  3634. i := {%H-}PtrUInt(aMapData);
  3635. if (BitsPerPixel > 1) then
  3636. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3637. else
  3638. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3639. inc(i, BitsPerPixel);
  3640. while (i >= 8) do begin
  3641. inc(aData);
  3642. dec(i, 8);
  3643. end;
  3644. aMapData := {%H-}Pointer(i);
  3645. end;
  3646. end;
  3647. begin
  3648. if (BitsPerPixel > 8) then
  3649. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3650. with fColorTable[ReadValue] do begin
  3651. aPixel.Data.r := r;
  3652. aPixel.Data.g := g;
  3653. aPixel.Data.b := b;
  3654. aPixel.Data.a := a;
  3655. end;
  3656. end;
  3657. destructor TbmpColorTableFormat.Destroy;
  3658. begin
  3659. SetLength(fColorTable, 0);
  3660. inherited Destroy;
  3661. end;
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3665. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3666. var
  3667. i: Integer;
  3668. begin
  3669. for i := 0 to 3 do begin
  3670. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3671. if (aSourceFD.Range.arr[i] > 0) then
  3672. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3673. else
  3674. aPixel.Data.arr[i] := 0;
  3675. end;
  3676. end;
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3680. begin
  3681. with aFuncRec do begin
  3682. if (Source.Range.r > 0) then
  3683. Dest.Data.r := Source.Data.r;
  3684. if (Source.Range.g > 0) then
  3685. Dest.Data.g := Source.Data.g;
  3686. if (Source.Range.b > 0) then
  3687. Dest.Data.b := Source.Data.b;
  3688. if (Source.Range.a > 0) then
  3689. Dest.Data.a := Source.Data.a;
  3690. end;
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3694. var
  3695. i: Integer;
  3696. begin
  3697. with aFuncRec do begin
  3698. for i := 0 to 3 do
  3699. if (Source.Range.arr[i] > 0) then
  3700. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3701. end;
  3702. end;
  3703. type
  3704. TShiftData = packed record
  3705. case Integer of
  3706. 0: (r, g, b, a: SmallInt);
  3707. 1: (arr: array[0..3] of SmallInt);
  3708. end;
  3709. PShiftData = ^TShiftData;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3712. var
  3713. i: Integer;
  3714. begin
  3715. with aFuncRec do
  3716. for i := 0 to 3 do
  3717. if (Source.Range.arr[i] > 0) then
  3718. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3719. end;
  3720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3721. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3722. var
  3723. i: Integer;
  3724. begin
  3725. with aFuncRec do begin
  3726. Dest.Data := Source.Data;
  3727. for i := 0 to 3 do
  3728. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3729. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3730. end;
  3731. end;
  3732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3733. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3734. var
  3735. i: Integer;
  3736. begin
  3737. with aFuncRec do begin
  3738. for i := 0 to 3 do
  3739. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3740. end;
  3741. end;
  3742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3743. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3744. var
  3745. Temp: Single;
  3746. begin
  3747. with FuncRec do begin
  3748. if (FuncRec.Args = nil) then begin //source has no alpha
  3749. Temp :=
  3750. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3751. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3752. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3753. Dest.Data.a := Round(Dest.Range.a * Temp);
  3754. end else
  3755. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3756. end;
  3757. end;
  3758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3759. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3760. type
  3761. PglBitmapPixelData = ^TglBitmapPixelData;
  3762. begin
  3763. with FuncRec do begin
  3764. Dest.Data.r := Source.Data.r;
  3765. Dest.Data.g := Source.Data.g;
  3766. Dest.Data.b := Source.Data.b;
  3767. with PglBitmapPixelData(Args)^ do
  3768. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3769. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3770. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3771. Dest.Data.a := 0
  3772. else
  3773. Dest.Data.a := Dest.Range.a;
  3774. end;
  3775. end;
  3776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3777. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3778. begin
  3779. with FuncRec do begin
  3780. Dest.Data.r := Source.Data.r;
  3781. Dest.Data.g := Source.Data.g;
  3782. Dest.Data.b := Source.Data.b;
  3783. Dest.Data.a := PCardinal(Args)^;
  3784. end;
  3785. end;
  3786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3788. type
  3789. PRGBPix = ^TRGBPix;
  3790. TRGBPix = array [0..2] of byte;
  3791. var
  3792. Temp: Byte;
  3793. begin
  3794. while aWidth > 0 do begin
  3795. Temp := PRGBPix(aData)^[0];
  3796. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3797. PRGBPix(aData)^[2] := Temp;
  3798. if aHasAlpha then
  3799. Inc(aData, 4)
  3800. else
  3801. Inc(aData, 3);
  3802. dec(aWidth);
  3803. end;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3808. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3809. begin
  3810. result := TFormatDescriptor.Get(fFormat);
  3811. end;
  3812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3813. function TglBitmapData.GetWidth: Integer;
  3814. begin
  3815. if (ffX in fDimension.Fields) then
  3816. result := fDimension.X
  3817. else
  3818. result := -1;
  3819. end;
  3820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3821. function TglBitmapData.GetHeight: Integer;
  3822. begin
  3823. if (ffY in fDimension.Fields) then
  3824. result := fDimension.Y
  3825. else
  3826. result := -1;
  3827. end;
  3828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3829. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3830. begin
  3831. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3832. result := fScanlines[aIndex]
  3833. else
  3834. result := nil;
  3835. end;
  3836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3838. begin
  3839. if fFormat = aValue then
  3840. exit;
  3841. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3842. raise EglBitmapUnsupportedFormat.Create(Format);
  3843. SetData(fData, aValue, Width, Height);
  3844. end;
  3845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3846. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3847. var
  3848. TempPos: Integer;
  3849. begin
  3850. if not Assigned(aResType) then begin
  3851. TempPos := Pos('.', aResource);
  3852. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3853. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3854. end;
  3855. end;
  3856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3857. procedure TglBitmapData.UpdateScanlines;
  3858. var
  3859. w, h, i, LineWidth: Integer;
  3860. begin
  3861. w := Width;
  3862. h := Height;
  3863. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3864. if fHasScanlines then begin
  3865. SetLength(fScanlines, h);
  3866. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3867. for i := 0 to h-1 do begin
  3868. fScanlines[i] := fData;
  3869. Inc(fScanlines[i], i * LineWidth);
  3870. end;
  3871. end else
  3872. SetLength(fScanlines, 0);
  3873. end;
  3874. {$IFDEF GLB_SUPPORT_PNG_READ}
  3875. {$IF DEFINED(GLB_LAZ_PNG)}
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3879. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3880. const
  3881. MAGIC_LEN = 8;
  3882. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3883. var
  3884. reader: TLazReaderPNG;
  3885. intf: TLazIntfImage;
  3886. StreamPos: Int64;
  3887. magic: String[MAGIC_LEN];
  3888. begin
  3889. result := true;
  3890. StreamPos := aStream.Position;
  3891. SetLength(magic, MAGIC_LEN);
  3892. aStream.Read(magic[1], MAGIC_LEN);
  3893. aStream.Position := StreamPos;
  3894. if (magic <> PNG_MAGIC) then begin
  3895. result := false;
  3896. exit;
  3897. end;
  3898. intf := TLazIntfImage.Create(0, 0);
  3899. reader := TLazReaderPNG.Create;
  3900. try try
  3901. reader.UpdateDescription := true;
  3902. reader.ImageRead(aStream, intf);
  3903. AssignFromLazIntfImage(intf);
  3904. except
  3905. result := false;
  3906. aStream.Position := StreamPos;
  3907. exit;
  3908. end;
  3909. finally
  3910. reader.Free;
  3911. intf.Free;
  3912. end;
  3913. end;
  3914. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3916. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3917. var
  3918. Surface: PSDL_Surface;
  3919. RWops: PSDL_RWops;
  3920. begin
  3921. result := false;
  3922. RWops := glBitmapCreateRWops(aStream);
  3923. try
  3924. if IMG_isPNG(RWops) > 0 then begin
  3925. Surface := IMG_LoadPNG_RW(RWops);
  3926. try
  3927. AssignFromSurface(Surface);
  3928. result := true;
  3929. finally
  3930. SDL_FreeSurface(Surface);
  3931. end;
  3932. end;
  3933. finally
  3934. SDL_FreeRW(RWops);
  3935. end;
  3936. end;
  3937. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3939. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3940. begin
  3941. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3942. end;
  3943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3944. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3945. var
  3946. StreamPos: Int64;
  3947. signature: array [0..7] of byte;
  3948. png: png_structp;
  3949. png_info: png_infop;
  3950. TempHeight, TempWidth: Integer;
  3951. Format: TglBitmapFormat;
  3952. png_data: pByte;
  3953. png_rows: array of pByte;
  3954. Row, LineSize: Integer;
  3955. begin
  3956. result := false;
  3957. if not init_libPNG then
  3958. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3959. try
  3960. // signature
  3961. StreamPos := aStream.Position;
  3962. aStream.Read(signature{%H-}, 8);
  3963. aStream.Position := StreamPos;
  3964. if png_check_sig(@signature, 8) <> 0 then begin
  3965. // png read struct
  3966. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3967. if png = nil then
  3968. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3969. // png info
  3970. png_info := png_create_info_struct(png);
  3971. if png_info = nil then begin
  3972. png_destroy_read_struct(@png, nil, nil);
  3973. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3974. end;
  3975. // set read callback
  3976. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  3977. // read informations
  3978. png_read_info(png, png_info);
  3979. // size
  3980. TempHeight := png_get_image_height(png, png_info);
  3981. TempWidth := png_get_image_width(png, png_info);
  3982. // format
  3983. case png_get_color_type(png, png_info) of
  3984. PNG_COLOR_TYPE_GRAY:
  3985. Format := tfLuminance8ub1;
  3986. PNG_COLOR_TYPE_GRAY_ALPHA:
  3987. Format := tfLuminance8Alpha8us1;
  3988. PNG_COLOR_TYPE_RGB:
  3989. Format := tfRGB8ub3;
  3990. PNG_COLOR_TYPE_RGB_ALPHA:
  3991. Format := tfRGBA8ub4;
  3992. else
  3993. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3994. end;
  3995. // cut upper 8 bit from 16 bit formats
  3996. if png_get_bit_depth(png, png_info) > 8 then
  3997. png_set_strip_16(png);
  3998. // expand bitdepth smaller than 8
  3999. if png_get_bit_depth(png, png_info) < 8 then
  4000. png_set_expand(png);
  4001. // allocating mem for scanlines
  4002. LineSize := png_get_rowbytes(png, png_info);
  4003. GetMem(png_data, TempHeight * LineSize);
  4004. try
  4005. SetLength(png_rows, TempHeight);
  4006. for Row := Low(png_rows) to High(png_rows) do begin
  4007. png_rows[Row] := png_data;
  4008. Inc(png_rows[Row], Row * LineSize);
  4009. end;
  4010. // read complete image into scanlines
  4011. png_read_image(png, @png_rows[0]);
  4012. // read end
  4013. png_read_end(png, png_info);
  4014. // destroy read struct
  4015. png_destroy_read_struct(@png, @png_info, nil);
  4016. SetLength(png_rows, 0);
  4017. // set new data
  4018. SetData(png_data, Format, TempWidth, TempHeight);
  4019. result := true;
  4020. except
  4021. if Assigned(png_data) then
  4022. FreeMem(png_data);
  4023. raise;
  4024. end;
  4025. end;
  4026. finally
  4027. quit_libPNG;
  4028. end;
  4029. end;
  4030. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4032. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4033. var
  4034. StreamPos: Int64;
  4035. Png: TPNGObject;
  4036. Header: String[8];
  4037. Row, Col, PixSize, LineSize: Integer;
  4038. NewImage, pSource, pDest, pAlpha: pByte;
  4039. PngFormat: TglBitmapFormat;
  4040. FormatDesc: TFormatDescriptor;
  4041. const
  4042. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4043. begin
  4044. result := false;
  4045. StreamPos := aStream.Position;
  4046. aStream.Read(Header[0], SizeOf(Header));
  4047. aStream.Position := StreamPos;
  4048. {Test if the header matches}
  4049. if Header = PngHeader then begin
  4050. Png := TPNGObject.Create;
  4051. try
  4052. Png.LoadFromStream(aStream);
  4053. case Png.Header.ColorType of
  4054. COLOR_GRAYSCALE:
  4055. PngFormat := tfLuminance8ub1;
  4056. COLOR_GRAYSCALEALPHA:
  4057. PngFormat := tfLuminance8Alpha8us1;
  4058. COLOR_RGB:
  4059. PngFormat := tfBGR8ub3;
  4060. COLOR_RGBALPHA:
  4061. PngFormat := tfBGRA8ub4;
  4062. else
  4063. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4064. end;
  4065. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4066. PixSize := Round(FormatDesc.PixelSize);
  4067. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4068. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4069. try
  4070. pDest := NewImage;
  4071. case Png.Header.ColorType of
  4072. COLOR_RGB, COLOR_GRAYSCALE:
  4073. begin
  4074. for Row := 0 to Png.Height -1 do begin
  4075. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4076. Inc(pDest, LineSize);
  4077. end;
  4078. end;
  4079. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4080. begin
  4081. PixSize := PixSize -1;
  4082. for Row := 0 to Png.Height -1 do begin
  4083. pSource := Png.Scanline[Row];
  4084. pAlpha := pByte(Png.AlphaScanline[Row]);
  4085. for Col := 0 to Png.Width -1 do begin
  4086. Move (pSource^, pDest^, PixSize);
  4087. Inc(pSource, PixSize);
  4088. Inc(pDest, PixSize);
  4089. pDest^ := pAlpha^;
  4090. inc(pAlpha);
  4091. Inc(pDest);
  4092. end;
  4093. end;
  4094. end;
  4095. else
  4096. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4097. end;
  4098. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4099. result := true;
  4100. except
  4101. if Assigned(NewImage) then
  4102. FreeMem(NewImage);
  4103. raise;
  4104. end;
  4105. finally
  4106. Png.Free;
  4107. end;
  4108. end;
  4109. end;
  4110. {$IFEND}
  4111. {$ENDIF}
  4112. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4113. {$IFDEF GLB_LIB_PNG}
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4116. begin
  4117. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4118. end;
  4119. {$ENDIF}
  4120. {$IF DEFINED(GLB_LAZ_PNG)}
  4121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4122. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4123. var
  4124. png: TPortableNetworkGraphic;
  4125. intf: TLazIntfImage;
  4126. raw: TRawImage;
  4127. begin
  4128. png := TPortableNetworkGraphic.Create;
  4129. intf := TLazIntfImage.Create(0, 0);
  4130. try
  4131. if not AssignToLazIntfImage(intf) then
  4132. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4133. intf.GetRawImage(raw);
  4134. png.LoadFromRawImage(raw, false);
  4135. png.SaveToStream(aStream);
  4136. finally
  4137. png.Free;
  4138. intf.Free;
  4139. end;
  4140. end;
  4141. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4143. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4144. var
  4145. png: png_structp;
  4146. png_info: png_infop;
  4147. png_rows: array of pByte;
  4148. LineSize: Integer;
  4149. ColorType: Integer;
  4150. Row: Integer;
  4151. FormatDesc: TFormatDescriptor;
  4152. begin
  4153. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4154. raise EglBitmapUnsupportedFormat.Create(Format);
  4155. if not init_libPNG then
  4156. raise Exception.Create('unable to initialize libPNG.');
  4157. try
  4158. case Format of
  4159. tfAlpha8ub1, tfLuminance8ub1:
  4160. ColorType := PNG_COLOR_TYPE_GRAY;
  4161. tfLuminance8Alpha8us1:
  4162. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4163. tfBGR8ub3, tfRGB8ub3:
  4164. ColorType := PNG_COLOR_TYPE_RGB;
  4165. tfBGRA8ub4, tfRGBA8ub4:
  4166. ColorType := PNG_COLOR_TYPE_RGBA;
  4167. else
  4168. raise EglBitmapUnsupportedFormat.Create(Format);
  4169. end;
  4170. FormatDesc := TFormatDescriptor.Get(Format);
  4171. LineSize := FormatDesc.GetSize(Width, 1);
  4172. // creating array for scanline
  4173. SetLength(png_rows, Height);
  4174. try
  4175. for Row := 0 to Height - 1 do begin
  4176. png_rows[Row] := Data;
  4177. Inc(png_rows[Row], Row * LineSize)
  4178. end;
  4179. // write struct
  4180. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4181. if png = nil then
  4182. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4183. // create png info
  4184. png_info := png_create_info_struct(png);
  4185. if png_info = nil then begin
  4186. png_destroy_write_struct(@png, nil);
  4187. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4188. end;
  4189. // set read callback
  4190. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4191. // set compression
  4192. png_set_compression_level(png, 6);
  4193. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4194. png_set_bgr(png);
  4195. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4196. png_write_info(png, png_info);
  4197. png_write_image(png, @png_rows[0]);
  4198. png_write_end(png, png_info);
  4199. png_destroy_write_struct(@png, @png_info);
  4200. finally
  4201. SetLength(png_rows, 0);
  4202. end;
  4203. finally
  4204. quit_libPNG;
  4205. end;
  4206. end;
  4207. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4209. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4210. var
  4211. Png: TPNGObject;
  4212. pSource, pDest: pByte;
  4213. X, Y, PixSize: Integer;
  4214. ColorType: Cardinal;
  4215. Alpha: Boolean;
  4216. pTemp: pByte;
  4217. Temp: Byte;
  4218. begin
  4219. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4220. raise EglBitmapUnsupportedFormat.Create(Format);
  4221. case Format of
  4222. tfAlpha8ub1, tfLuminance8ub1: begin
  4223. ColorType := COLOR_GRAYSCALE;
  4224. PixSize := 1;
  4225. Alpha := false;
  4226. end;
  4227. tfLuminance8Alpha8us1: begin
  4228. ColorType := COLOR_GRAYSCALEALPHA;
  4229. PixSize := 1;
  4230. Alpha := true;
  4231. end;
  4232. tfBGR8ub3, tfRGB8ub3: begin
  4233. ColorType := COLOR_RGB;
  4234. PixSize := 3;
  4235. Alpha := false;
  4236. end;
  4237. tfBGRA8ub4, tfRGBA8ub4: begin
  4238. ColorType := COLOR_RGBALPHA;
  4239. PixSize := 3;
  4240. Alpha := true
  4241. end;
  4242. else
  4243. raise EglBitmapUnsupportedFormat.Create(Format);
  4244. end;
  4245. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4246. try
  4247. // Copy ImageData
  4248. pSource := Data;
  4249. for Y := 0 to Height -1 do begin
  4250. pDest := png.ScanLine[Y];
  4251. for X := 0 to Width -1 do begin
  4252. Move(pSource^, pDest^, PixSize);
  4253. Inc(pDest, PixSize);
  4254. Inc(pSource, PixSize);
  4255. if Alpha then begin
  4256. png.AlphaScanline[Y]^[X] := pSource^;
  4257. Inc(pSource);
  4258. end;
  4259. end;
  4260. // convert RGB line to BGR
  4261. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4262. pTemp := png.ScanLine[Y];
  4263. for X := 0 to Width -1 do begin
  4264. Temp := pByteArray(pTemp)^[0];
  4265. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4266. pByteArray(pTemp)^[2] := Temp;
  4267. Inc(pTemp, 3);
  4268. end;
  4269. end;
  4270. end;
  4271. // Save to Stream
  4272. Png.CompressionLevel := 6;
  4273. Png.SaveToStream(aStream);
  4274. finally
  4275. FreeAndNil(Png);
  4276. end;
  4277. end;
  4278. {$IFEND}
  4279. {$ENDIF}
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4283. {$IFDEF GLB_LIB_JPEG}
  4284. type
  4285. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4286. glBitmap_libJPEG_source_mgr = record
  4287. pub: jpeg_source_mgr;
  4288. SrcStream: TStream;
  4289. SrcBuffer: array [1..4096] of byte;
  4290. end;
  4291. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4292. glBitmap_libJPEG_dest_mgr = record
  4293. pub: jpeg_destination_mgr;
  4294. DestStream: TStream;
  4295. DestBuffer: array [1..4096] of byte;
  4296. end;
  4297. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4298. begin
  4299. //DUMMY
  4300. end;
  4301. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4302. begin
  4303. //DUMMY
  4304. end;
  4305. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4306. begin
  4307. //DUMMY
  4308. end;
  4309. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4310. begin
  4311. //DUMMY
  4312. end;
  4313. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4314. begin
  4315. //DUMMY
  4316. end;
  4317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4318. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4319. var
  4320. src: glBitmap_libJPEG_source_mgr_ptr;
  4321. bytes: integer;
  4322. begin
  4323. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4324. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4325. if (bytes <= 0) then begin
  4326. src^.SrcBuffer[1] := $FF;
  4327. src^.SrcBuffer[2] := JPEG_EOI;
  4328. bytes := 2;
  4329. end;
  4330. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4331. src^.pub.bytes_in_buffer := bytes;
  4332. result := true;
  4333. end;
  4334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4335. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4336. var
  4337. src: glBitmap_libJPEG_source_mgr_ptr;
  4338. begin
  4339. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4340. if num_bytes > 0 then begin
  4341. // wanted byte isn't in buffer so set stream position and read buffer
  4342. if num_bytes > src^.pub.bytes_in_buffer then begin
  4343. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4344. src^.pub.fill_input_buffer(cinfo);
  4345. end else begin
  4346. // wanted byte is in buffer so only skip
  4347. inc(src^.pub.next_input_byte, num_bytes);
  4348. dec(src^.pub.bytes_in_buffer, num_bytes);
  4349. end;
  4350. end;
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4354. var
  4355. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4356. begin
  4357. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4358. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4359. // write complete buffer
  4360. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4361. // reset buffer
  4362. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4363. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4364. end;
  4365. result := true;
  4366. end;
  4367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4368. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4369. var
  4370. Idx: Integer;
  4371. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4372. begin
  4373. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4374. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4375. // check for endblock
  4376. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4377. // write endblock
  4378. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4379. // leave
  4380. break;
  4381. end else
  4382. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4383. end;
  4384. end;
  4385. {$ENDIF}
  4386. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4387. {$IF DEFINED(GLB_LAZ_JPEG)}
  4388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4389. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4390. const
  4391. MAGIC_LEN = 2;
  4392. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4393. var
  4394. intf: TLazIntfImage;
  4395. reader: TFPReaderJPEG;
  4396. StreamPos: Int64;
  4397. magic: String[MAGIC_LEN];
  4398. begin
  4399. result := true;
  4400. StreamPos := aStream.Position;
  4401. SetLength(magic, MAGIC_LEN);
  4402. aStream.Read(magic[1], MAGIC_LEN);
  4403. aStream.Position := StreamPos;
  4404. if (magic <> JPEG_MAGIC) then begin
  4405. result := false;
  4406. exit;
  4407. end;
  4408. reader := TFPReaderJPEG.Create;
  4409. intf := TLazIntfImage.Create(0, 0);
  4410. try try
  4411. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4412. reader.ImageRead(aStream, intf);
  4413. AssignFromLazIntfImage(intf);
  4414. except
  4415. result := false;
  4416. aStream.Position := StreamPos;
  4417. exit;
  4418. end;
  4419. finally
  4420. reader.Free;
  4421. intf.Free;
  4422. end;
  4423. end;
  4424. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4426. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4427. var
  4428. Surface: PSDL_Surface;
  4429. RWops: PSDL_RWops;
  4430. begin
  4431. result := false;
  4432. RWops := glBitmapCreateRWops(aStream);
  4433. try
  4434. if IMG_isJPG(RWops) > 0 then begin
  4435. Surface := IMG_LoadJPG_RW(RWops);
  4436. try
  4437. AssignFromSurface(Surface);
  4438. result := true;
  4439. finally
  4440. SDL_FreeSurface(Surface);
  4441. end;
  4442. end;
  4443. finally
  4444. SDL_FreeRW(RWops);
  4445. end;
  4446. end;
  4447. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4449. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4450. var
  4451. StreamPos: Int64;
  4452. Temp: array[0..1]of Byte;
  4453. jpeg: jpeg_decompress_struct;
  4454. jpeg_err: jpeg_error_mgr;
  4455. IntFormat: TglBitmapFormat;
  4456. pImage: pByte;
  4457. TempHeight, TempWidth: Integer;
  4458. pTemp: pByte;
  4459. Row: Integer;
  4460. FormatDesc: TFormatDescriptor;
  4461. begin
  4462. result := false;
  4463. if not init_libJPEG then
  4464. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4465. try
  4466. // reading first two bytes to test file and set cursor back to begin
  4467. StreamPos := aStream.Position;
  4468. aStream.Read({%H-}Temp[0], 2);
  4469. aStream.Position := StreamPos;
  4470. // if Bitmap then read file.
  4471. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4472. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4473. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4474. // error managment
  4475. jpeg.err := jpeg_std_error(@jpeg_err);
  4476. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4477. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4478. // decompression struct
  4479. jpeg_create_decompress(@jpeg);
  4480. // allocation space for streaming methods
  4481. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4482. // seeting up custom functions
  4483. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4484. pub.init_source := glBitmap_libJPEG_init_source;
  4485. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4486. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4487. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4488. pub.term_source := glBitmap_libJPEG_term_source;
  4489. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4490. pub.next_input_byte := nil; // until buffer loaded
  4491. SrcStream := aStream;
  4492. end;
  4493. // set global decoding state
  4494. jpeg.global_state := DSTATE_START;
  4495. // read header of jpeg
  4496. jpeg_read_header(@jpeg, false);
  4497. // setting output parameter
  4498. case jpeg.jpeg_color_space of
  4499. JCS_GRAYSCALE:
  4500. begin
  4501. jpeg.out_color_space := JCS_GRAYSCALE;
  4502. IntFormat := tfLuminance8ub1;
  4503. end;
  4504. else
  4505. jpeg.out_color_space := JCS_RGB;
  4506. IntFormat := tfRGB8ub3;
  4507. end;
  4508. // reading image
  4509. jpeg_start_decompress(@jpeg);
  4510. TempHeight := jpeg.output_height;
  4511. TempWidth := jpeg.output_width;
  4512. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4513. // creating new image
  4514. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4515. try
  4516. pTemp := pImage;
  4517. for Row := 0 to TempHeight -1 do begin
  4518. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4519. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4520. end;
  4521. // finish decompression
  4522. jpeg_finish_decompress(@jpeg);
  4523. // destroy decompression
  4524. jpeg_destroy_decompress(@jpeg);
  4525. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4526. result := true;
  4527. except
  4528. if Assigned(pImage) then
  4529. FreeMem(pImage);
  4530. raise;
  4531. end;
  4532. end;
  4533. finally
  4534. quit_libJPEG;
  4535. end;
  4536. end;
  4537. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4539. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4540. var
  4541. bmp: TBitmap;
  4542. jpg: TJPEGImage;
  4543. StreamPos: Int64;
  4544. Temp: array[0..1]of Byte;
  4545. begin
  4546. result := false;
  4547. // reading first two bytes to test file and set cursor back to begin
  4548. StreamPos := aStream.Position;
  4549. aStream.Read(Temp[0], 2);
  4550. aStream.Position := StreamPos;
  4551. // if Bitmap then read file.
  4552. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4553. bmp := TBitmap.Create;
  4554. try
  4555. jpg := TJPEGImage.Create;
  4556. try
  4557. jpg.LoadFromStream(aStream);
  4558. bmp.Assign(jpg);
  4559. result := AssignFromBitmap(bmp);
  4560. finally
  4561. jpg.Free;
  4562. end;
  4563. finally
  4564. bmp.Free;
  4565. end;
  4566. end;
  4567. end;
  4568. {$IFEND}
  4569. {$ENDIF}
  4570. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4571. {$IF DEFINED(GLB_LAZ_JPEG)}
  4572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4573. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4574. var
  4575. jpeg: TJPEGImage;
  4576. intf: TLazIntfImage;
  4577. raw: TRawImage;
  4578. begin
  4579. jpeg := TJPEGImage.Create;
  4580. intf := TLazIntfImage.Create(0, 0);
  4581. try
  4582. if not AssignToLazIntfImage(intf) then
  4583. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4584. intf.GetRawImage(raw);
  4585. jpeg.LoadFromRawImage(raw, false);
  4586. jpeg.SaveToStream(aStream);
  4587. finally
  4588. intf.Free;
  4589. jpeg.Free;
  4590. end;
  4591. end;
  4592. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4594. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4595. var
  4596. jpeg: jpeg_compress_struct;
  4597. jpeg_err: jpeg_error_mgr;
  4598. Row: Integer;
  4599. pTemp, pTemp2: pByte;
  4600. procedure CopyRow(pDest, pSource: pByte);
  4601. var
  4602. X: Integer;
  4603. begin
  4604. for X := 0 to Width - 1 do begin
  4605. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4606. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4607. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4608. Inc(pDest, 3);
  4609. Inc(pSource, 3);
  4610. end;
  4611. end;
  4612. begin
  4613. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4614. raise EglBitmapUnsupportedFormat.Create(Format);
  4615. if not init_libJPEG then
  4616. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4617. try
  4618. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4619. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4620. // error managment
  4621. jpeg.err := jpeg_std_error(@jpeg_err);
  4622. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4623. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4624. // compression struct
  4625. jpeg_create_compress(@jpeg);
  4626. // allocation space for streaming methods
  4627. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4628. // seeting up custom functions
  4629. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4630. pub.init_destination := glBitmap_libJPEG_init_destination;
  4631. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4632. pub.term_destination := glBitmap_libJPEG_term_destination;
  4633. pub.next_output_byte := @DestBuffer[1];
  4634. pub.free_in_buffer := Length(DestBuffer);
  4635. DestStream := aStream;
  4636. end;
  4637. // very important state
  4638. jpeg.global_state := CSTATE_START;
  4639. jpeg.image_width := Width;
  4640. jpeg.image_height := Height;
  4641. case Format of
  4642. tfAlpha8ub1, tfLuminance8ub1: begin
  4643. jpeg.input_components := 1;
  4644. jpeg.in_color_space := JCS_GRAYSCALE;
  4645. end;
  4646. tfRGB8ub3, tfBGR8ub3: begin
  4647. jpeg.input_components := 3;
  4648. jpeg.in_color_space := JCS_RGB;
  4649. end;
  4650. end;
  4651. jpeg_set_defaults(@jpeg);
  4652. jpeg_set_quality(@jpeg, 95, true);
  4653. jpeg_start_compress(@jpeg, true);
  4654. pTemp := Data;
  4655. if Format = tfBGR8ub3 then
  4656. GetMem(pTemp2, fRowSize)
  4657. else
  4658. pTemp2 := pTemp;
  4659. try
  4660. for Row := 0 to jpeg.image_height -1 do begin
  4661. // prepare row
  4662. if Format = tfBGR8ub3 then
  4663. CopyRow(pTemp2, pTemp)
  4664. else
  4665. pTemp2 := pTemp;
  4666. // write row
  4667. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4668. inc(pTemp, fRowSize);
  4669. end;
  4670. finally
  4671. // free memory
  4672. if Format = tfBGR8ub3 then
  4673. FreeMem(pTemp2);
  4674. end;
  4675. jpeg_finish_compress(@jpeg);
  4676. jpeg_destroy_compress(@jpeg);
  4677. finally
  4678. quit_libJPEG;
  4679. end;
  4680. end;
  4681. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4684. var
  4685. Bmp: TBitmap;
  4686. Jpg: TJPEGImage;
  4687. begin
  4688. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4689. raise EglBitmapUnsupportedFormat.Create(Format);
  4690. Bmp := TBitmap.Create;
  4691. try
  4692. Jpg := TJPEGImage.Create;
  4693. try
  4694. AssignToBitmap(Bmp);
  4695. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4696. Jpg.Grayscale := true;
  4697. Jpg.PixelFormat := jf8Bit;
  4698. end;
  4699. Jpg.Assign(Bmp);
  4700. Jpg.SaveToStream(aStream);
  4701. finally
  4702. FreeAndNil(Jpg);
  4703. end;
  4704. finally
  4705. FreeAndNil(Bmp);
  4706. end;
  4707. end;
  4708. {$IFEND}
  4709. {$ENDIF}
  4710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4711. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4713. type
  4714. RawHeader = packed record
  4715. Magic: String[5];
  4716. Version: Byte;
  4717. Width: Integer;
  4718. Height: Integer;
  4719. DataSize: Integer;
  4720. BitsPerPixel: Integer;
  4721. Precision: TglBitmapRec4ub;
  4722. Shift: TglBitmapRec4ub;
  4723. end;
  4724. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4725. var
  4726. header: RawHeader;
  4727. StartPos: Int64;
  4728. fd: TFormatDescriptor;
  4729. buf: PByte;
  4730. begin
  4731. result := false;
  4732. StartPos := aStream.Position;
  4733. aStream.Read(header{%H-}, SizeOf(header));
  4734. if (header.Magic <> 'glBMP') then begin
  4735. aStream.Position := StartPos;
  4736. exit;
  4737. end;
  4738. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4739. if (fd.Format = tfEmpty) then
  4740. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4741. buf := GetMemory(header.DataSize);
  4742. aStream.Read(buf^, header.DataSize);
  4743. SetData(buf, fd.Format, header.Width, header.Height);
  4744. result := true;
  4745. end;
  4746. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4747. var
  4748. header: RawHeader;
  4749. fd: TFormatDescriptor;
  4750. begin
  4751. fd := TFormatDescriptor.Get(Format);
  4752. header.Magic := 'glBMP';
  4753. header.Version := 1;
  4754. header.Width := Width;
  4755. header.Height := Height;
  4756. header.DataSize := fd.GetSize(fDimension);
  4757. header.BitsPerPixel := fd.BitsPerPixel;
  4758. header.Precision := fd.Precision;
  4759. header.Shift := fd.Shift;
  4760. aStream.Write(header, SizeOf(header));
  4761. aStream.Write(Data^, header.DataSize);
  4762. end;
  4763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4764. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4766. const
  4767. BMP_MAGIC = $4D42;
  4768. BMP_COMP_RGB = 0;
  4769. BMP_COMP_RLE8 = 1;
  4770. BMP_COMP_RLE4 = 2;
  4771. BMP_COMP_BITFIELDS = 3;
  4772. type
  4773. TBMPHeader = packed record
  4774. bfType: Word;
  4775. bfSize: Cardinal;
  4776. bfReserved1: Word;
  4777. bfReserved2: Word;
  4778. bfOffBits: Cardinal;
  4779. end;
  4780. TBMPInfo = packed record
  4781. biSize: Cardinal;
  4782. biWidth: Longint;
  4783. biHeight: Longint;
  4784. biPlanes: Word;
  4785. biBitCount: Word;
  4786. biCompression: Cardinal;
  4787. biSizeImage: Cardinal;
  4788. biXPelsPerMeter: Longint;
  4789. biYPelsPerMeter: Longint;
  4790. biClrUsed: Cardinal;
  4791. biClrImportant: Cardinal;
  4792. end;
  4793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4794. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4795. //////////////////////////////////////////////////////////////////////////////////////////////////
  4796. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4797. var
  4798. tmp, i: Cardinal;
  4799. begin
  4800. result := tfEmpty;
  4801. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4802. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4803. //Read Compression
  4804. case aInfo.biCompression of
  4805. BMP_COMP_RLE4,
  4806. BMP_COMP_RLE8: begin
  4807. raise EglBitmap.Create('RLE compression is not supported');
  4808. end;
  4809. BMP_COMP_BITFIELDS: begin
  4810. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4811. for i := 0 to 2 do begin
  4812. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4813. aMask.arr[i] := tmp;
  4814. end;
  4815. end else
  4816. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4817. end;
  4818. end;
  4819. //get suitable format
  4820. case aInfo.biBitCount of
  4821. 8: result := tfLuminance8ub1;
  4822. 16: result := tfX1RGB5us1;
  4823. 24: result := tfBGR8ub3;
  4824. 32: result := tfXRGB8ui1;
  4825. end;
  4826. end;
  4827. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4828. var
  4829. i, c: Integer;
  4830. fd: TFormatDescriptor;
  4831. ColorTable: TbmpColorTable;
  4832. begin
  4833. result := nil;
  4834. if (aInfo.biBitCount >= 16) then
  4835. exit;
  4836. aFormat := tfLuminance8ub1;
  4837. c := aInfo.biClrUsed;
  4838. if (c = 0) then
  4839. c := 1 shl aInfo.biBitCount;
  4840. SetLength(ColorTable, c);
  4841. for i := 0 to c-1 do begin
  4842. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4843. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4844. aFormat := tfRGB8ub3;
  4845. end;
  4846. fd := TFormatDescriptor.Get(aFormat);
  4847. result := TbmpColorTableFormat.Create;
  4848. result.ColorTable := ColorTable;
  4849. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4850. end;
  4851. //////////////////////////////////////////////////////////////////////////////////////////////////
  4852. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4853. var
  4854. fd: TFormatDescriptor;
  4855. begin
  4856. result := nil;
  4857. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4858. // find suitable format ...
  4859. fd := TFormatDescriptor.GetFromMask(aMask);
  4860. if (fd.Format <> tfEmpty) then begin
  4861. aFormat := fd.Format;
  4862. exit;
  4863. end;
  4864. // or create custom bitfield format
  4865. result := TbmpBitfieldFormat.Create;
  4866. result.SetCustomValues(aInfo.biBitCount, aMask);
  4867. end;
  4868. end;
  4869. var
  4870. //simple types
  4871. StartPos: Int64;
  4872. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4873. PaddingBuff: Cardinal;
  4874. LineBuf, ImageData, TmpData: PByte;
  4875. SourceMD, DestMD: Pointer;
  4876. BmpFormat: TglBitmapFormat;
  4877. //records
  4878. Mask: TglBitmapRec4ul;
  4879. Header: TBMPHeader;
  4880. Info: TBMPInfo;
  4881. //classes
  4882. SpecialFormat: TFormatDescriptor;
  4883. FormatDesc: TFormatDescriptor;
  4884. //////////////////////////////////////////////////////////////////////////////////////////////////
  4885. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4886. var
  4887. i: Integer;
  4888. Pixel: TglBitmapPixelData;
  4889. begin
  4890. aStream.Read(aLineBuf^, rbLineSize);
  4891. SpecialFormat.PreparePixel(Pixel);
  4892. for i := 0 to Info.biWidth-1 do begin
  4893. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4894. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4895. FormatDesc.Map(Pixel, aData, DestMD);
  4896. end;
  4897. end;
  4898. begin
  4899. result := false;
  4900. BmpFormat := tfEmpty;
  4901. SpecialFormat := nil;
  4902. LineBuf := nil;
  4903. SourceMD := nil;
  4904. DestMD := nil;
  4905. // Header
  4906. StartPos := aStream.Position;
  4907. aStream.Read(Header{%H-}, SizeOf(Header));
  4908. if Header.bfType = BMP_MAGIC then begin
  4909. try try
  4910. BmpFormat := ReadInfo(Info, Mask);
  4911. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4912. if not Assigned(SpecialFormat) then
  4913. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4914. aStream.Position := StartPos + Header.bfOffBits;
  4915. if (BmpFormat <> tfEmpty) then begin
  4916. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4917. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4918. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4919. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4920. //get Memory
  4921. DestMD := FormatDesc.CreateMappingData;
  4922. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4923. GetMem(ImageData, ImageSize);
  4924. if Assigned(SpecialFormat) then begin
  4925. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4926. SourceMD := SpecialFormat.CreateMappingData;
  4927. end;
  4928. //read Data
  4929. try try
  4930. FillChar(ImageData^, ImageSize, $FF);
  4931. TmpData := ImageData;
  4932. if (Info.biHeight > 0) then
  4933. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4934. for i := 0 to Abs(Info.biHeight)-1 do begin
  4935. if Assigned(SpecialFormat) then
  4936. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4937. else
  4938. aStream.Read(TmpData^, wbLineSize); //else only read data
  4939. if (Info.biHeight > 0) then
  4940. dec(TmpData, wbLineSize)
  4941. else
  4942. inc(TmpData, wbLineSize);
  4943. aStream.Read(PaddingBuff{%H-}, Padding);
  4944. end;
  4945. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4946. result := true;
  4947. finally
  4948. if Assigned(LineBuf) then
  4949. FreeMem(LineBuf);
  4950. if Assigned(SourceMD) then
  4951. SpecialFormat.FreeMappingData(SourceMD);
  4952. FormatDesc.FreeMappingData(DestMD);
  4953. end;
  4954. except
  4955. if Assigned(ImageData) then
  4956. FreeMem(ImageData);
  4957. raise;
  4958. end;
  4959. end else
  4960. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4961. except
  4962. aStream.Position := StartPos;
  4963. raise;
  4964. end;
  4965. finally
  4966. FreeAndNil(SpecialFormat);
  4967. end;
  4968. end
  4969. else aStream.Position := StartPos;
  4970. end;
  4971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4972. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4973. var
  4974. Header: TBMPHeader;
  4975. Info: TBMPInfo;
  4976. Converter: TFormatDescriptor;
  4977. FormatDesc: TFormatDescriptor;
  4978. SourceFD, DestFD: Pointer;
  4979. pData, srcData, dstData, ConvertBuffer: pByte;
  4980. Pixel: TglBitmapPixelData;
  4981. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  4982. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  4983. PaddingBuff: Cardinal;
  4984. function GetLineWidth : Integer;
  4985. begin
  4986. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  4987. end;
  4988. begin
  4989. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  4990. raise EglBitmapUnsupportedFormat.Create(Format);
  4991. Converter := nil;
  4992. FormatDesc := TFormatDescriptor.Get(Format);
  4993. ImageSize := FormatDesc.GetSize(Dimension);
  4994. FillChar(Header{%H-}, SizeOf(Header), 0);
  4995. Header.bfType := BMP_MAGIC;
  4996. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  4997. Header.bfReserved1 := 0;
  4998. Header.bfReserved2 := 0;
  4999. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5000. FillChar(Info{%H-}, SizeOf(Info), 0);
  5001. Info.biSize := SizeOf(Info);
  5002. Info.biWidth := Width;
  5003. Info.biHeight := Height;
  5004. Info.biPlanes := 1;
  5005. Info.biCompression := BMP_COMP_RGB;
  5006. Info.biSizeImage := ImageSize;
  5007. try
  5008. case Format of
  5009. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5010. begin
  5011. Info.biBitCount := 8;
  5012. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5013. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5014. Converter := TbmpColorTableFormat.Create;
  5015. with (Converter as TbmpColorTableFormat) do begin
  5016. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5017. CreateColorTable;
  5018. end;
  5019. end;
  5020. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5021. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5022. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5023. begin
  5024. Info.biBitCount := 16;
  5025. Info.biCompression := BMP_COMP_BITFIELDS;
  5026. end;
  5027. tfBGR8ub3, tfRGB8ub3:
  5028. begin
  5029. Info.biBitCount := 24;
  5030. if (Format = tfRGB8ub3) then
  5031. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5032. end;
  5033. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5034. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5035. begin
  5036. Info.biBitCount := 32;
  5037. Info.biCompression := BMP_COMP_BITFIELDS;
  5038. end;
  5039. else
  5040. raise EglBitmapUnsupportedFormat.Create(Format);
  5041. end;
  5042. Info.biXPelsPerMeter := 2835;
  5043. Info.biYPelsPerMeter := 2835;
  5044. // prepare bitmasks
  5045. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5046. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5047. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5048. RedMask := FormatDesc.Mask.r;
  5049. GreenMask := FormatDesc.Mask.g;
  5050. BlueMask := FormatDesc.Mask.b;
  5051. AlphaMask := FormatDesc.Mask.a;
  5052. end;
  5053. // headers
  5054. aStream.Write(Header, SizeOf(Header));
  5055. aStream.Write(Info, SizeOf(Info));
  5056. // colortable
  5057. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5058. with (Converter as TbmpColorTableFormat) do
  5059. aStream.Write(ColorTable[0].b,
  5060. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5061. // bitmasks
  5062. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5063. aStream.Write(RedMask, SizeOf(Cardinal));
  5064. aStream.Write(GreenMask, SizeOf(Cardinal));
  5065. aStream.Write(BlueMask, SizeOf(Cardinal));
  5066. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5067. end;
  5068. // image data
  5069. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5070. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5071. Padding := GetLineWidth - wbLineSize;
  5072. PaddingBuff := 0;
  5073. pData := Data;
  5074. inc(pData, (Height-1) * rbLineSize);
  5075. // prepare row buffer. But only for RGB because RGBA supports color masks
  5076. // so it's possible to change color within the image.
  5077. if Assigned(Converter) then begin
  5078. FormatDesc.PreparePixel(Pixel);
  5079. GetMem(ConvertBuffer, wbLineSize);
  5080. SourceFD := FormatDesc.CreateMappingData;
  5081. DestFD := Converter.CreateMappingData;
  5082. end else
  5083. ConvertBuffer := nil;
  5084. try
  5085. for LineIdx := 0 to Height - 1 do begin
  5086. // preparing row
  5087. if Assigned(Converter) then begin
  5088. srcData := pData;
  5089. dstData := ConvertBuffer;
  5090. for PixelIdx := 0 to Info.biWidth-1 do begin
  5091. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5092. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5093. Converter.Map(Pixel, dstData, DestFD);
  5094. end;
  5095. aStream.Write(ConvertBuffer^, wbLineSize);
  5096. end else begin
  5097. aStream.Write(pData^, rbLineSize);
  5098. end;
  5099. dec(pData, rbLineSize);
  5100. if (Padding > 0) then
  5101. aStream.Write(PaddingBuff, Padding);
  5102. end;
  5103. finally
  5104. // destroy row buffer
  5105. if Assigned(ConvertBuffer) then begin
  5106. FormatDesc.FreeMappingData(SourceFD);
  5107. Converter.FreeMappingData(DestFD);
  5108. FreeMem(ConvertBuffer);
  5109. end;
  5110. end;
  5111. finally
  5112. if Assigned(Converter) then
  5113. Converter.Free;
  5114. end;
  5115. end;
  5116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5117. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. type
  5120. TTGAHeader = packed record
  5121. ImageID: Byte;
  5122. ColorMapType: Byte;
  5123. ImageType: Byte;
  5124. //ColorMapSpec: Array[0..4] of Byte;
  5125. ColorMapStart: Word;
  5126. ColorMapLength: Word;
  5127. ColorMapEntrySize: Byte;
  5128. OrigX: Word;
  5129. OrigY: Word;
  5130. Width: Word;
  5131. Height: Word;
  5132. Bpp: Byte;
  5133. ImageDesc: Byte;
  5134. end;
  5135. const
  5136. TGA_UNCOMPRESSED_RGB = 2;
  5137. TGA_UNCOMPRESSED_GRAY = 3;
  5138. TGA_COMPRESSED_RGB = 10;
  5139. TGA_COMPRESSED_GRAY = 11;
  5140. TGA_NONE_COLOR_TABLE = 0;
  5141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5142. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5143. var
  5144. Header: TTGAHeader;
  5145. ImageData: System.PByte;
  5146. StartPosition: Int64;
  5147. PixelSize, LineSize: Integer;
  5148. tgaFormat: TglBitmapFormat;
  5149. FormatDesc: TFormatDescriptor;
  5150. Counter: packed record
  5151. X, Y: packed record
  5152. low, high, dir: Integer;
  5153. end;
  5154. end;
  5155. const
  5156. CACHE_SIZE = $4000;
  5157. ////////////////////////////////////////////////////////////////////////////////////////
  5158. procedure ReadUncompressed;
  5159. var
  5160. i, j: Integer;
  5161. buf, tmp1, tmp2: System.PByte;
  5162. begin
  5163. buf := nil;
  5164. if (Counter.X.dir < 0) then
  5165. GetMem(buf, LineSize);
  5166. try
  5167. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5168. tmp1 := ImageData;
  5169. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5170. if (Counter.X.dir < 0) then begin //flip X
  5171. aStream.Read(buf^, LineSize);
  5172. tmp2 := buf;
  5173. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5174. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5175. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5176. tmp1^ := tmp2^;
  5177. inc(tmp1);
  5178. inc(tmp2);
  5179. end;
  5180. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5181. end;
  5182. end else
  5183. aStream.Read(tmp1^, LineSize);
  5184. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5185. end;
  5186. finally
  5187. if Assigned(buf) then
  5188. FreeMem(buf);
  5189. end;
  5190. end;
  5191. ////////////////////////////////////////////////////////////////////////////////////////
  5192. procedure ReadCompressed;
  5193. /////////////////////////////////////////////////////////////////
  5194. var
  5195. TmpData: System.PByte;
  5196. LinePixelsRead: Integer;
  5197. procedure CheckLine;
  5198. begin
  5199. if (LinePixelsRead >= Header.Width) then begin
  5200. LinePixelsRead := 0;
  5201. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5202. TmpData := ImageData;
  5203. inc(TmpData, Counter.Y.low * LineSize); //set line
  5204. if (Counter.X.dir < 0) then //if x flipped then
  5205. inc(TmpData, LineSize - PixelSize); //set last pixel
  5206. end;
  5207. end;
  5208. /////////////////////////////////////////////////////////////////
  5209. var
  5210. Cache: PByte;
  5211. CacheSize, CachePos: Integer;
  5212. procedure CachedRead(out Buffer; Count: Integer);
  5213. var
  5214. BytesRead: Integer;
  5215. begin
  5216. if (CachePos + Count > CacheSize) then begin
  5217. //if buffer overflow save non read bytes
  5218. BytesRead := 0;
  5219. if (CacheSize - CachePos > 0) then begin
  5220. BytesRead := CacheSize - CachePos;
  5221. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5222. inc(CachePos, BytesRead);
  5223. end;
  5224. //load cache from file
  5225. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5226. aStream.Read(Cache^, CacheSize);
  5227. CachePos := 0;
  5228. //read rest of requested bytes
  5229. if (Count - BytesRead > 0) then begin
  5230. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5231. inc(CachePos, Count - BytesRead);
  5232. end;
  5233. end else begin
  5234. //if no buffer overflow just read the data
  5235. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5236. inc(CachePos, Count);
  5237. end;
  5238. end;
  5239. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5240. begin
  5241. case PixelSize of
  5242. 1: begin
  5243. aBuffer^ := aData^;
  5244. inc(aBuffer, Counter.X.dir);
  5245. end;
  5246. 2: begin
  5247. PWord(aBuffer)^ := PWord(aData)^;
  5248. inc(aBuffer, 2 * Counter.X.dir);
  5249. end;
  5250. 3: begin
  5251. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5252. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5253. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5254. inc(aBuffer, 3 * Counter.X.dir);
  5255. end;
  5256. 4: begin
  5257. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5258. inc(aBuffer, 4 * Counter.X.dir);
  5259. end;
  5260. end;
  5261. end;
  5262. var
  5263. TotalPixelsToRead, TotalPixelsRead: Integer;
  5264. Temp: Byte;
  5265. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5266. PixelRepeat: Boolean;
  5267. PixelsToRead, PixelCount: Integer;
  5268. begin
  5269. CacheSize := 0;
  5270. CachePos := 0;
  5271. TotalPixelsToRead := Header.Width * Header.Height;
  5272. TotalPixelsRead := 0;
  5273. LinePixelsRead := 0;
  5274. GetMem(Cache, CACHE_SIZE);
  5275. try
  5276. TmpData := ImageData;
  5277. inc(TmpData, Counter.Y.low * LineSize); //set line
  5278. if (Counter.X.dir < 0) then //if x flipped then
  5279. inc(TmpData, LineSize - PixelSize); //set last pixel
  5280. repeat
  5281. //read CommandByte
  5282. CachedRead(Temp, 1);
  5283. PixelRepeat := (Temp and $80) > 0;
  5284. PixelsToRead := (Temp and $7F) + 1;
  5285. inc(TotalPixelsRead, PixelsToRead);
  5286. if PixelRepeat then
  5287. CachedRead(buf[0], PixelSize);
  5288. while (PixelsToRead > 0) do begin
  5289. CheckLine;
  5290. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5291. while (PixelCount > 0) do begin
  5292. if not PixelRepeat then
  5293. CachedRead(buf[0], PixelSize);
  5294. PixelToBuffer(@buf[0], TmpData);
  5295. inc(LinePixelsRead);
  5296. dec(PixelsToRead);
  5297. dec(PixelCount);
  5298. end;
  5299. end;
  5300. until (TotalPixelsRead >= TotalPixelsToRead);
  5301. finally
  5302. FreeMem(Cache);
  5303. end;
  5304. end;
  5305. function IsGrayFormat: Boolean;
  5306. begin
  5307. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5308. end;
  5309. begin
  5310. result := false;
  5311. // reading header to test file and set cursor back to begin
  5312. StartPosition := aStream.Position;
  5313. aStream.Read(Header{%H-}, SizeOf(Header));
  5314. // no colormapped files
  5315. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5316. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5317. begin
  5318. try
  5319. if Header.ImageID <> 0 then // skip image ID
  5320. aStream.Position := aStream.Position + Header.ImageID;
  5321. tgaFormat := tfEmpty;
  5322. case Header.Bpp of
  5323. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5324. 0: tgaFormat := tfLuminance8ub1;
  5325. 8: tgaFormat := tfAlpha8ub1;
  5326. end;
  5327. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5328. 0: tgaFormat := tfLuminance16us1;
  5329. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5330. end else case (Header.ImageDesc and $F) of
  5331. 0: tgaFormat := tfX1RGB5us1;
  5332. 1: tgaFormat := tfA1RGB5us1;
  5333. 4: tgaFormat := tfARGB4us1;
  5334. end;
  5335. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5336. 0: tgaFormat := tfBGR8ub3;
  5337. end;
  5338. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5339. 0: tgaFormat := tfDepth32ui1;
  5340. end else case (Header.ImageDesc and $F) of
  5341. 0: tgaFormat := tfX2RGB10ui1;
  5342. 2: tgaFormat := tfA2RGB10ui1;
  5343. 8: tgaFormat := tfARGB8ui1;
  5344. end;
  5345. end;
  5346. if (tgaFormat = tfEmpty) then
  5347. raise EglBitmap.Create('LoadTga - unsupported format');
  5348. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5349. PixelSize := FormatDesc.GetSize(1, 1);
  5350. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5351. GetMem(ImageData, LineSize * Header.Height);
  5352. try
  5353. //column direction
  5354. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5355. Counter.X.low := Header.Height-1;;
  5356. Counter.X.high := 0;
  5357. Counter.X.dir := -1;
  5358. end else begin
  5359. Counter.X.low := 0;
  5360. Counter.X.high := Header.Height-1;
  5361. Counter.X.dir := 1;
  5362. end;
  5363. // Row direction
  5364. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5365. Counter.Y.low := 0;
  5366. Counter.Y.high := Header.Height-1;
  5367. Counter.Y.dir := 1;
  5368. end else begin
  5369. Counter.Y.low := Header.Height-1;;
  5370. Counter.Y.high := 0;
  5371. Counter.Y.dir := -1;
  5372. end;
  5373. // Read Image
  5374. case Header.ImageType of
  5375. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5376. ReadUncompressed;
  5377. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5378. ReadCompressed;
  5379. end;
  5380. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5381. result := true;
  5382. except
  5383. if Assigned(ImageData) then
  5384. FreeMem(ImageData);
  5385. raise;
  5386. end;
  5387. finally
  5388. aStream.Position := StartPosition;
  5389. end;
  5390. end
  5391. else aStream.Position := StartPosition;
  5392. end;
  5393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5394. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5395. var
  5396. Header: TTGAHeader;
  5397. Size: Integer;
  5398. FormatDesc: TFormatDescriptor;
  5399. begin
  5400. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5401. raise EglBitmapUnsupportedFormat.Create(Format);
  5402. //prepare header
  5403. FormatDesc := TFormatDescriptor.Get(Format);
  5404. FillChar(Header{%H-}, SizeOf(Header), 0);
  5405. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5406. Header.Bpp := FormatDesc.BitsPerPixel;
  5407. Header.Width := Width;
  5408. Header.Height := Height;
  5409. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5410. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5411. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5412. else
  5413. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5414. aStream.Write(Header, SizeOf(Header));
  5415. // write Data
  5416. Size := FormatDesc.GetSize(Dimension);
  5417. aStream.Write(Data^, Size);
  5418. end;
  5419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5420. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5422. const
  5423. DDS_MAGIC: Cardinal = $20534444;
  5424. // DDS_header.dwFlags
  5425. DDSD_CAPS = $00000001;
  5426. DDSD_HEIGHT = $00000002;
  5427. DDSD_WIDTH = $00000004;
  5428. DDSD_PIXELFORMAT = $00001000;
  5429. // DDS_header.sPixelFormat.dwFlags
  5430. DDPF_ALPHAPIXELS = $00000001;
  5431. DDPF_ALPHA = $00000002;
  5432. DDPF_FOURCC = $00000004;
  5433. DDPF_RGB = $00000040;
  5434. DDPF_LUMINANCE = $00020000;
  5435. // DDS_header.sCaps.dwCaps1
  5436. DDSCAPS_TEXTURE = $00001000;
  5437. // DDS_header.sCaps.dwCaps2
  5438. DDSCAPS2_CUBEMAP = $00000200;
  5439. D3DFMT_DXT1 = $31545844;
  5440. D3DFMT_DXT3 = $33545844;
  5441. D3DFMT_DXT5 = $35545844;
  5442. type
  5443. TDDSPixelFormat = packed record
  5444. dwSize: Cardinal;
  5445. dwFlags: Cardinal;
  5446. dwFourCC: Cardinal;
  5447. dwRGBBitCount: Cardinal;
  5448. dwRBitMask: Cardinal;
  5449. dwGBitMask: Cardinal;
  5450. dwBBitMask: Cardinal;
  5451. dwABitMask: Cardinal;
  5452. end;
  5453. TDDSCaps = packed record
  5454. dwCaps1: Cardinal;
  5455. dwCaps2: Cardinal;
  5456. dwDDSX: Cardinal;
  5457. dwReserved: Cardinal;
  5458. end;
  5459. TDDSHeader = packed record
  5460. dwSize: Cardinal;
  5461. dwFlags: Cardinal;
  5462. dwHeight: Cardinal;
  5463. dwWidth: Cardinal;
  5464. dwPitchOrLinearSize: Cardinal;
  5465. dwDepth: Cardinal;
  5466. dwMipMapCount: Cardinal;
  5467. dwReserved: array[0..10] of Cardinal;
  5468. PixelFormat: TDDSPixelFormat;
  5469. Caps: TDDSCaps;
  5470. dwReserved2: Cardinal;
  5471. end;
  5472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5473. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5474. var
  5475. Header: TDDSHeader;
  5476. Converter: TbmpBitfieldFormat;
  5477. function GetDDSFormat: TglBitmapFormat;
  5478. var
  5479. fd: TFormatDescriptor;
  5480. i: Integer;
  5481. Mask: TglBitmapRec4ul;
  5482. Range: TglBitmapRec4ui;
  5483. match: Boolean;
  5484. begin
  5485. result := tfEmpty;
  5486. with Header.PixelFormat do begin
  5487. // Compresses
  5488. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5489. case Header.PixelFormat.dwFourCC of
  5490. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5491. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5492. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5493. end;
  5494. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5495. // prepare masks
  5496. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5497. Mask.r := dwRBitMask;
  5498. Mask.g := dwGBitMask;
  5499. Mask.b := dwBBitMask;
  5500. end else begin
  5501. Mask.r := dwRBitMask;
  5502. Mask.g := dwRBitMask;
  5503. Mask.b := dwRBitMask;
  5504. end;
  5505. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5506. Mask.a := dwABitMask
  5507. else
  5508. Mask.a := 0;;
  5509. //find matching format
  5510. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5511. result := fd.Format;
  5512. if (result <> tfEmpty) then
  5513. exit;
  5514. //find format with same Range
  5515. for i := 0 to 3 do
  5516. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5517. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5518. fd := TFormatDescriptor.Get(result);
  5519. match := true;
  5520. for i := 0 to 3 do
  5521. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5522. match := false;
  5523. break;
  5524. end;
  5525. if match then
  5526. break;
  5527. end;
  5528. //no format with same range found -> use default
  5529. if (result = tfEmpty) then begin
  5530. if (dwABitMask > 0) then
  5531. result := tfRGBA8ui1
  5532. else
  5533. result := tfRGB8ub3;
  5534. end;
  5535. Converter := TbmpBitfieldFormat.Create;
  5536. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5537. end;
  5538. end;
  5539. end;
  5540. var
  5541. StreamPos: Int64;
  5542. x, y, LineSize, RowSize, Magic: Cardinal;
  5543. NewImage, TmpData, RowData, SrcData: System.PByte;
  5544. SourceMD, DestMD: Pointer;
  5545. Pixel: TglBitmapPixelData;
  5546. ddsFormat: TglBitmapFormat;
  5547. FormatDesc: TFormatDescriptor;
  5548. begin
  5549. result := false;
  5550. Converter := nil;
  5551. StreamPos := aStream.Position;
  5552. // Magic
  5553. aStream.Read(Magic{%H-}, sizeof(Magic));
  5554. if (Magic <> DDS_MAGIC) then begin
  5555. aStream.Position := StreamPos;
  5556. exit;
  5557. end;
  5558. //Header
  5559. aStream.Read(Header{%H-}, sizeof(Header));
  5560. if (Header.dwSize <> SizeOf(Header)) or
  5561. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5562. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5563. begin
  5564. aStream.Position := StreamPos;
  5565. exit;
  5566. end;
  5567. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5568. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5569. ddsFormat := GetDDSFormat;
  5570. try
  5571. if (ddsFormat = tfEmpty) then
  5572. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5573. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5574. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5575. GetMem(NewImage, Header.dwHeight * LineSize);
  5576. try
  5577. TmpData := NewImage;
  5578. //Converter needed
  5579. if Assigned(Converter) then begin
  5580. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5581. GetMem(RowData, RowSize);
  5582. SourceMD := Converter.CreateMappingData;
  5583. DestMD := FormatDesc.CreateMappingData;
  5584. try
  5585. for y := 0 to Header.dwHeight-1 do begin
  5586. TmpData := NewImage;
  5587. inc(TmpData, y * LineSize);
  5588. SrcData := RowData;
  5589. aStream.Read(SrcData^, RowSize);
  5590. for x := 0 to Header.dwWidth-1 do begin
  5591. Converter.Unmap(SrcData, Pixel, SourceMD);
  5592. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5593. FormatDesc.Map(Pixel, TmpData, DestMD);
  5594. end;
  5595. end;
  5596. finally
  5597. Converter.FreeMappingData(SourceMD);
  5598. FormatDesc.FreeMappingData(DestMD);
  5599. FreeMem(RowData);
  5600. end;
  5601. end else
  5602. // Compressed
  5603. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5604. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5605. for Y := 0 to Header.dwHeight-1 do begin
  5606. aStream.Read(TmpData^, RowSize);
  5607. Inc(TmpData, LineSize);
  5608. end;
  5609. end else
  5610. // Uncompressed
  5611. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5612. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5613. for Y := 0 to Header.dwHeight-1 do begin
  5614. aStream.Read(TmpData^, RowSize);
  5615. Inc(TmpData, LineSize);
  5616. end;
  5617. end else
  5618. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5619. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5620. result := true;
  5621. except
  5622. if Assigned(NewImage) then
  5623. FreeMem(NewImage);
  5624. raise;
  5625. end;
  5626. finally
  5627. FreeAndNil(Converter);
  5628. end;
  5629. end;
  5630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5631. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5632. var
  5633. Header: TDDSHeader;
  5634. FormatDesc: TFormatDescriptor;
  5635. begin
  5636. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5637. raise EglBitmapUnsupportedFormat.Create(Format);
  5638. FormatDesc := TFormatDescriptor.Get(Format);
  5639. // Generell
  5640. FillChar(Header{%H-}, SizeOf(Header), 0);
  5641. Header.dwSize := SizeOf(Header);
  5642. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5643. Header.dwWidth := Max(1, Width);
  5644. Header.dwHeight := Max(1, Height);
  5645. // Caps
  5646. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5647. // Pixelformat
  5648. Header.PixelFormat.dwSize := sizeof(Header);
  5649. if (FormatDesc.IsCompressed) then begin
  5650. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5651. case Format of
  5652. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5653. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5654. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5655. end;
  5656. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5657. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5658. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5659. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5660. end else if FormatDesc.IsGrayscale then begin
  5661. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5662. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5663. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5664. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5665. end else begin
  5666. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5667. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5668. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5669. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5670. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5671. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5672. end;
  5673. if (FormatDesc.HasAlpha) then
  5674. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5675. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5676. aStream.Write(Header, SizeOf(Header));
  5677. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5678. end;
  5679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5680. function TglBitmapData.FlipHorz: Boolean;
  5681. var
  5682. fd: TglBitmapFormatDescriptor;
  5683. Col, RowSize, PixelSize: Integer;
  5684. pTempDest, pDest, pSource: PByte;
  5685. begin
  5686. result := false;
  5687. fd := FormatDescriptor;
  5688. PixelSize := Ceil(fd.BytesPerPixel);
  5689. RowSize := fd.GetSize(Width, 1);
  5690. if Assigned(Data) and not fd.IsCompressed then begin
  5691. pSource := Data;
  5692. GetMem(pDest, RowSize);
  5693. try
  5694. pTempDest := pDest;
  5695. Inc(pTempDest, RowSize);
  5696. for Col := 0 to Width-1 do begin
  5697. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5698. Move(pSource^, pTempDest^, PixelSize);
  5699. Inc(pSource, PixelSize);
  5700. end;
  5701. SetData(pDest, Format, Width);
  5702. result := true;
  5703. except
  5704. if Assigned(pDest) then
  5705. FreeMem(pDest);
  5706. raise;
  5707. end;
  5708. end;
  5709. end;
  5710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5711. function TglBitmapData.FlipVert: Boolean;
  5712. var
  5713. fd: TglBitmapFormatDescriptor;
  5714. Row, RowSize, PixelSize: Integer;
  5715. TempDestData, DestData, SourceData: PByte;
  5716. begin
  5717. result := false;
  5718. fd := FormatDescriptor;
  5719. PixelSize := Ceil(fd.BytesPerPixel);
  5720. RowSize := fd.GetSize(Width, 1);
  5721. if Assigned(Data) then begin
  5722. SourceData := Data;
  5723. GetMem(DestData, Height * RowSize);
  5724. try
  5725. TempDestData := DestData;
  5726. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5727. for Row := 0 to Height -1 do begin
  5728. Move(SourceData^, TempDestData^, RowSize);
  5729. Dec(TempDestData, RowSize);
  5730. Inc(SourceData, RowSize);
  5731. end;
  5732. SetData(DestData, Format, Width, Height);
  5733. result := true;
  5734. except
  5735. if Assigned(DestData) then
  5736. FreeMem(DestData);
  5737. raise;
  5738. end;
  5739. end;
  5740. end;
  5741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5742. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5743. var
  5744. fs: TFileStream;
  5745. begin
  5746. if not FileExists(aFilename) then
  5747. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5748. fs := TFileStream.Create(aFilename, fmOpenRead);
  5749. try
  5750. fs.Position := 0;
  5751. LoadFromStream(fs);
  5752. fFilename := aFilename;
  5753. finally
  5754. fs.Free;
  5755. end;
  5756. end;
  5757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5758. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5759. begin
  5760. {$IFDEF GLB_SUPPORT_PNG_READ}
  5761. if not LoadPNG(aStream) then
  5762. {$ENDIF}
  5763. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5764. if not LoadJPEG(aStream) then
  5765. {$ENDIF}
  5766. if not LoadDDS(aStream) then
  5767. if not LoadTGA(aStream) then
  5768. if not LoadBMP(aStream) then
  5769. if not LoadRAW(aStream) then
  5770. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5771. end;
  5772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5773. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5774. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5775. var
  5776. tmpData: PByte;
  5777. size: Integer;
  5778. begin
  5779. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5780. GetMem(tmpData, size);
  5781. try
  5782. FillChar(tmpData^, size, #$FF);
  5783. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5784. except
  5785. if Assigned(tmpData) then
  5786. FreeMem(tmpData);
  5787. raise;
  5788. end;
  5789. Convert(Self, aFunc, false, aFormat, aArgs);
  5790. end;
  5791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5792. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5793. var
  5794. rs: TResourceStream;
  5795. begin
  5796. PrepareResType(aResource, aResType);
  5797. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5798. try
  5799. LoadFromStream(rs);
  5800. finally
  5801. rs.Free;
  5802. end;
  5803. end;
  5804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5805. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5806. var
  5807. rs: TResourceStream;
  5808. begin
  5809. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5810. try
  5811. LoadFromStream(rs);
  5812. finally
  5813. rs.Free;
  5814. end;
  5815. end;
  5816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5817. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5818. var
  5819. fs: TFileStream;
  5820. begin
  5821. fs := TFileStream.Create(aFileName, fmCreate);
  5822. try
  5823. fs.Position := 0;
  5824. SaveToStream(fs, aFileType);
  5825. finally
  5826. fs.Free;
  5827. end;
  5828. end;
  5829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5830. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5831. begin
  5832. case aFileType of
  5833. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5834. ftPNG: SavePNG(aStream);
  5835. {$ENDIF}
  5836. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5837. ftJPEG: SaveJPEG(aStream);
  5838. {$ENDIF}
  5839. ftDDS: SaveDDS(aStream);
  5840. ftTGA: SaveTGA(aStream);
  5841. ftBMP: SaveBMP(aStream);
  5842. ftRAW: SaveRAW(aStream);
  5843. end;
  5844. end;
  5845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5846. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5847. begin
  5848. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5849. end;
  5850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5851. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5852. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5853. var
  5854. DestData, TmpData, SourceData: pByte;
  5855. TempHeight, TempWidth: Integer;
  5856. SourceFD, DestFD: TFormatDescriptor;
  5857. SourceMD, DestMD: Pointer;
  5858. FuncRec: TglBitmapFunctionRec;
  5859. begin
  5860. Assert(Assigned(Data));
  5861. Assert(Assigned(aSource));
  5862. Assert(Assigned(aSource.Data));
  5863. result := false;
  5864. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5865. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5866. DestFD := TFormatDescriptor.Get(aFormat);
  5867. if (SourceFD.IsCompressed) then
  5868. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5869. if (DestFD.IsCompressed) then
  5870. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5871. // inkompatible Formats so CreateTemp
  5872. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5873. aCreateTemp := true;
  5874. // Values
  5875. TempHeight := Max(1, aSource.Height);
  5876. TempWidth := Max(1, aSource.Width);
  5877. FuncRec.Sender := Self;
  5878. FuncRec.Args := aArgs;
  5879. TmpData := nil;
  5880. if aCreateTemp then begin
  5881. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5882. DestData := TmpData;
  5883. end else
  5884. DestData := Data;
  5885. try
  5886. SourceFD.PreparePixel(FuncRec.Source);
  5887. DestFD.PreparePixel (FuncRec.Dest);
  5888. SourceMD := SourceFD.CreateMappingData;
  5889. DestMD := DestFD.CreateMappingData;
  5890. FuncRec.Size := aSource.Dimension;
  5891. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5892. try
  5893. SourceData := aSource.Data;
  5894. FuncRec.Position.Y := 0;
  5895. while FuncRec.Position.Y < TempHeight do begin
  5896. FuncRec.Position.X := 0;
  5897. while FuncRec.Position.X < TempWidth do begin
  5898. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5899. aFunc(FuncRec);
  5900. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5901. inc(FuncRec.Position.X);
  5902. end;
  5903. inc(FuncRec.Position.Y);
  5904. end;
  5905. // Updating Image or InternalFormat
  5906. if aCreateTemp then
  5907. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5908. else if (aFormat <> fFormat) then
  5909. Format := aFormat;
  5910. result := true;
  5911. finally
  5912. SourceFD.FreeMappingData(SourceMD);
  5913. DestFD.FreeMappingData(DestMD);
  5914. end;
  5915. except
  5916. if aCreateTemp and Assigned(TmpData) then
  5917. FreeMem(TmpData);
  5918. raise;
  5919. end;
  5920. end;
  5921. end;
  5922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5923. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5924. var
  5925. SourceFD, DestFD: TFormatDescriptor;
  5926. SourcePD, DestPD: TglBitmapPixelData;
  5927. ShiftData: TShiftData;
  5928. function DataIsIdentical: Boolean;
  5929. begin
  5930. result := SourceFD.MaskMatch(DestFD.Mask);
  5931. end;
  5932. function CanCopyDirect: Boolean;
  5933. begin
  5934. result :=
  5935. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5936. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5937. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5938. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5939. end;
  5940. function CanShift: Boolean;
  5941. begin
  5942. result :=
  5943. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5944. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5945. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5946. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5947. end;
  5948. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5949. begin
  5950. result := 0;
  5951. while (aSource > aDest) and (aSource > 0) do begin
  5952. inc(result);
  5953. aSource := aSource shr 1;
  5954. end;
  5955. end;
  5956. begin
  5957. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5958. SourceFD := TFormatDescriptor.Get(Format);
  5959. DestFD := TFormatDescriptor.Get(aFormat);
  5960. if DataIsIdentical then begin
  5961. result := true;
  5962. Format := aFormat;
  5963. exit;
  5964. end;
  5965. SourceFD.PreparePixel(SourcePD);
  5966. DestFD.PreparePixel (DestPD);
  5967. if CanCopyDirect then
  5968. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5969. else if CanShift then begin
  5970. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5971. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5972. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5973. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5974. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5975. end else
  5976. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5977. end else
  5978. result := true;
  5979. end;
  5980. {$IFDEF GLB_SDL}
  5981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5982. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  5983. var
  5984. Row, RowSize: Integer;
  5985. SourceData, TmpData: PByte;
  5986. TempDepth: Integer;
  5987. FormatDesc: TFormatDescriptor;
  5988. function GetRowPointer(Row: Integer): pByte;
  5989. begin
  5990. result := aSurface.pixels;
  5991. Inc(result, Row * RowSize);
  5992. end;
  5993. begin
  5994. result := false;
  5995. FormatDesc := TFormatDescriptor.Get(Format);
  5996. if FormatDesc.IsCompressed then
  5997. raise EglBitmapUnsupportedFormat.Create(Format);
  5998. if Assigned(Data) then begin
  5999. case Trunc(FormatDesc.PixelSize) of
  6000. 1: TempDepth := 8;
  6001. 2: TempDepth := 16;
  6002. 3: TempDepth := 24;
  6003. 4: TempDepth := 32;
  6004. else
  6005. raise EglBitmapUnsupportedFormat.Create(Format);
  6006. end;
  6007. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6008. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6009. SourceData := Data;
  6010. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6011. for Row := 0 to FileHeight-1 do begin
  6012. TmpData := GetRowPointer(Row);
  6013. if Assigned(TmpData) then begin
  6014. Move(SourceData^, TmpData^, RowSize);
  6015. inc(SourceData, RowSize);
  6016. end;
  6017. end;
  6018. result := true;
  6019. end;
  6020. end;
  6021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6022. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6023. var
  6024. pSource, pData, pTempData: PByte;
  6025. Row, RowSize, TempWidth, TempHeight: Integer;
  6026. IntFormat: TglBitmapFormat;
  6027. fd: TFormatDescriptor;
  6028. Mask: TglBitmapMask;
  6029. function GetRowPointer(Row: Integer): pByte;
  6030. begin
  6031. result := aSurface^.pixels;
  6032. Inc(result, Row * RowSize);
  6033. end;
  6034. begin
  6035. result := false;
  6036. if (Assigned(aSurface)) then begin
  6037. with aSurface^.format^ do begin
  6038. Mask.r := RMask;
  6039. Mask.g := GMask;
  6040. Mask.b := BMask;
  6041. Mask.a := AMask;
  6042. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6043. if (IntFormat = tfEmpty) then
  6044. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6045. end;
  6046. fd := TFormatDescriptor.Get(IntFormat);
  6047. TempWidth := aSurface^.w;
  6048. TempHeight := aSurface^.h;
  6049. RowSize := fd.GetSize(TempWidth, 1);
  6050. GetMem(pData, TempHeight * RowSize);
  6051. try
  6052. pTempData := pData;
  6053. for Row := 0 to TempHeight -1 do begin
  6054. pSource := GetRowPointer(Row);
  6055. if (Assigned(pSource)) then begin
  6056. Move(pSource^, pTempData^, RowSize);
  6057. Inc(pTempData, RowSize);
  6058. end;
  6059. end;
  6060. SetData(pData, IntFormat, TempWidth, TempHeight);
  6061. result := true;
  6062. except
  6063. if Assigned(pData) then
  6064. FreeMem(pData);
  6065. raise;
  6066. end;
  6067. end;
  6068. end;
  6069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6070. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6071. var
  6072. Row, Col, AlphaInterleave: Integer;
  6073. pSource, pDest: PByte;
  6074. function GetRowPointer(Row: Integer): pByte;
  6075. begin
  6076. result := aSurface.pixels;
  6077. Inc(result, Row * Width);
  6078. end;
  6079. begin
  6080. result := false;
  6081. if Assigned(Data) then begin
  6082. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6083. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6084. AlphaInterleave := 0;
  6085. case Format of
  6086. tfLuminance8Alpha8ub2:
  6087. AlphaInterleave := 1;
  6088. tfBGRA8ub4, tfRGBA8ub4:
  6089. AlphaInterleave := 3;
  6090. end;
  6091. pSource := Data;
  6092. for Row := 0 to Height -1 do begin
  6093. pDest := GetRowPointer(Row);
  6094. if Assigned(pDest) then begin
  6095. for Col := 0 to Width -1 do begin
  6096. Inc(pSource, AlphaInterleave);
  6097. pDest^ := pSource^;
  6098. Inc(pDest);
  6099. Inc(pSource);
  6100. end;
  6101. end;
  6102. end;
  6103. result := true;
  6104. end;
  6105. end;
  6106. end;
  6107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6108. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6109. var
  6110. bmp: TglBitmap2D;
  6111. begin
  6112. bmp := TglBitmap2D.Create;
  6113. try
  6114. bmp.AssignFromSurface(aSurface);
  6115. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6116. finally
  6117. bmp.Free;
  6118. end;
  6119. end;
  6120. {$ENDIF}
  6121. {$IFDEF GLB_DELPHI}
  6122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6123. function CreateGrayPalette: HPALETTE;
  6124. var
  6125. Idx: Integer;
  6126. Pal: PLogPalette;
  6127. begin
  6128. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6129. Pal.palVersion := $300;
  6130. Pal.palNumEntries := 256;
  6131. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6132. Pal.palPalEntry[Idx].peRed := Idx;
  6133. Pal.palPalEntry[Idx].peGreen := Idx;
  6134. Pal.palPalEntry[Idx].peBlue := Idx;
  6135. Pal.palPalEntry[Idx].peFlags := 0;
  6136. end;
  6137. Result := CreatePalette(Pal^);
  6138. FreeMem(Pal);
  6139. end;
  6140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6141. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6142. var
  6143. Row, RowSize: Integer;
  6144. pSource, pData: PByte;
  6145. begin
  6146. result := false;
  6147. if Assigned(Data) then begin
  6148. if Assigned(aBitmap) then begin
  6149. aBitmap.Width := Width;
  6150. aBitmap.Height := Height;
  6151. case Format of
  6152. tfAlpha8ub1, tfLuminance8ub1: begin
  6153. aBitmap.PixelFormat := pf8bit;
  6154. aBitmap.Palette := CreateGrayPalette;
  6155. end;
  6156. tfRGB5A1us1:
  6157. aBitmap.PixelFormat := pf15bit;
  6158. tfR5G6B5us1:
  6159. aBitmap.PixelFormat := pf16bit;
  6160. tfRGB8ub3, tfBGR8ub3:
  6161. aBitmap.PixelFormat := pf24bit;
  6162. tfRGBA8ub4, tfBGRA8ub4:
  6163. aBitmap.PixelFormat := pf32bit;
  6164. else
  6165. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6166. end;
  6167. RowSize := FormatDescriptor.GetSize(Width, 1);
  6168. pSource := Data;
  6169. for Row := 0 to Height-1 do begin
  6170. pData := aBitmap.Scanline[Row];
  6171. Move(pSource^, pData^, RowSize);
  6172. Inc(pSource, RowSize);
  6173. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6174. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6175. end;
  6176. result := true;
  6177. end;
  6178. end;
  6179. end;
  6180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6181. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6182. var
  6183. pSource, pData, pTempData: PByte;
  6184. Row, RowSize, TempWidth, TempHeight: Integer;
  6185. IntFormat: TglBitmapFormat;
  6186. begin
  6187. result := false;
  6188. if (Assigned(aBitmap)) then begin
  6189. case aBitmap.PixelFormat of
  6190. pf8bit:
  6191. IntFormat := tfLuminance8ub1;
  6192. pf15bit:
  6193. IntFormat := tfRGB5A1us1;
  6194. pf16bit:
  6195. IntFormat := tfR5G6B5us1;
  6196. pf24bit:
  6197. IntFormat := tfBGR8ub3;
  6198. pf32bit:
  6199. IntFormat := tfBGRA8ub4;
  6200. else
  6201. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6202. end;
  6203. TempWidth := aBitmap.Width;
  6204. TempHeight := aBitmap.Height;
  6205. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6206. GetMem(pData, TempHeight * RowSize);
  6207. try
  6208. pTempData := pData;
  6209. for Row := 0 to TempHeight -1 do begin
  6210. pSource := aBitmap.Scanline[Row];
  6211. if (Assigned(pSource)) then begin
  6212. Move(pSource^, pTempData^, RowSize);
  6213. Inc(pTempData, RowSize);
  6214. end;
  6215. end;
  6216. SetData(pData, IntFormat, TempWidth, TempHeight);
  6217. result := true;
  6218. except
  6219. if Assigned(pData) then
  6220. FreeMem(pData);
  6221. raise;
  6222. end;
  6223. end;
  6224. end;
  6225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6226. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6227. var
  6228. Row, Col, AlphaInterleave: Integer;
  6229. pSource, pDest: PByte;
  6230. begin
  6231. result := false;
  6232. if Assigned(Data) then begin
  6233. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6234. if Assigned(aBitmap) then begin
  6235. aBitmap.PixelFormat := pf8bit;
  6236. aBitmap.Palette := CreateGrayPalette;
  6237. aBitmap.Width := Width;
  6238. aBitmap.Height := Height;
  6239. case Format of
  6240. tfLuminance8Alpha8ub2:
  6241. AlphaInterleave := 1;
  6242. tfRGBA8ub4, tfBGRA8ub4:
  6243. AlphaInterleave := 3;
  6244. else
  6245. AlphaInterleave := 0;
  6246. end;
  6247. // Copy Data
  6248. pSource := Data;
  6249. for Row := 0 to Height -1 do begin
  6250. pDest := aBitmap.Scanline[Row];
  6251. if Assigned(pDest) then begin
  6252. for Col := 0 to Width -1 do begin
  6253. Inc(pSource, AlphaInterleave);
  6254. pDest^ := pSource^;
  6255. Inc(pDest);
  6256. Inc(pSource);
  6257. end;
  6258. end;
  6259. end;
  6260. result := true;
  6261. end;
  6262. end;
  6263. end;
  6264. end;
  6265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6266. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6267. var
  6268. data: TglBitmapData;
  6269. begin
  6270. data := TglBitmapData.Create;
  6271. try
  6272. data.AssignFromBitmap(aBitmap);
  6273. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6274. finally
  6275. data.Free;
  6276. end;
  6277. end;
  6278. {$ENDIF}
  6279. {$IFDEF GLB_LAZARUS}
  6280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6281. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6282. var
  6283. rid: TRawImageDescription;
  6284. FormatDesc: TFormatDescriptor;
  6285. begin
  6286. if not Assigned(Data) then
  6287. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6288. result := false;
  6289. if not Assigned(aImage) or (Format = tfEmpty) then
  6290. exit;
  6291. FormatDesc := TFormatDescriptor.Get(Format);
  6292. if FormatDesc.IsCompressed then
  6293. exit;
  6294. FillChar(rid{%H-}, SizeOf(rid), 0);
  6295. if FormatDesc.IsGrayscale then
  6296. rid.Format := ricfGray
  6297. else
  6298. rid.Format := ricfRGBA;
  6299. rid.Width := Width;
  6300. rid.Height := Height;
  6301. rid.Depth := FormatDesc.BitsPerPixel;
  6302. rid.BitOrder := riboBitsInOrder;
  6303. rid.ByteOrder := riboLSBFirst;
  6304. rid.LineOrder := riloTopToBottom;
  6305. rid.LineEnd := rileTight;
  6306. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6307. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6308. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6309. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6310. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6311. rid.RedShift := FormatDesc.Shift.r;
  6312. rid.GreenShift := FormatDesc.Shift.g;
  6313. rid.BlueShift := FormatDesc.Shift.b;
  6314. rid.AlphaShift := FormatDesc.Shift.a;
  6315. rid.MaskBitsPerPixel := 0;
  6316. rid.PaletteColorCount := 0;
  6317. aImage.DataDescription := rid;
  6318. aImage.CreateData;
  6319. if not Assigned(aImage.PixelData) then
  6320. raise EglBitmap.Create('error while creating LazIntfImage');
  6321. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6322. result := true;
  6323. end;
  6324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6325. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6326. var
  6327. f: TglBitmapFormat;
  6328. FormatDesc: TFormatDescriptor;
  6329. ImageData: PByte;
  6330. ImageSize: Integer;
  6331. CanCopy: Boolean;
  6332. Mask: TglBitmapRec4ul;
  6333. procedure CopyConvert;
  6334. var
  6335. bfFormat: TbmpBitfieldFormat;
  6336. pSourceLine, pDestLine: PByte;
  6337. pSourceMD, pDestMD: Pointer;
  6338. Shift, Prec: TglBitmapRec4ub;
  6339. x, y: Integer;
  6340. pixel: TglBitmapPixelData;
  6341. begin
  6342. bfFormat := TbmpBitfieldFormat.Create;
  6343. with aImage.DataDescription do begin
  6344. Prec.r := RedPrec;
  6345. Prec.g := GreenPrec;
  6346. Prec.b := BluePrec;
  6347. Prec.a := AlphaPrec;
  6348. Shift.r := RedShift;
  6349. Shift.g := GreenShift;
  6350. Shift.b := BlueShift;
  6351. Shift.a := AlphaShift;
  6352. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6353. end;
  6354. pSourceMD := bfFormat.CreateMappingData;
  6355. pDestMD := FormatDesc.CreateMappingData;
  6356. try
  6357. for y := 0 to aImage.Height-1 do begin
  6358. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6359. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6360. for x := 0 to aImage.Width-1 do begin
  6361. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6362. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6363. end;
  6364. end;
  6365. finally
  6366. FormatDesc.FreeMappingData(pDestMD);
  6367. bfFormat.FreeMappingData(pSourceMD);
  6368. bfFormat.Free;
  6369. end;
  6370. end;
  6371. begin
  6372. result := false;
  6373. if not Assigned(aImage) then
  6374. exit;
  6375. with aImage.DataDescription do begin
  6376. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6377. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6378. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6379. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6380. end;
  6381. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6382. f := FormatDesc.Format;
  6383. if (f = tfEmpty) then
  6384. exit;
  6385. CanCopy :=
  6386. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6387. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6388. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6389. ImageData := GetMem(ImageSize);
  6390. try
  6391. if CanCopy then
  6392. Move(aImage.PixelData^, ImageData^, ImageSize)
  6393. else
  6394. CopyConvert;
  6395. SetData(ImageData, f, aImage.Width, aImage.Height);
  6396. except
  6397. if Assigned(ImageData) then
  6398. FreeMem(ImageData);
  6399. raise;
  6400. end;
  6401. result := true;
  6402. end;
  6403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6404. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6405. var
  6406. rid: TRawImageDescription;
  6407. FormatDesc: TFormatDescriptor;
  6408. Pixel: TglBitmapPixelData;
  6409. x, y: Integer;
  6410. srcMD: Pointer;
  6411. src, dst: PByte;
  6412. begin
  6413. result := false;
  6414. if not Assigned(aImage) or (Format = tfEmpty) then
  6415. exit;
  6416. FormatDesc := TFormatDescriptor.Get(Format);
  6417. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6418. exit;
  6419. FillChar(rid{%H-}, SizeOf(rid), 0);
  6420. rid.Format := ricfGray;
  6421. rid.Width := Width;
  6422. rid.Height := Height;
  6423. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6424. rid.BitOrder := riboBitsInOrder;
  6425. rid.ByteOrder := riboLSBFirst;
  6426. rid.LineOrder := riloTopToBottom;
  6427. rid.LineEnd := rileTight;
  6428. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6429. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6430. rid.GreenPrec := 0;
  6431. rid.BluePrec := 0;
  6432. rid.AlphaPrec := 0;
  6433. rid.RedShift := 0;
  6434. rid.GreenShift := 0;
  6435. rid.BlueShift := 0;
  6436. rid.AlphaShift := 0;
  6437. rid.MaskBitsPerPixel := 0;
  6438. rid.PaletteColorCount := 0;
  6439. aImage.DataDescription := rid;
  6440. aImage.CreateData;
  6441. srcMD := FormatDesc.CreateMappingData;
  6442. try
  6443. FormatDesc.PreparePixel(Pixel);
  6444. src := Data;
  6445. dst := aImage.PixelData;
  6446. for y := 0 to Height-1 do
  6447. for x := 0 to Width-1 do begin
  6448. FormatDesc.Unmap(src, Pixel, srcMD);
  6449. case rid.BitsPerPixel of
  6450. 8: begin
  6451. dst^ := Pixel.Data.a;
  6452. inc(dst);
  6453. end;
  6454. 16: begin
  6455. PWord(dst)^ := Pixel.Data.a;
  6456. inc(dst, 2);
  6457. end;
  6458. 24: begin
  6459. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6460. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6461. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6462. inc(dst, 3);
  6463. end;
  6464. 32: begin
  6465. PCardinal(dst)^ := Pixel.Data.a;
  6466. inc(dst, 4);
  6467. end;
  6468. else
  6469. raise EglBitmapUnsupportedFormat.Create(Format);
  6470. end;
  6471. end;
  6472. finally
  6473. FormatDesc.FreeMappingData(srcMD);
  6474. end;
  6475. result := true;
  6476. end;
  6477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6478. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6479. var
  6480. data: TglBitmapData;
  6481. begin
  6482. data := TglBitmapData.Create;
  6483. try
  6484. data.AssignFromLazIntfImage(aImage);
  6485. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6486. finally
  6487. data.Free;
  6488. end;
  6489. end;
  6490. {$ENDIF}
  6491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6492. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6493. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6494. var
  6495. rs: TResourceStream;
  6496. begin
  6497. PrepareResType(aResource, aResType);
  6498. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6499. try
  6500. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6501. finally
  6502. rs.Free;
  6503. end;
  6504. end;
  6505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6506. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6507. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6508. var
  6509. rs: TResourceStream;
  6510. begin
  6511. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6512. try
  6513. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6514. finally
  6515. rs.Free;
  6516. end;
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6520. begin
  6521. if TFormatDescriptor.Get(Format).IsCompressed then
  6522. raise EglBitmapUnsupportedFormat.Create(Format);
  6523. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6524. end;
  6525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6526. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6527. var
  6528. FS: TFileStream;
  6529. begin
  6530. FS := TFileStream.Create(aFileName, fmOpenRead);
  6531. try
  6532. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6533. finally
  6534. FS.Free;
  6535. end;
  6536. end;
  6537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6538. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6539. var
  6540. data: TglBitmapData;
  6541. begin
  6542. data := TglBitmapData.Create(aStream);
  6543. try
  6544. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6545. finally
  6546. data.Free;
  6547. end;
  6548. end;
  6549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6550. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6551. var
  6552. DestData, DestData2, SourceData: pByte;
  6553. TempHeight, TempWidth: Integer;
  6554. SourceFD, DestFD: TFormatDescriptor;
  6555. SourceMD, DestMD, DestMD2: Pointer;
  6556. FuncRec: TglBitmapFunctionRec;
  6557. begin
  6558. result := false;
  6559. Assert(Assigned(Data));
  6560. Assert(Assigned(aDataObj));
  6561. Assert(Assigned(aDataObj.Data));
  6562. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6563. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6564. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6565. DestFD := TFormatDescriptor.Get(Format);
  6566. if not Assigned(aFunc) then begin
  6567. aFunc := glBitmapAlphaFunc;
  6568. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6569. end else
  6570. FuncRec.Args := aArgs;
  6571. // Values
  6572. TempWidth := aDataObj.Width;
  6573. TempHeight := aDataObj.Height;
  6574. if (TempWidth <= 0) or (TempHeight <= 0) then
  6575. exit;
  6576. FuncRec.Sender := Self;
  6577. FuncRec.Size := Dimension;
  6578. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6579. DestData := Data;
  6580. DestData2 := Data;
  6581. SourceData := aDataObj.Data;
  6582. // Mapping
  6583. SourceFD.PreparePixel(FuncRec.Source);
  6584. DestFD.PreparePixel (FuncRec.Dest);
  6585. SourceMD := SourceFD.CreateMappingData;
  6586. DestMD := DestFD.CreateMappingData;
  6587. DestMD2 := DestFD.CreateMappingData;
  6588. try
  6589. FuncRec.Position.Y := 0;
  6590. while FuncRec.Position.Y < TempHeight do begin
  6591. FuncRec.Position.X := 0;
  6592. while FuncRec.Position.X < TempWidth do begin
  6593. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6594. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6595. aFunc(FuncRec);
  6596. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6597. inc(FuncRec.Position.X);
  6598. end;
  6599. inc(FuncRec.Position.Y);
  6600. end;
  6601. finally
  6602. SourceFD.FreeMappingData(SourceMD);
  6603. DestFD.FreeMappingData(DestMD);
  6604. DestFD.FreeMappingData(DestMD2);
  6605. end;
  6606. end;
  6607. end;
  6608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6609. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6610. begin
  6611. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6612. end;
  6613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6614. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6615. var
  6616. PixelData: TglBitmapPixelData;
  6617. begin
  6618. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6619. result := AddAlphaFromColorKeyFloat(
  6620. aRed / PixelData.Range.r,
  6621. aGreen / PixelData.Range.g,
  6622. aBlue / PixelData.Range.b,
  6623. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6624. end;
  6625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6626. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6627. var
  6628. values: array[0..2] of Single;
  6629. tmp: Cardinal;
  6630. i: Integer;
  6631. PixelData: TglBitmapPixelData;
  6632. begin
  6633. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6634. with PixelData do begin
  6635. values[0] := aRed;
  6636. values[1] := aGreen;
  6637. values[2] := aBlue;
  6638. for i := 0 to 2 do begin
  6639. tmp := Trunc(Range.arr[i] * aDeviation);
  6640. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6641. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6642. end;
  6643. Data.a := 0;
  6644. Range.a := 0;
  6645. end;
  6646. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6647. end;
  6648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6649. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6650. begin
  6651. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6652. end;
  6653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6654. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6655. var
  6656. PixelData: TglBitmapPixelData;
  6657. begin
  6658. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6659. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6660. end;
  6661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6662. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6663. var
  6664. PixelData: TglBitmapPixelData;
  6665. begin
  6666. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6667. with PixelData do
  6668. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6669. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6670. end;
  6671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6672. function TglBitmapData.RemoveAlpha: Boolean;
  6673. var
  6674. FormatDesc: TFormatDescriptor;
  6675. begin
  6676. result := false;
  6677. FormatDesc := TFormatDescriptor.Get(Format);
  6678. if Assigned(Data) then begin
  6679. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6680. raise EglBitmapUnsupportedFormat.Create(Format);
  6681. result := ConvertTo(FormatDesc.WithoutAlpha);
  6682. end;
  6683. end;
  6684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6685. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6686. const aAlpha: Byte);
  6687. begin
  6688. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6689. end;
  6690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6691. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6692. var
  6693. PixelData: TglBitmapPixelData;
  6694. begin
  6695. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6696. FillWithColorFloat(
  6697. aRed / PixelData.Range.r,
  6698. aGreen / PixelData.Range.g,
  6699. aBlue / PixelData.Range.b,
  6700. aAlpha / PixelData.Range.a);
  6701. end;
  6702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6703. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6704. var
  6705. PixelData: TglBitmapPixelData;
  6706. begin
  6707. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6708. with PixelData do begin
  6709. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6710. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6711. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6712. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6713. end;
  6714. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6715. end;
  6716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6717. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6718. begin
  6719. if (Data <> aData) then begin
  6720. if (Assigned(Data)) then
  6721. FreeMem(Data);
  6722. fData := aData;
  6723. end;
  6724. if Assigned(fData) then begin
  6725. FillChar(fDimension, SizeOf(fDimension), 0);
  6726. if aWidth <> -1 then begin
  6727. fDimension.Fields := fDimension.Fields + [ffX];
  6728. fDimension.X := aWidth;
  6729. end;
  6730. if aHeight <> -1 then begin
  6731. fDimension.Fields := fDimension.Fields + [ffY];
  6732. fDimension.Y := aHeight;
  6733. end;
  6734. fFormat := aFormat;
  6735. end else
  6736. fFormat := tfEmpty;
  6737. UpdateScanlines;
  6738. end;
  6739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6740. function TglBitmapData.Clone: TglBitmapData;
  6741. var
  6742. Temp: TglBitmapData;
  6743. TempPtr: PByte;
  6744. Size: Integer;
  6745. begin
  6746. result := nil;
  6747. Temp := (ClassType.Create as TglBitmapData);
  6748. try
  6749. // copy texture data if assigned
  6750. if Assigned(Data) then begin
  6751. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6752. GetMem(TempPtr, Size);
  6753. try
  6754. Move(Data^, TempPtr^, Size);
  6755. Temp.SetData(TempPtr, Format, Width, Height);
  6756. except
  6757. if Assigned(TempPtr) then
  6758. FreeMem(TempPtr);
  6759. raise;
  6760. end;
  6761. end else begin
  6762. TempPtr := nil;
  6763. Temp.SetData(TempPtr, Format, Width, Height);
  6764. end;
  6765. // copy properties
  6766. Temp.fFormat := Format;
  6767. result := Temp;
  6768. except
  6769. FreeAndNil(Temp);
  6770. raise;
  6771. end;
  6772. end;
  6773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6774. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6775. var
  6776. mask: PtrInt;
  6777. begin
  6778. mask :=
  6779. (Byte(aRed) and 1) or
  6780. ((Byte(aGreen) and 1) shl 1) or
  6781. ((Byte(aBlue) and 1) shl 2) or
  6782. ((Byte(aAlpha) and 1) shl 3);
  6783. if (mask > 0) then
  6784. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6785. end;
  6786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6787. type
  6788. TMatrixItem = record
  6789. X, Y: Integer;
  6790. W: Single;
  6791. end;
  6792. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6793. TglBitmapToNormalMapRec = Record
  6794. Scale: Single;
  6795. Heights: array of Single;
  6796. MatrixU : array of TMatrixItem;
  6797. MatrixV : array of TMatrixItem;
  6798. end;
  6799. const
  6800. ONE_OVER_255 = 1 / 255;
  6801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6802. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6803. var
  6804. Val: Single;
  6805. begin
  6806. with FuncRec do begin
  6807. Val :=
  6808. Source.Data.r * LUMINANCE_WEIGHT_R +
  6809. Source.Data.g * LUMINANCE_WEIGHT_G +
  6810. Source.Data.b * LUMINANCE_WEIGHT_B;
  6811. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6812. end;
  6813. end;
  6814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6815. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6816. begin
  6817. with FuncRec do
  6818. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6819. end;
  6820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6821. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6822. type
  6823. TVec = Array[0..2] of Single;
  6824. var
  6825. Idx: Integer;
  6826. du, dv: Double;
  6827. Len: Single;
  6828. Vec: TVec;
  6829. function GetHeight(X, Y: Integer): Single;
  6830. begin
  6831. with FuncRec do begin
  6832. X := Max(0, Min(Size.X -1, X));
  6833. Y := Max(0, Min(Size.Y -1, Y));
  6834. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6835. end;
  6836. end;
  6837. begin
  6838. with FuncRec do begin
  6839. with PglBitmapToNormalMapRec(Args)^ do begin
  6840. du := 0;
  6841. for Idx := Low(MatrixU) to High(MatrixU) do
  6842. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6843. dv := 0;
  6844. for Idx := Low(MatrixU) to High(MatrixU) do
  6845. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6846. Vec[0] := -du * Scale;
  6847. Vec[1] := -dv * Scale;
  6848. Vec[2] := 1;
  6849. end;
  6850. // Normalize
  6851. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6852. if Len <> 0 then begin
  6853. Vec[0] := Vec[0] * Len;
  6854. Vec[1] := Vec[1] * Len;
  6855. Vec[2] := Vec[2] * Len;
  6856. end;
  6857. // Farbe zuweisem
  6858. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6859. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6860. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6861. end;
  6862. end;
  6863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6864. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6865. var
  6866. Rec: TglBitmapToNormalMapRec;
  6867. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6868. begin
  6869. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6870. Matrix[Index].X := X;
  6871. Matrix[Index].Y := Y;
  6872. Matrix[Index].W := W;
  6873. end;
  6874. end;
  6875. begin
  6876. if TFormatDescriptor.Get(Format).IsCompressed then
  6877. raise EglBitmapUnsupportedFormat.Create(Format);
  6878. if aScale > 100 then
  6879. Rec.Scale := 100
  6880. else if aScale < -100 then
  6881. Rec.Scale := -100
  6882. else
  6883. Rec.Scale := aScale;
  6884. SetLength(Rec.Heights, Width * Height);
  6885. try
  6886. case aFunc of
  6887. nm4Samples: begin
  6888. SetLength(Rec.MatrixU, 2);
  6889. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6890. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6891. SetLength(Rec.MatrixV, 2);
  6892. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6893. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6894. end;
  6895. nmSobel: begin
  6896. SetLength(Rec.MatrixU, 6);
  6897. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6898. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6899. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6900. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6901. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6902. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6903. SetLength(Rec.MatrixV, 6);
  6904. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6905. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6906. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6907. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6908. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6909. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6910. end;
  6911. nm3x3: begin
  6912. SetLength(Rec.MatrixU, 6);
  6913. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6914. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6915. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6916. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6917. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6918. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6919. SetLength(Rec.MatrixV, 6);
  6920. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6921. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6922. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6923. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6924. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6925. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6926. end;
  6927. nm5x5: begin
  6928. SetLength(Rec.MatrixU, 20);
  6929. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6930. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6931. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6932. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6933. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6934. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6935. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6936. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6937. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6938. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6939. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6940. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6941. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6942. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6943. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6944. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6945. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6946. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6947. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6948. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6949. SetLength(Rec.MatrixV, 20);
  6950. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6951. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6952. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6953. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6954. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6955. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6956. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6957. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6958. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6959. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6960. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6961. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6962. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6963. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6964. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6965. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6966. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6967. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6968. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6969. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6970. end;
  6971. end;
  6972. // Daten Sammeln
  6973. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6974. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6975. else
  6976. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6977. Convert(glBitmapToNormalMapFunc, false, @Rec);
  6978. finally
  6979. SetLength(Rec.Heights, 0);
  6980. end;
  6981. end;
  6982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6983. constructor TglBitmapData.Create;
  6984. begin
  6985. inherited Create;
  6986. fFormat := glBitmapDefaultFormat;
  6987. end;
  6988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6989. constructor TglBitmapData.Create(const aFileName: String);
  6990. begin
  6991. Create;
  6992. LoadFromFile(aFileName);
  6993. end;
  6994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6995. constructor TglBitmapData.Create(const aStream: TStream);
  6996. begin
  6997. Create;
  6998. LoadFromStream(aStream);
  6999. end;
  7000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7001. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  7002. var
  7003. ImageSize: Integer;
  7004. begin
  7005. Create;
  7006. if not Assigned(aData) then begin
  7007. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7008. GetMem(aData, ImageSize);
  7009. try
  7010. FillChar(aData^, ImageSize, #$FF);
  7011. SetData(aData, aFormat, aSize.X, aSize.Y);
  7012. except
  7013. if Assigned(aData) then
  7014. FreeMem(aData);
  7015. raise;
  7016. end;
  7017. end else begin
  7018. SetData(aData, aFormat, aSize.X, aSize.Y);
  7019. end;
  7020. end;
  7021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7022. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7023. begin
  7024. Create;
  7025. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7026. end;
  7027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7028. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7029. begin
  7030. Create;
  7031. LoadFromResource(aInstance, aResource, aResType);
  7032. end;
  7033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7034. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7035. begin
  7036. Create;
  7037. LoadFromResourceID(aInstance, aResourceID, aResType);
  7038. end;
  7039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7040. destructor TglBitmapData.Destroy;
  7041. begin
  7042. SetData(nil, tfEmpty);
  7043. inherited Destroy;
  7044. end;
  7045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7046. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7048. function TglBitmap.GetWidth: Integer;
  7049. begin
  7050. if (ffX in fDimension.Fields) then
  7051. result := fDimension.X
  7052. else
  7053. result := -1;
  7054. end;
  7055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7056. function TglBitmap.GetHeight: Integer;
  7057. begin
  7058. if (ffY in fDimension.Fields) then
  7059. result := fDimension.Y
  7060. else
  7061. result := -1;
  7062. end;
  7063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7064. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7065. begin
  7066. if fCustomData = aValue then
  7067. exit;
  7068. fCustomData := aValue;
  7069. end;
  7070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. procedure TglBitmap.SetCustomName(const aValue: String);
  7072. begin
  7073. if fCustomName = aValue then
  7074. exit;
  7075. fCustomName := aValue;
  7076. end;
  7077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7078. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7079. begin
  7080. if fCustomNameW = aValue then
  7081. exit;
  7082. fCustomNameW := aValue;
  7083. end;
  7084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7085. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7086. begin
  7087. if fDeleteTextureOnFree = aValue then
  7088. exit;
  7089. fDeleteTextureOnFree := aValue;
  7090. end;
  7091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7092. procedure TglBitmap.SetID(const aValue: Cardinal);
  7093. begin
  7094. if fID = aValue then
  7095. exit;
  7096. fID := aValue;
  7097. end;
  7098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7099. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7100. begin
  7101. if fMipMap = aValue then
  7102. exit;
  7103. fMipMap := aValue;
  7104. end;
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7107. begin
  7108. if fTarget = aValue then
  7109. exit;
  7110. fTarget := aValue;
  7111. end;
  7112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7113. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7114. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7115. var
  7116. MaxAnisotropic: Integer;
  7117. {$IFEND}
  7118. begin
  7119. fAnisotropic := aValue;
  7120. if (ID > 0) then begin
  7121. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7122. if GL_EXT_texture_filter_anisotropic then begin
  7123. if fAnisotropic > 0 then begin
  7124. Bind(false);
  7125. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7126. if aValue > MaxAnisotropic then
  7127. fAnisotropic := MaxAnisotropic;
  7128. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7129. end;
  7130. end else begin
  7131. fAnisotropic := 0;
  7132. end;
  7133. {$ELSE}
  7134. fAnisotropic := 0;
  7135. {$IFEND}
  7136. end;
  7137. end;
  7138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7139. procedure TglBitmap.CreateID;
  7140. begin
  7141. if (ID <> 0) then
  7142. glDeleteTextures(1, @fID);
  7143. glGenTextures(1, @fID);
  7144. Bind(false);
  7145. end;
  7146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7147. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  7148. begin
  7149. // Set Up Parameters
  7150. SetWrap(fWrapS, fWrapT, fWrapR);
  7151. SetFilter(fFilterMin, fFilterMag);
  7152. SetAnisotropic(fAnisotropic);
  7153. {$IFNDEF OPENGL_ES}
  7154. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7155. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7156. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7157. {$ENDIF}
  7158. {$IFNDEF OPENGL_ES}
  7159. // Mip Maps Generation Mode
  7160. aBuildWithGlu := false;
  7161. if (MipMap = mmMipmap) then begin
  7162. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  7163. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  7164. else
  7165. aBuildWithGlu := true;
  7166. end else if (MipMap = mmMipmapGlu) then
  7167. aBuildWithGlu := true;
  7168. {$ELSE}
  7169. if (MipMap = mmMipmap) then
  7170. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  7171. {$ENDIF}
  7172. end;
  7173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7174. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7176. procedure TglBitmap.AfterConstruction;
  7177. begin
  7178. inherited AfterConstruction;
  7179. fID := 0;
  7180. fTarget := 0;
  7181. {$IFNDEF OPENGL_ES}
  7182. fIsResident := false;
  7183. {$ENDIF}
  7184. fMipMap := glBitmapDefaultMipmap;
  7185. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7186. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7187. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7188. {$IFNDEF OPENGL_ES}
  7189. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7190. {$ENDIF}
  7191. end;
  7192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7193. procedure TglBitmap.BeforeDestruction;
  7194. begin
  7195. if (fID > 0) and fDeleteTextureOnFree then
  7196. glDeleteTextures(1, @fID);
  7197. inherited BeforeDestruction;
  7198. end;
  7199. {$IFNDEF OPENGL_ES}
  7200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7201. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7202. begin
  7203. fBorderColor[0] := aRed;
  7204. fBorderColor[1] := aGreen;
  7205. fBorderColor[2] := aBlue;
  7206. fBorderColor[3] := aAlpha;
  7207. if (ID > 0) then begin
  7208. Bind(false);
  7209. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7210. end;
  7211. end;
  7212. {$ENDIF}
  7213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7214. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7215. begin
  7216. //check MIN filter
  7217. case aMin of
  7218. GL_NEAREST:
  7219. fFilterMin := GL_NEAREST;
  7220. GL_LINEAR:
  7221. fFilterMin := GL_LINEAR;
  7222. GL_NEAREST_MIPMAP_NEAREST:
  7223. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7224. GL_LINEAR_MIPMAP_NEAREST:
  7225. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7226. GL_NEAREST_MIPMAP_LINEAR:
  7227. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7228. GL_LINEAR_MIPMAP_LINEAR:
  7229. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7230. else
  7231. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7232. end;
  7233. //check MAG filter
  7234. case aMag of
  7235. GL_NEAREST:
  7236. fFilterMag := GL_NEAREST;
  7237. GL_LINEAR:
  7238. fFilterMag := GL_LINEAR;
  7239. else
  7240. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7241. end;
  7242. //apply filter
  7243. if (ID > 0) then begin
  7244. Bind(false);
  7245. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7246. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7247. case fFilterMin of
  7248. GL_NEAREST, GL_LINEAR:
  7249. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7250. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7251. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7252. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7253. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7254. end;
  7255. end else
  7256. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7257. end;
  7258. end;
  7259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7260. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7261. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7262. begin
  7263. case aValue of
  7264. {$IFNDEF OPENGL_ES}
  7265. GL_CLAMP:
  7266. aTarget := GL_CLAMP;
  7267. {$ENDIF}
  7268. GL_REPEAT:
  7269. aTarget := GL_REPEAT;
  7270. GL_CLAMP_TO_EDGE: begin
  7271. {$IFNDEF OPENGL_ES}
  7272. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7273. aTarget := GL_CLAMP
  7274. else
  7275. {$ENDIF}
  7276. aTarget := GL_CLAMP_TO_EDGE;
  7277. end;
  7278. {$IFNDEF OPENGL_ES}
  7279. GL_CLAMP_TO_BORDER: begin
  7280. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7281. aTarget := GL_CLAMP_TO_BORDER
  7282. else
  7283. aTarget := GL_CLAMP;
  7284. end;
  7285. {$ENDIF}
  7286. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7287. GL_MIRRORED_REPEAT: begin
  7288. {$IFNDEF OPENGL_ES}
  7289. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7290. {$ELSE}
  7291. if GL_VERSION_2_0 then
  7292. {$ENDIF}
  7293. aTarget := GL_MIRRORED_REPEAT
  7294. else
  7295. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7296. end;
  7297. {$IFEND}
  7298. else
  7299. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7300. end;
  7301. end;
  7302. begin
  7303. CheckAndSetWrap(S, fWrapS);
  7304. CheckAndSetWrap(T, fWrapT);
  7305. CheckAndSetWrap(R, fWrapR);
  7306. if (ID > 0) then begin
  7307. Bind(false);
  7308. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7309. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7310. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7311. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7312. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7313. {$IFEND}
  7314. end;
  7315. end;
  7316. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7318. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7319. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7320. begin
  7321. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7322. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7323. fSwizzle[aIndex] := aValue
  7324. else
  7325. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7326. end;
  7327. begin
  7328. {$IFNDEF OPENGL_ES}
  7329. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7330. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7331. {$ELSE}
  7332. if not GL_VERSION_3_0 then
  7333. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7334. {$ENDIF}
  7335. CheckAndSetValue(r, 0);
  7336. CheckAndSetValue(g, 1);
  7337. CheckAndSetValue(b, 2);
  7338. CheckAndSetValue(a, 3);
  7339. if (ID > 0) then begin
  7340. Bind(false);
  7341. {$IFNDEF OPENGL_ES}
  7342. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7343. {$ELSE}
  7344. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7345. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7346. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7347. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7348. {$ENDIF}
  7349. end;
  7350. end;
  7351. {$IFEND}
  7352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7353. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  7354. begin
  7355. if aEnableTextureUnit then
  7356. glEnable(Target);
  7357. if (ID > 0) then
  7358. glBindTexture(Target, ID);
  7359. end;
  7360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7361. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  7362. begin
  7363. if aDisableTextureUnit then
  7364. glDisable(Target);
  7365. glBindTexture(Target, 0);
  7366. end;
  7367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7368. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7369. var
  7370. w, h: Integer;
  7371. begin
  7372. w := aDataObj.Width;
  7373. h := aDataObj.Height;
  7374. fDimension.Fields := [];
  7375. if (w > 0) then
  7376. fDimension.Fields := fDimension.Fields + [ffX];
  7377. if (h > 0) then
  7378. fDimension.Fields := fDimension.Fields + [ffY];
  7379. fDimension.X := w;
  7380. fDimension.Y := h;
  7381. end;
  7382. {$IFNDEF OPENGL_ES}
  7383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7384. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7385. var
  7386. Temp: PByte;
  7387. TempWidth, TempHeight: Integer;
  7388. TempIntFormat: GLint;
  7389. IntFormat: TglBitmapFormat;
  7390. FormatDesc: TFormatDescriptor;
  7391. begin
  7392. result := false;
  7393. Bind;
  7394. // Request Data
  7395. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7396. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7397. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7398. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7399. IntFormat := FormatDesc.Format;
  7400. // Getting data from OpenGL
  7401. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7402. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7403. try
  7404. if FormatDesc.IsCompressed then begin
  7405. if not Assigned(glGetCompressedTexImage) then
  7406. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7407. glGetCompressedTexImage(Target, 0, Temp)
  7408. end else
  7409. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7410. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7411. result := true;
  7412. except
  7413. if Assigned(Temp) then
  7414. FreeMem(Temp);
  7415. raise;
  7416. end;
  7417. end;
  7418. {$ENDIF}
  7419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7420. constructor TglBitmap.Create;
  7421. begin
  7422. if (ClassType = TglBitmap) then
  7423. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7424. inherited Create;
  7425. end;
  7426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7427. constructor TglBitmap.Create(const aData: TglBitmapData);
  7428. begin
  7429. Create;
  7430. UploadData(aData);
  7431. end;
  7432. {$IFNDEF OPENGL_ES}
  7433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7434. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7436. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  7437. var
  7438. fd: TglBitmapFormatDescriptor;
  7439. begin
  7440. // Upload data
  7441. fd := aDataObj.FormatDescriptor;
  7442. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7443. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7444. if fd.IsCompressed then begin
  7445. if not Assigned(glCompressedTexImage1D) then
  7446. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7447. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
  7448. end else if aBuildWithGlu then
  7449. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7450. else
  7451. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7452. end;
  7453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7454. procedure TglBitmap1D.AfterConstruction;
  7455. begin
  7456. inherited;
  7457. Target := GL_TEXTURE_1D;
  7458. end;
  7459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7460. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7461. var
  7462. BuildWithGlu, TexRec: Boolean;
  7463. TexSize: Integer;
  7464. begin
  7465. if not Assigned(aDataObj) then
  7466. exit;
  7467. // Check Texture Size
  7468. if (aCheckSize) then begin
  7469. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7470. if (aDataObj.Width > TexSize) then
  7471. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7472. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7473. (Target = GL_TEXTURE_RECTANGLE);
  7474. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7475. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7476. end;
  7477. if (fID = 0) then
  7478. CreateID;
  7479. SetupParameters(BuildWithGlu);
  7480. UploadDataIntern(aDataObj, BuildWithGlu);
  7481. glAreTexturesResident(1, @fID, @fIsResident);
  7482. inherited UploadData(aDataObj, aCheckSize);
  7483. end;
  7484. {$ENDIF}
  7485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7486. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7488. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7489. var
  7490. fd: TglBitmapFormatDescriptor;
  7491. begin
  7492. fd := aDataObj.FormatDescriptor;
  7493. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7494. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7495. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7496. if fd.IsCompressed then begin
  7497. if not Assigned(glCompressedTexImage2D) then
  7498. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7499. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
  7500. {$IFNDEF OPENGL_ES}
  7501. end else if aBuildWithGlu then begin
  7502. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7503. {$ENDIF}
  7504. end else begin
  7505. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7506. end;
  7507. end;
  7508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7509. procedure TglBitmap2D.AfterConstruction;
  7510. begin
  7511. inherited;
  7512. Target := GL_TEXTURE_2D;
  7513. end;
  7514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7515. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7516. var
  7517. {$IFNDEF OPENGL_ES}
  7518. BuildWithGlu, TexRec: Boolean;
  7519. {$ENDIF}
  7520. PotTex: Boolean;
  7521. TexSize: Integer;
  7522. begin
  7523. if not Assigned(aDataObj) then
  7524. exit;
  7525. // Check Texture Size
  7526. if (aCheckSize) then begin
  7527. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7528. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7529. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7530. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7531. {$IF NOT DEFINED(OPENGL_ES)}
  7532. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7533. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7534. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7535. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7536. if not PotTex and not GL_OES_texture_npot then
  7537. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7538. {$ELSE}
  7539. if not PotTex then
  7540. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7541. {$IFEND}
  7542. end;
  7543. if (fID = 0) then
  7544. CreateID;
  7545. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7546. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7547. {$IFNDEF OPENGL_ES}
  7548. glAreTexturesResident(1, @fID, @fIsResident);
  7549. {$ENDIF}
  7550. inherited UploadData(aDataObj, aCheckSize);
  7551. end;
  7552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7553. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7554. var
  7555. Temp: pByte;
  7556. Size, w, h: Integer;
  7557. FormatDesc: TFormatDescriptor;
  7558. begin
  7559. FormatDesc := TFormatDescriptor.Get(aFormat);
  7560. if FormatDesc.IsCompressed then
  7561. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7562. w := aRight - aLeft;
  7563. h := aBottom - aTop;
  7564. Size := FormatDesc.GetSize(w, h);
  7565. GetMem(Temp, Size);
  7566. try
  7567. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7568. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7569. aDataObj.SetData(Temp, aFormat, w, h);
  7570. aDataObj.FlipVert;
  7571. except
  7572. if Assigned(Temp) then
  7573. FreeMem(Temp);
  7574. raise;
  7575. end;
  7576. end;
  7577. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7579. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7581. procedure TglBitmapCubeMap.AfterConstruction;
  7582. begin
  7583. inherited;
  7584. {$IFNDEF OPENGL_ES}
  7585. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7586. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7587. {$ELSE}
  7588. if not (GL_VERSION_2_0) then
  7589. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7590. {$ENDIF}
  7591. SetWrap;
  7592. Target := GL_TEXTURE_CUBE_MAP;
  7593. {$IFNDEF OPENGL_ES}
  7594. fGenMode := GL_REFLECTION_MAP;
  7595. {$ENDIF}
  7596. end;
  7597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7598. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7599. begin
  7600. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7601. end;
  7602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7603. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7604. var
  7605. {$IFNDEF OPENGL_ES}
  7606. BuildWithGlu: Boolean;
  7607. {$ENDIF}
  7608. TexSize: Integer;
  7609. begin
  7610. if (aCheckSize) then begin
  7611. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7612. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7613. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7614. {$IF NOT DEFINED(OPENGL_ES)}
  7615. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7616. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7617. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7618. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7619. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7620. {$ELSE}
  7621. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7622. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7623. {$IFEND}
  7624. end;
  7625. if (fID = 0) then
  7626. CreateID;
  7627. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7628. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7629. inherited UploadData(aDataObj, aCheckSize);
  7630. end;
  7631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7632. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7633. begin
  7634. inherited Bind (aEnableTextureUnit);
  7635. {$IFNDEF OPENGL_ES}
  7636. if aEnableTexCoordsGen then begin
  7637. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7638. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7639. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7640. glEnable(GL_TEXTURE_GEN_S);
  7641. glEnable(GL_TEXTURE_GEN_T);
  7642. glEnable(GL_TEXTURE_GEN_R);
  7643. end;
  7644. {$ENDIF}
  7645. end;
  7646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7647. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7648. begin
  7649. inherited Unbind(aDisableTextureUnit);
  7650. {$IFNDEF OPENGL_ES}
  7651. if aDisableTexCoordsGen then begin
  7652. glDisable(GL_TEXTURE_GEN_S);
  7653. glDisable(GL_TEXTURE_GEN_T);
  7654. glDisable(GL_TEXTURE_GEN_R);
  7655. end;
  7656. {$ENDIF}
  7657. end;
  7658. {$IFEND}
  7659. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7661. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7663. type
  7664. TVec = Array[0..2] of Single;
  7665. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7666. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7667. TglBitmapNormalMapRec = record
  7668. HalfSize : Integer;
  7669. Func: TglBitmapNormalMapGetVectorFunc;
  7670. end;
  7671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7672. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7673. begin
  7674. aVec[0] := aHalfSize;
  7675. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7676. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7677. end;
  7678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7679. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7680. begin
  7681. aVec[0] := - aHalfSize;
  7682. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7683. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7684. end;
  7685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7686. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7687. begin
  7688. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7689. aVec[1] := aHalfSize;
  7690. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7691. end;
  7692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7693. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7694. begin
  7695. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7696. aVec[1] := - aHalfSize;
  7697. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7698. end;
  7699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7700. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7701. begin
  7702. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7703. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7704. aVec[2] := aHalfSize;
  7705. end;
  7706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7707. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7708. begin
  7709. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7710. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7711. aVec[2] := - aHalfSize;
  7712. end;
  7713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7714. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7715. var
  7716. i: Integer;
  7717. Vec: TVec;
  7718. Len: Single;
  7719. begin
  7720. with FuncRec do begin
  7721. with PglBitmapNormalMapRec(Args)^ do begin
  7722. Func(Vec, Position, HalfSize);
  7723. // Normalize
  7724. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7725. if Len <> 0 then begin
  7726. Vec[0] := Vec[0] * Len;
  7727. Vec[1] := Vec[1] * Len;
  7728. Vec[2] := Vec[2] * Len;
  7729. end;
  7730. // Scale Vector and AddVectro
  7731. Vec[0] := Vec[0] * 0.5 + 0.5;
  7732. Vec[1] := Vec[1] * 0.5 + 0.5;
  7733. Vec[2] := Vec[2] * 0.5 + 0.5;
  7734. end;
  7735. // Set Color
  7736. for i := 0 to 2 do
  7737. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7738. end;
  7739. end;
  7740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7741. procedure TglBitmapNormalMap.AfterConstruction;
  7742. begin
  7743. inherited;
  7744. {$IFNDEF OPENGL_ES}
  7745. fGenMode := GL_NORMAL_MAP;
  7746. {$ENDIF}
  7747. end;
  7748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7749. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7750. var
  7751. Rec: TglBitmapNormalMapRec;
  7752. SizeRec: TglBitmapSize;
  7753. DataObj: TglBitmapData;
  7754. begin
  7755. Rec.HalfSize := aSize div 2;
  7756. SizeRec.Fields := [ffX, ffY];
  7757. SizeRec.X := aSize;
  7758. SizeRec.Y := aSize;
  7759. DataObj := TglBitmapData.Create;
  7760. try
  7761. // Positive X
  7762. Rec.Func := glBitmapNormalMapPosX;
  7763. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7764. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7765. // Negative X
  7766. Rec.Func := glBitmapNormalMapNegX;
  7767. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7768. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7769. // Positive Y
  7770. Rec.Func := glBitmapNormalMapPosY;
  7771. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7772. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7773. // Negative Y
  7774. Rec.Func := glBitmapNormalMapNegY;
  7775. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7776. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7777. // Positive Z
  7778. Rec.Func := glBitmapNormalMapPosZ;
  7779. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7780. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7781. // Negative Z
  7782. Rec.Func := glBitmapNormalMapNegZ;
  7783. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7784. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7785. finally
  7786. FreeAndNil(DataObj);
  7787. end;
  7788. end;
  7789. {$IFEND}
  7790. initialization
  7791. glBitmapSetDefaultFormat (tfEmpty);
  7792. glBitmapSetDefaultMipmap (mmMipmap);
  7793. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7794. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7795. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7796. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7797. {$IFEND}
  7798. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7799. glBitmapSetDefaultDeleteTextureOnFree (true);
  7800. TFormatDescriptor.Init;
  7801. finalization
  7802. TFormatDescriptor.Finalize;
  7803. end.