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 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
10 jaren geleden
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885
  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. interface
  149. uses
  150. {$IFDEF OPENGL_ES} dglOpenGLES,
  151. {$ELSE} dglOpenGL, {$ENDIF}
  152. {$IF DEFINED(GLB_WIN) AND
  153. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  154. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  155. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  156. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  157. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  158. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  159. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  160. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  161. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  162. Classes, SysUtils;
  163. type
  164. {$IFNDEF fpc}
  165. QWord = System.UInt64;
  166. PQWord = ^QWord;
  167. PtrInt = Longint;
  168. PtrUInt = DWord;
  169. {$ENDIF}
  170. { type that describes the format of the data stored in a texture.
  171. the name of formats is composed of the following constituents:
  172. - multiple channels:
  173. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  174. - width of the chanel in bit (4, 8, 16, ...)
  175. - data type (e.g. ub, us, ui)
  176. - number of elements of data types }
  177. TglBitmapFormat = (
  178. tfEmpty = 0,
  179. tfAlpha4ub1, //< 1 x unsigned byte
  180. tfAlpha8ub1, //< 1 x unsigned byte
  181. tfAlpha16us1, //< 1 x unsigned short
  182. tfLuminance4ub1, //< 1 x unsigned byte
  183. tfLuminance8ub1, //< 1 x unsigned byte
  184. tfLuminance16us1, //< 1 x unsigned short
  185. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  186. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  187. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  188. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  189. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  190. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  191. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  192. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  193. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  194. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  195. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  196. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  197. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  198. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  199. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  200. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  201. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  202. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  203. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  204. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  205. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  206. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  207. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  208. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  209. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  210. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  211. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  212. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  213. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  214. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  215. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  216. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  217. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  218. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  219. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  220. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  221. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  222. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  223. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  224. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  225. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  226. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  227. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  228. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  229. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  230. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  231. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  232. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  233. tfDepth16us1, //< 1 x unsigned short (depth)
  234. tfDepth24ui1, //< 1 x unsigned int (depth)
  235. tfDepth32ui1, //< 1 x unsigned int (depth)
  236. tfS3tcDtx1RGBA,
  237. tfS3tcDtx3RGBA,
  238. tfS3tcDtx5RGBA
  239. );
  240. { type to define suitable file formats }
  241. TglBitmapFileType = (
  242. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  243. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  244. ftDDS, //< Direct Draw Surface file (DDS)
  245. ftTGA, //< Targa Image File (TGA)
  246. ftBMP, //< Windows Bitmap File (BMP)
  247. ftRAW); //< glBitmap RAW file format
  248. TglBitmapFileTypes = set of TglBitmapFileType;
  249. { possible mipmap types }
  250. TglBitmapMipMap = (
  251. mmNone, //< no mipmaps
  252. mmMipmap, //< normal mipmaps
  253. mmMipmapGlu); //< mipmaps generated with glu functions
  254. { possible normal map functions }
  255. TglBitmapNormalMapFunc = (
  256. nm4Samples,
  257. nmSobel,
  258. nm3x3,
  259. nm5x5);
  260. ////////////////////////////////////////////////////////////////////////////////////////////////////
  261. EglBitmap = class(Exception); //< glBitmap exception
  262. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  263. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  264. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  265. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  266. public
  267. constructor Create(const aFormat: TglBitmapFormat); overload;
  268. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  269. end;
  270. ////////////////////////////////////////////////////////////////////////////////////////////////////
  271. { record that stores 4 unsigned integer values }
  272. TglBitmapRec4ui = packed record
  273. case Integer of
  274. 0: (r, g, b, a: Cardinal);
  275. 1: (arr: array[0..3] of Cardinal);
  276. end;
  277. { record that stores 4 unsigned byte values }
  278. TglBitmapRec4ub = packed record
  279. case Integer of
  280. 0: (r, g, b, a: Byte);
  281. 1: (arr: array[0..3] of Byte);
  282. end;
  283. { record that stores 4 unsigned long integer values }
  284. TglBitmapRec4ul = packed record
  285. case Integer of
  286. 0: (r, g, b, a: QWord);
  287. 1: (arr: array[0..3] of QWord);
  288. end;
  289. { structure to store pixel data in }
  290. TglBitmapPixelData = packed record
  291. Data: TglBitmapRec4ui; //< color data for each color channel
  292. Range: TglBitmapRec4ui; //< maximal color value for each channel
  293. Format: TglBitmapFormat; //< format of the pixel
  294. end;
  295. PglBitmapPixelData = ^TglBitmapPixelData;
  296. TglBitmapSizeFields = set of (ffX, ffY);
  297. TglBitmapSize = packed record
  298. Fields: TglBitmapSizeFields;
  299. X: Word;
  300. Y: Word;
  301. end;
  302. TglBitmapPixelPosition = TglBitmapSize;
  303. { describes the properties of a given texture data format }
  304. TglBitmapFormatDescriptor = class(TObject)
  305. private
  306. // cached properties
  307. fBytesPerPixel: Single; //< number of bytes for each pixel
  308. fChannelCount: Integer; //< number of color channels
  309. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  310. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  311. { @return @true if the format has a red color channel, @false otherwise }
  312. function GetHasRed: Boolean;
  313. { @return @true if the format has a green color channel, @false otherwise }
  314. function GetHasGreen: Boolean;
  315. { @return @true if the format has a blue color channel, @false otherwise }
  316. function GetHasBlue: Boolean;
  317. { @return @true if the format has a alpha color channel, @false otherwise }
  318. function GetHasAlpha: Boolean;
  319. { @return @true if the format has any color color channel, @false otherwise }
  320. function GetHasColor: Boolean;
  321. { @return @true if the format is a grayscale format, @false otherwise }
  322. function GetIsGrayscale: Boolean;
  323. { @return @true if the format is supported by OpenGL, @false otherwise }
  324. function GetHasOpenGLSupport: Boolean;
  325. protected
  326. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  327. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  328. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  329. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  330. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  331. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  332. fBitsPerPixel: Integer; //< number of bits per pixel
  333. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  334. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  335. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  336. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  337. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  338. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  339. { set values for this format descriptor }
  340. procedure SetValues; virtual;
  341. { calculate cached values }
  342. procedure CalcValues;
  343. public
  344. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  345. property ChannelCount: Integer read fChannelCount; //< number of color channels
  346. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  347. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  348. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  349. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  350. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  351. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  352. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  353. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  354. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  355. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  356. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  357. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  358. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  359. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  360. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  361. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  362. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  363. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  364. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  365. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  366. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  367. property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
  368. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  369. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  370. { constructor }
  371. constructor Create;
  372. public
  373. { get the format descriptor by a given OpenGL internal format
  374. @param aInternalFormat OpenGL internal format to get format descriptor for
  375. @returns suitable format descriptor or tfEmpty-Descriptor }
  376. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  377. end;
  378. ////////////////////////////////////////////////////////////////////////////////////////////////////
  379. TglBitmapData = class;
  380. { structure to store data for converting in }
  381. TglBitmapFunctionRec = record
  382. Sender: TglBitmapData; //< texture object that stores the data to convert
  383. Size: TglBitmapSize; //< size of the texture
  384. Position: TglBitmapPixelPosition; //< position of the currently pixel
  385. Source: TglBitmapPixelData; //< pixel data of the current pixel
  386. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  387. Args: Pointer; //< user defined args that was passed to the convert function
  388. end;
  389. { callback to use for converting texture data }
  390. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  392. { class to store texture data in. used to load, save and
  393. manipulate data before assigned to texture object
  394. all operations on a data object can be done from a background thread }
  395. TglBitmapData = class
  396. private { fields }
  397. fData: PByte; //< texture data
  398. fDimension: TglBitmapSize; //< pixel size of the data
  399. fFormat: TglBitmapFormat; //< format the texture data is stored in
  400. fFilename: String; //< file the data was load from
  401. fScanlines: array of PByte; //< pointer to begin of each line
  402. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  403. private { getter / setter }
  404. { @returns the format descriptor suitable to the texture data format }
  405. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  406. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  407. function GetWidth: Integer;
  408. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  409. function GetHeight: Integer;
  410. { get scanline at index aIndex
  411. @returns Pointer to start of line or @nil }
  412. function GetScanlines(const aIndex: Integer): PByte;
  413. { set new value for the data format. only possible if new format has the same pixel size.
  414. if you want to convert the texture data, see ConvertTo function }
  415. procedure SetFormat(const aValue: TglBitmapFormat);
  416. private { internal misc }
  417. { splits a resource identifier into the resource and it's type
  418. @param aResource resource identifier to split and store name in
  419. @param aResType type of the resource }
  420. procedure PrepareResType(var aResource: String; var aResType: PChar);
  421. { updates scanlines array }
  422. procedure UpdateScanlines;
  423. private { internal load and save }
  424. {$IFDEF GLB_SUPPORT_PNG_READ}
  425. { try to load a PNG from a stream
  426. @param aStream stream to load PNG from
  427. @returns @true on success, @false otherwise }
  428. function LoadPNG(const aStream: TStream): Boolean; virtual;
  429. {$ENDIF}
  430. {$ifdef GLB_SUPPORT_PNG_WRITE}
  431. { save texture data as PNG to stream
  432. @param aStream stream to save data to}
  433. procedure SavePNG(const aStream: TStream); virtual;
  434. {$ENDIF}
  435. {$IFDEF GLB_SUPPORT_JPEG_READ}
  436. { try to load a JPEG from a stream
  437. @param aStream stream to load JPEG from
  438. @returns @true on success, @false otherwise }
  439. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  440. {$ENDIF}
  441. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  442. { save texture data as JPEG to stream
  443. @param aStream stream to save data to}
  444. procedure SaveJPEG(const aStream: TStream); virtual;
  445. {$ENDIF}
  446. { try to load a RAW image from a stream
  447. @param aStream stream to load RAW image from
  448. @returns @true on success, @false otherwise }
  449. function LoadRAW(const aStream: TStream): Boolean;
  450. { save texture data as RAW image to stream
  451. @param aStream stream to save data to}
  452. procedure SaveRAW(const aStream: TStream);
  453. { try to load a BMP from a stream
  454. @param aStream stream to load BMP from
  455. @returns @true on success, @false otherwise }
  456. function LoadBMP(const aStream: TStream): Boolean;
  457. { save texture data as BMP to stream
  458. @param aStream stream to save data to}
  459. procedure SaveBMP(const aStream: TStream);
  460. { try to load a TGA from a stream
  461. @param aStream stream to load TGA from
  462. @returns @true on success, @false otherwise }
  463. function LoadTGA(const aStream: TStream): Boolean;
  464. { save texture data as TGA to stream
  465. @param aStream stream to save data to}
  466. procedure SaveTGA(const aStream: TStream);
  467. { try to load a DDS from a stream
  468. @param aStream stream to load DDS from
  469. @returns @true on success, @false otherwise }
  470. function LoadDDS(const aStream: TStream): Boolean;
  471. { save texture data as DDS to stream
  472. @param aStream stream to save data to}
  473. procedure SaveDDS(const aStream: TStream);
  474. public { properties }
  475. property Data: PByte read fData; //< texture data (be carefull with this!)
  476. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  477. property Filename: String read fFilename; //< file the data was loaded from
  478. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  479. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  480. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  481. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  482. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  483. public { flip }
  484. { flip texture horizontal
  485. @returns @true in success, @false otherwise }
  486. function FlipHorz: Boolean; virtual;
  487. { flip texture vertical
  488. @returns @true in success, @false otherwise }
  489. function FlipVert: Boolean; virtual;
  490. public { load }
  491. { load a texture from a file
  492. @param aFilename file to load texuture from }
  493. procedure LoadFromFile(const aFilename: String);
  494. { load a texture from a stream
  495. @param aStream stream to load texture from }
  496. procedure LoadFromStream(const aStream: TStream); virtual;
  497. { use a function to generate texture data
  498. @param aSize size of the texture
  499. @param aFormat format of the texture data
  500. @param aFunc callback to use for generation
  501. @param aArgs user defined paramaters (use at will) }
  502. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  503. { load a texture from a resource
  504. @param aInstance resource handle
  505. @param aResource resource indentifier
  506. @param aResType resource type (if known) }
  507. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  508. { load a texture from a resource id
  509. @param aInstance resource handle
  510. @param aResource resource ID
  511. @param aResType resource type }
  512. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  513. public { save }
  514. { save texture data to a file
  515. @param aFilename filename to store texture in
  516. @param aFileType file type to store data into }
  517. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  518. { save texture data to a stream
  519. @param aFilename filename to store texture in
  520. @param aFileType file type to store data into }
  521. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  522. public { convert }
  523. { convert texture data using a user defined callback
  524. @param aFunc callback to use for converting
  525. @param aCreateTemp create a temporary buffer to use for converting
  526. @param aArgs user defined paramters (use at will)
  527. @returns @true if converting was successful, @false otherwise }
  528. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  529. { convert texture data using a user defined callback
  530. @param aSource glBitmap to read data from
  531. @param aFunc callback to use for converting
  532. @param aCreateTemp create a temporary buffer to use for converting
  533. @param aFormat format of the new data
  534. @param aArgs user defined paramters (use at will)
  535. @returns @true if converting was successful, @false otherwise }
  536. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  537. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  538. { convert texture data using a specific format
  539. @param aFormat new format of texture data
  540. @returns @true if converting was successful, @false otherwise }
  541. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  542. {$IFDEF GLB_SDL}
  543. public { SDL }
  544. { assign texture data to SDL surface
  545. @param aSurface SDL surface to write data to
  546. @returns @true on success, @false otherwise }
  547. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  548. { assign texture data from SDL surface
  549. @param aSurface SDL surface to read data from
  550. @returns @true on success, @false otherwise }
  551. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  552. { assign alpha channel data to SDL surface
  553. @param aSurface SDL surface to write alpha channel data to
  554. @returns @true on success, @false otherwise }
  555. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  556. { assign alpha channel data from SDL surface
  557. @param aSurface SDL surface to read data from
  558. @param aFunc callback to use for converting
  559. @param aArgs user defined parameters (use at will)
  560. @returns @true on success, @false otherwise }
  561. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  562. {$ENDIF}
  563. {$IFDEF GLB_DELPHI}
  564. public { Delphi }
  565. { assign texture data to TBitmap object
  566. @param aBitmap TBitmap to write data to
  567. @returns @true on success, @false otherwise }
  568. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  569. { assign texture data from TBitmap object
  570. @param aBitmap TBitmap to read data from
  571. @returns @true on success, @false otherwise }
  572. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  573. { assign alpha channel data to TBitmap object
  574. @param aBitmap TBitmap to write data to
  575. @returns @true on success, @false otherwise }
  576. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  577. { assign alpha channel data from TBitmap object
  578. @param aBitmap TBitmap to read data from
  579. @param aFunc callback to use for converting
  580. @param aArgs user defined parameters (use at will)
  581. @returns @true on success, @false otherwise }
  582. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  583. {$ENDIF}
  584. {$IFDEF GLB_LAZARUS}
  585. public { Lazarus }
  586. { assign texture data to TLazIntfImage object
  587. @param aImage TLazIntfImage to write data to
  588. @returns @true on success, @false otherwise }
  589. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  590. { assign texture data from TLazIntfImage object
  591. @param aImage TLazIntfImage to read data from
  592. @returns @true on success, @false otherwise }
  593. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  594. { assign alpha channel data to TLazIntfImage object
  595. @param aImage TLazIntfImage to write data to
  596. @returns @true on success, @false otherwise }
  597. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  598. { assign alpha channel data from TLazIntfImage object
  599. @param aImage TLazIntfImage to read data from
  600. @param aFunc callback to use for converting
  601. @param aArgs user defined parameters (use at will)
  602. @returns @true on success, @false otherwise }
  603. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  604. {$ENDIF}
  605. public { Alpha }
  606. { load alpha channel data from resource
  607. @param aInstance resource handle
  608. @param aResource resource ID
  609. @param aResType resource type
  610. @param aFunc callback to use for converting
  611. @param aArgs user defined parameters (use at will)
  612. @returns @true on success, @false otherwise }
  613. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  614. { load alpha channel data from resource ID
  615. @param aInstance resource handle
  616. @param aResourceID resource ID
  617. @param aResType resource type
  618. @param aFunc callback to use for converting
  619. @param aArgs user defined parameters (use at will)
  620. @returns @true on success, @false otherwise }
  621. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  622. { add alpha channel data from function
  623. @param aFunc callback to get data from
  624. @param aArgs user defined parameters (use at will)
  625. @returns @true on success, @false otherwise }
  626. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  627. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  628. @param aFilename file to load alpha channel data from
  629. @param aFunc callback to use for converting
  630. @param aArgs SetFormat user defined parameters (use at will)
  631. @returns @true on success, @false otherwise }
  632. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  633. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  634. @param aStream stream to load alpha channel data from
  635. @param aFunc callback to use for converting
  636. @param aArgs user defined parameters (use at will)
  637. @returns @true on success, @false otherwise }
  638. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  639. { add alpha channel data from existing glBitmap object
  640. @param aBitmap TglBitmap to copy alpha channel data from
  641. @param aFunc callback to use for converting
  642. @param aArgs user defined parameters (use at will)
  643. @returns @true on success, @false otherwise }
  644. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  645. { add alpha to pixel if the pixels color is greter than the given color value
  646. @param aRed red threshold (0-255)
  647. @param aGreen green threshold (0-255)
  648. @param aBlue blue threshold (0-255)
  649. @param aDeviatation accepted deviatation (0-255)
  650. @returns @true on success, @false otherwise }
  651. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  652. { add alpha to pixel if the pixels color is greter than the given color value
  653. @param aRed red threshold (0-Range.r)
  654. @param aGreen green threshold (0-Range.g)
  655. @param aBlue blue threshold (0-Range.b)
  656. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  657. @returns @true on success, @false otherwise }
  658. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  659. { add alpha to pixel if the pixels color is greter than the given color value
  660. @param aRed red threshold (0.0-1.0)
  661. @param aGreen green threshold (0.0-1.0)
  662. @param aBlue blue threshold (0.0-1.0)
  663. @param aDeviatation accepted deviatation (0.0-1.0)
  664. @returns @true on success, @false otherwise }
  665. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  666. { add a constand alpha value to all pixels
  667. @param aAlpha alpha value to add (0-255)
  668. @returns @true on success, @false otherwise }
  669. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  670. { add a constand alpha value to all pixels
  671. @param aAlpha alpha value to add (0-max(Range.rgb))
  672. @returns @true on success, @false otherwise }
  673. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  674. { add a constand alpha value to all pixels
  675. @param aAlpha alpha value to add (0.0-1.0)
  676. @returns @true on success, @false otherwise }
  677. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  678. { remove alpha channel
  679. @returns @true on success, @false otherwise }
  680. function RemoveAlpha: Boolean; virtual;
  681. public { fill }
  682. { fill complete texture with one color
  683. @param aRed red color for border (0-255)
  684. @param aGreen green color for border (0-255)
  685. @param aBlue blue color for border (0-255)
  686. @param aAlpha alpha color for border (0-255) }
  687. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  688. { fill complete texture with one color
  689. @param aRed red color for border (0-Range.r)
  690. @param aGreen green color for border (0-Range.g)
  691. @param aBlue blue color for border (0-Range.b)
  692. @param aAlpha alpha color for border (0-Range.a) }
  693. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  694. { fill complete texture with one color
  695. @param aRed red color for border (0.0-1.0)
  696. @param aGreen green color for border (0.0-1.0)
  697. @param aBlue blue color for border (0.0-1.0)
  698. @param aAlpha alpha color for border (0.0-1.0) }
  699. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  700. public { Misc }
  701. { set data pointer of texture data
  702. @param aData pointer to new texture data
  703. @param aFormat format of the data stored at aData
  704. @param aWidth width of the texture data
  705. @param aHeight height of the texture data }
  706. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  707. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  708. { create a clone of the current object
  709. @returns clone of this object}
  710. function Clone: TglBitmapData;
  711. { invert color data (bitwise not)
  712. @param aRed invert red channel
  713. @param aGreen invert green channel
  714. @param aBlue invert blue channel
  715. @param aAlpha invert alpha channel }
  716. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  717. { create normal map from texture data
  718. @param aFunc normal map function to generate normalmap with
  719. @param aScale scale of the normale stored in the normal map
  720. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  721. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  722. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  723. public { constructor }
  724. { constructor - creates a texutre data object }
  725. constructor Create; overload;
  726. { constructor - creates a texture data object and loads it from a file
  727. @param aFilename file to load texture from }
  728. constructor Create(const aFileName: String); overload;
  729. { constructor - creates a texture data object and loads it from a stream
  730. @param aStream stream to load texture from }
  731. constructor Create(const aStream: TStream); overload;
  732. { constructor - creates a texture data object with the given size, format and data
  733. @param aSize size of the texture
  734. @param aFormat format of the given data
  735. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  736. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  737. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  738. @param aSize size of the texture
  739. @param aFormat format of the given data
  740. @param aFunc callback to use for generating the data
  741. @param aArgs user defined parameters (use at will) }
  742. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  743. { constructor - creates a texture data object and loads it from a resource
  744. @param aInstance resource handle
  745. @param aResource resource indentifier
  746. @param aResType resource type (if known) }
  747. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  748. { constructor - creates a texture data object and loads it from a resource
  749. @param aInstance resource handle
  750. @param aResourceID resource ID
  751. @param aResType resource type (if known) }
  752. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  753. { destructor }
  754. destructor Destroy; override;
  755. end;
  756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  757. { base class for all glBitmap classes. used to manage OpenGL texture objects
  758. all operations on a bitmap object must be done from the render thread }
  759. TglBitmap = class
  760. protected
  761. fID: GLuint; //< name of the OpenGL texture object
  762. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  763. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  764. // texture properties
  765. fFilterMin: GLenum; //< min filter to apply to the texture
  766. fFilterMag: GLenum; //< mag filter to apply to the texture
  767. fWrapS: GLenum; //< texture wrapping for x axis
  768. fWrapT: GLenum; //< texture wrapping for y axis
  769. fWrapR: GLenum; //< texture wrapping for z axis
  770. fAnisotropic: Integer; //< anisotropic level
  771. fBorderColor: array[0..3] of Single; //< color of the texture border
  772. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  773. //Swizzle
  774. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  775. {$IFEND}
  776. {$IFNDEF OPENGL_ES}
  777. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  778. {$ENDIF}
  779. fDimension: TglBitmapSize; //< size of this texture
  780. fMipMap: TglBitmapMipMap; //< mipmap type
  781. // CustomData
  782. fCustomData: Pointer; //< user defined data
  783. fCustomName: String; //< user defined name
  784. fCustomNameW: WideString; //< user defined name
  785. protected
  786. { @returns the actual width of the texture }
  787. function GetWidth: Integer; virtual;
  788. { @returns the actual height of the texture }
  789. function GetHeight: Integer; virtual;
  790. protected
  791. { set a new value for fCustomData }
  792. procedure SetCustomData(const aValue: Pointer);
  793. { set a new value for fCustomName }
  794. procedure SetCustomName(const aValue: String);
  795. { set a new value for fCustomNameW }
  796. procedure SetCustomNameW(const aValue: WideString);
  797. { set new value for fDeleteTextureOnFree }
  798. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  799. { set name of OpenGL texture object }
  800. procedure SetID(const aValue: Cardinal);
  801. { set new value for fMipMap }
  802. procedure SetMipMap(const aValue: TglBitmapMipMap);
  803. { set new value for target }
  804. procedure SetTarget(const aValue: Cardinal);
  805. { set new value for fAnisotrophic }
  806. procedure SetAnisotropic(const aValue: Integer);
  807. protected
  808. { create OpenGL texture object (delete exisiting object if exists) }
  809. procedure CreateID;
  810. { setup texture parameters }
  811. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  812. protected
  813. property Width: Integer read GetWidth; //< the actual width of the texture
  814. property Height: Integer read GetHeight; //< the actual height of the texture
  815. public
  816. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  817. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  818. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  819. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  820. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  821. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  822. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  823. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  824. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  825. {$IFNDEF OPENGL_ES}
  826. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  827. {$ENDIF}
  828. { this method is called after the constructor and sets the default values of this object }
  829. procedure AfterConstruction; override;
  830. { this method is called before the destructor and does some cleanup }
  831. procedure BeforeDestruction; override;
  832. public
  833. {$IFNDEF OPENGL_ES}
  834. { set the new value for texture border color
  835. @param aRed red color for border (0.0-1.0)
  836. @param aGreen green color for border (0.0-1.0)
  837. @param aBlue blue color for border (0.0-1.0)
  838. @param aAlpha alpha color for border (0.0-1.0) }
  839. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  840. {$ENDIF}
  841. public
  842. { set new texture filer
  843. @param aMin min filter
  844. @param aMag mag filter }
  845. procedure SetFilter(const aMin, aMag: GLenum);
  846. { set new texture wrapping
  847. @param S texture wrapping for x axis
  848. @param T texture wrapping for y axis
  849. @param R texture wrapping for z axis }
  850. procedure SetWrap(
  851. const S: GLenum = GL_CLAMP_TO_EDGE;
  852. const T: GLenum = GL_CLAMP_TO_EDGE;
  853. const R: GLenum = GL_CLAMP_TO_EDGE);
  854. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  855. { set new swizzle
  856. @param r swizzle for red channel
  857. @param g swizzle for green channel
  858. @param b swizzle for blue channel
  859. @param a swizzle for alpha channel }
  860. procedure SetSwizzle(const r, g, b, a: GLenum);
  861. {$IFEND}
  862. public
  863. { bind texture
  864. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  865. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  866. { bind texture
  867. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  868. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  869. { upload texture data from given data object to video card
  870. @param aData texture data object that contains the actual data
  871. @param aCheckSize check size before upload and throw exception if something is wrong }
  872. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  873. {$IFNDEF OPENGL_ES}
  874. { download texture data from video card and store it into given data object
  875. @returns @true when download was successfull, @false otherwise }
  876. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  877. {$ENDIF}
  878. public
  879. { constructor - creates an empty texture }
  880. constructor Create; overload;
  881. { constructor - creates an texture object and uploads the given data }
  882. constructor Create(const aData: TglBitmapData); overload;
  883. end;
  884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  885. {$IF NOT DEFINED(OPENGL_ES)}
  886. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  887. all operations on a bitmap object must be done from the render thread }
  888. TglBitmap1D = class(TglBitmap)
  889. protected
  890. { upload the texture data to video card
  891. @param aDataObj texture data object that contains the actual data
  892. @param aBuildWithGlu use glu functions to build mipmaps }
  893. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  894. public
  895. property Width; //< actual with of the texture
  896. { this method is called after constructor and initializes the object }
  897. procedure AfterConstruction; override;
  898. { upload texture data from given data object to video card
  899. @param aData texture data object that contains the actual data
  900. @param aCheckSize check size before upload and throw exception if something is wrong }
  901. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  902. end;
  903. {$IFEND}
  904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  905. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  906. all operations on a bitmap object must be done from the render thread }
  907. TglBitmap2D = class(TglBitmap)
  908. protected
  909. { upload the texture data to video card
  910. @param aDataObj texture data object that contains the actual data
  911. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  912. @param aBuildWithGlu use glu functions to build mipmaps }
  913. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  914. {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  915. public
  916. property Width; //< actual width of the texture
  917. property Height; //< actual height of the texture
  918. { this method is called after constructor and initializes the object }
  919. procedure AfterConstruction; override;
  920. { upload texture data from given data object to video card
  921. @param aData texture data object that contains the actual data
  922. @param aCheckSize check size before upload and throw exception if something is wrong }
  923. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  924. public
  925. { copy a part of the frame buffer to the texture
  926. @param aTop topmost pixel to copy
  927. @param aLeft leftmost pixel to copy
  928. @param aRight rightmost pixel to copy
  929. @param aBottom bottommost pixel to copy
  930. @param aFormat format to store data in
  931. @param aDataObj texture data object to store the data in }
  932. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  933. end;
  934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  935. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  936. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  937. all operations on a bitmap object must be done from the render thread }
  938. TglBitmapCubeMap = class(TglBitmap2D)
  939. protected
  940. {$IFNDEF OPENGL_ES}
  941. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  942. {$ENDIF}
  943. public
  944. { this method is called after constructor and initializes the object }
  945. procedure AfterConstruction; override;
  946. { upload texture data from given data object to video card
  947. @param aData texture data object that contains the actual data
  948. @param aCheckSize check size before upload and throw exception if something is wrong }
  949. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  950. { upload texture data from given data object to video card
  951. @param aData texture data object that contains the actual data
  952. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  953. @param aCheckSize check size before upload and throw exception if something is wrong }
  954. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  955. { bind texture
  956. @param aEnableTexCoordsGen enable cube map generator
  957. @param aEnableTextureUnit enable texture unit }
  958. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  959. { unbind texture
  960. @param aDisableTexCoordsGen disable cube map generator
  961. @param aDisableTextureUnit disable texture unit }
  962. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  963. end;
  964. {$IFEND}
  965. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  967. { wrapper class for cube normal maps
  968. all operations on a bitmap object must be done from the render thread }
  969. TglBitmapNormalMap = class(TglBitmapCubeMap)
  970. public
  971. { this method is called after constructor and initializes the object }
  972. procedure AfterConstruction; override;
  973. { create cube normal map from texture data and upload it to video card
  974. @param aSize size of each cube map texture
  975. @param aCheckSize check size before upload and throw exception if something is wrong }
  976. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  977. end;
  978. {$IFEND}
  979. const
  980. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  981. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  982. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  983. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  984. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  985. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  986. procedure glBitmapSetDefaultWrap(
  987. const S: Cardinal = GL_CLAMP_TO_EDGE;
  988. const T: Cardinal = GL_CLAMP_TO_EDGE;
  989. const R: Cardinal = GL_CLAMP_TO_EDGE);
  990. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  991. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  992. {$IFEND}
  993. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  994. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  995. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  996. function glBitmapGetDefaultFormat: TglBitmapFormat;
  997. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  998. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  999. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1000. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1001. {$IFEND}
  1002. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1003. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1004. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1005. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1006. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1007. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1008. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1009. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1010. {$IFDEF GLB_DELPHI}
  1011. function CreateGrayPalette: HPALETTE;
  1012. {$ENDIF}
  1013. implementation
  1014. uses
  1015. Math, syncobjs, typinfo
  1016. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1017. var
  1018. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1019. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1020. glBitmapDefaultFormat: TglBitmapFormat;
  1021. glBitmapDefaultMipmap: TglBitmapMipMap;
  1022. glBitmapDefaultFilterMin: Cardinal;
  1023. glBitmapDefaultFilterMag: Cardinal;
  1024. glBitmapDefaultWrapS: Cardinal;
  1025. glBitmapDefaultWrapT: Cardinal;
  1026. glBitmapDefaultWrapR: Cardinal;
  1027. glDefaultSwizzle: array[0..3] of GLenum;
  1028. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1029. type
  1030. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1031. public
  1032. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1033. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1034. function CreateMappingData: Pointer; virtual;
  1035. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1036. function IsEmpty: Boolean; virtual;
  1037. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1038. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1039. constructor Create; virtual;
  1040. public
  1041. class procedure Init;
  1042. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1043. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1044. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1045. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1046. class procedure Clear;
  1047. class procedure Finalize;
  1048. end;
  1049. TFormatDescriptorClass = class of TFormatDescriptor;
  1050. TfdEmpty = class(TFormatDescriptor);
  1051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1052. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1053. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1054. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1055. end;
  1056. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1057. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1058. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1059. end;
  1060. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1061. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1062. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1063. end;
  1064. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1065. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1066. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1067. end;
  1068. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1069. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1070. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1071. end;
  1072. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1073. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1074. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1075. end;
  1076. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1077. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1078. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1079. end;
  1080. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1081. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1082. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1083. end;
  1084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1085. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1086. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1087. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1088. end;
  1089. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1092. end;
  1093. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1094. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1095. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1096. end;
  1097. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1098. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1099. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1100. end;
  1101. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1102. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1103. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1104. end;
  1105. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1106. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1107. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1108. end;
  1109. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1110. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1111. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1112. end;
  1113. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1114. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1115. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1116. end;
  1117. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1118. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1119. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1120. end;
  1121. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1122. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1123. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1124. end;
  1125. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1126. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1127. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1128. end;
  1129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1130. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. end;
  1134. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1135. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1136. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1137. end;
  1138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1139. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1140. procedure SetValues; override;
  1141. end;
  1142. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1143. procedure SetValues; override;
  1144. end;
  1145. TfdAlpha16us1 = class(TfdAlphaUS1)
  1146. procedure SetValues; override;
  1147. end;
  1148. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1149. procedure SetValues; override;
  1150. end;
  1151. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1152. procedure SetValues; override;
  1153. end;
  1154. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1155. procedure SetValues; override;
  1156. end;
  1157. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1158. procedure SetValues; override;
  1159. end;
  1160. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1161. procedure SetValues; override;
  1162. end;
  1163. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1164. procedure SetValues; override;
  1165. end;
  1166. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1167. procedure SetValues; override;
  1168. end;
  1169. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1170. procedure SetValues; override;
  1171. end;
  1172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1173. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1174. procedure SetValues; override;
  1175. end;
  1176. TfdRGBX4us1 = class(TfdUniversalUS1)
  1177. procedure SetValues; override;
  1178. end;
  1179. TfdXRGB4us1 = class(TfdUniversalUS1)
  1180. procedure SetValues; override;
  1181. end;
  1182. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1183. procedure SetValues; override;
  1184. end;
  1185. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1186. procedure SetValues; override;
  1187. end;
  1188. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1189. procedure SetValues; override;
  1190. end;
  1191. TfdRGB8ub3 = class(TfdRGBub3)
  1192. procedure SetValues; override;
  1193. end;
  1194. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1195. procedure SetValues; override;
  1196. end;
  1197. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1198. procedure SetValues; override;
  1199. end;
  1200. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1201. procedure SetValues; override;
  1202. end;
  1203. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1204. procedure SetValues; override;
  1205. end;
  1206. TfdRGB16us3 = class(TfdRGBus3)
  1207. procedure SetValues; override;
  1208. end;
  1209. TfdRGBA4us1 = class(TfdUniversalUS1)
  1210. procedure SetValues; override;
  1211. end;
  1212. TfdARGB4us1 = class(TfdUniversalUS1)
  1213. procedure SetValues; override;
  1214. end;
  1215. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1216. procedure SetValues; override;
  1217. end;
  1218. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1219. procedure SetValues; override;
  1220. end;
  1221. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1222. procedure SetValues; override;
  1223. end;
  1224. TfdARGB8ui1 = class(TfdUniversalUI1)
  1225. procedure SetValues; override;
  1226. end;
  1227. TfdRGBA8ub4 = class(TfdRGBAub4)
  1228. procedure SetValues; override;
  1229. end;
  1230. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1231. procedure SetValues; override;
  1232. end;
  1233. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1234. procedure SetValues; override;
  1235. end;
  1236. TfdRGBA16us4 = class(TfdRGBAus4)
  1237. procedure SetValues; override;
  1238. end;
  1239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1240. TfdBGRX4us1 = class(TfdUniversalUS1)
  1241. procedure SetValues; override;
  1242. end;
  1243. TfdXBGR4us1 = class(TfdUniversalUS1)
  1244. procedure SetValues; override;
  1245. end;
  1246. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1247. procedure SetValues; override;
  1248. end;
  1249. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1250. procedure SetValues; override;
  1251. end;
  1252. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1253. procedure SetValues; override;
  1254. end;
  1255. TfdBGR8ub3 = class(TfdBGRub3)
  1256. procedure SetValues; override;
  1257. end;
  1258. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1259. procedure SetValues; override;
  1260. end;
  1261. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1262. procedure SetValues; override;
  1263. end;
  1264. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1265. procedure SetValues; override;
  1266. end;
  1267. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1268. procedure SetValues; override;
  1269. end;
  1270. TfdBGR16us3 = class(TfdBGRus3)
  1271. procedure SetValues; override;
  1272. end;
  1273. TfdBGRA4us1 = class(TfdUniversalUS1)
  1274. procedure SetValues; override;
  1275. end;
  1276. TfdABGR4us1 = class(TfdUniversalUS1)
  1277. procedure SetValues; override;
  1278. end;
  1279. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1280. procedure SetValues; override;
  1281. end;
  1282. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1283. procedure SetValues; override;
  1284. end;
  1285. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1286. procedure SetValues; override;
  1287. end;
  1288. TfdABGR8ui1 = class(TfdUniversalUI1)
  1289. procedure SetValues; override;
  1290. end;
  1291. TfdBGRA8ub4 = class(TfdBGRAub4)
  1292. procedure SetValues; override;
  1293. end;
  1294. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1295. procedure SetValues; override;
  1296. end;
  1297. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1298. procedure SetValues; override;
  1299. end;
  1300. TfdBGRA16us4 = class(TfdBGRAus4)
  1301. procedure SetValues; override;
  1302. end;
  1303. TfdDepth16us1 = class(TfdDepthUS1)
  1304. procedure SetValues; override;
  1305. end;
  1306. TfdDepth24ui1 = class(TfdDepthUI1)
  1307. procedure SetValues; override;
  1308. end;
  1309. TfdDepth32ui1 = class(TfdDepthUI1)
  1310. procedure SetValues; override;
  1311. end;
  1312. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1313. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1314. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1315. procedure SetValues; override;
  1316. end;
  1317. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1318. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1319. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1320. procedure SetValues; override;
  1321. end;
  1322. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1323. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1324. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1325. procedure SetValues; override;
  1326. end;
  1327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1328. TbmpBitfieldFormat = class(TFormatDescriptor)
  1329. public
  1330. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1331. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1332. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1333. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1334. end;
  1335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1336. TbmpColorTableEnty = packed record
  1337. b, g, r, a: Byte;
  1338. end;
  1339. TbmpColorTable = array of TbmpColorTableEnty;
  1340. TbmpColorTableFormat = class(TFormatDescriptor)
  1341. private
  1342. fColorTable: TbmpColorTable;
  1343. protected
  1344. procedure SetValues; override;
  1345. public
  1346. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1347. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1348. procedure CalcValues;
  1349. procedure CreateColorTable;
  1350. function CreateMappingData: Pointer; override;
  1351. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1352. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1353. destructor Destroy; override;
  1354. end;
  1355. const
  1356. LUMINANCE_WEIGHT_R = 0.30;
  1357. LUMINANCE_WEIGHT_G = 0.59;
  1358. LUMINANCE_WEIGHT_B = 0.11;
  1359. ALPHA_WEIGHT_R = 0.30;
  1360. ALPHA_WEIGHT_G = 0.59;
  1361. ALPHA_WEIGHT_B = 0.11;
  1362. DEPTH_WEIGHT_R = 0.333333333;
  1363. DEPTH_WEIGHT_G = 0.333333333;
  1364. DEPTH_WEIGHT_B = 0.333333333;
  1365. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1366. TfdEmpty,
  1367. TfdAlpha4ub1,
  1368. TfdAlpha8ub1,
  1369. TfdAlpha16us1,
  1370. TfdLuminance4ub1,
  1371. TfdLuminance8ub1,
  1372. TfdLuminance16us1,
  1373. TfdLuminance4Alpha4ub2,
  1374. TfdLuminance6Alpha2ub2,
  1375. TfdLuminance8Alpha8ub2,
  1376. TfdLuminance12Alpha4us2,
  1377. TfdLuminance16Alpha16us2,
  1378. TfdR3G3B2ub1,
  1379. TfdRGBX4us1,
  1380. TfdXRGB4us1,
  1381. TfdR5G6B5us1,
  1382. TfdRGB5X1us1,
  1383. TfdX1RGB5us1,
  1384. TfdRGB8ub3,
  1385. TfdRGBX8ui1,
  1386. TfdXRGB8ui1,
  1387. TfdRGB10X2ui1,
  1388. TfdX2RGB10ui1,
  1389. TfdRGB16us3,
  1390. TfdRGBA4us1,
  1391. TfdARGB4us1,
  1392. TfdRGB5A1us1,
  1393. TfdA1RGB5us1,
  1394. TfdRGBA8ui1,
  1395. TfdARGB8ui1,
  1396. TfdRGBA8ub4,
  1397. TfdRGB10A2ui1,
  1398. TfdA2RGB10ui1,
  1399. TfdRGBA16us4,
  1400. TfdBGRX4us1,
  1401. TfdXBGR4us1,
  1402. TfdB5G6R5us1,
  1403. TfdBGR5X1us1,
  1404. TfdX1BGR5us1,
  1405. TfdBGR8ub3,
  1406. TfdBGRX8ui1,
  1407. TfdXBGR8ui1,
  1408. TfdBGR10X2ui1,
  1409. TfdX2BGR10ui1,
  1410. TfdBGR16us3,
  1411. TfdBGRA4us1,
  1412. TfdABGR4us1,
  1413. TfdBGR5A1us1,
  1414. TfdA1BGR5us1,
  1415. TfdBGRA8ui1,
  1416. TfdABGR8ui1,
  1417. TfdBGRA8ub4,
  1418. TfdBGR10A2ui1,
  1419. TfdA2BGR10ui1,
  1420. TfdBGRA16us4,
  1421. TfdDepth16us1,
  1422. TfdDepth24ui1,
  1423. TfdDepth32ui1,
  1424. TfdS3tcDtx1RGBA,
  1425. TfdS3tcDtx3RGBA,
  1426. TfdS3tcDtx5RGBA
  1427. );
  1428. var
  1429. FormatDescriptorCS: TCriticalSection;
  1430. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1432. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1433. begin
  1434. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1435. end;
  1436. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1437. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1438. begin
  1439. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1440. end;
  1441. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1442. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1443. begin
  1444. result.Fields := [];
  1445. if (X >= 0) then
  1446. result.Fields := result.Fields + [ffX];
  1447. if (Y >= 0) then
  1448. result.Fields := result.Fields + [ffY];
  1449. result.X := Max(0, X);
  1450. result.Y := Max(0, Y);
  1451. end;
  1452. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1453. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1454. begin
  1455. result := glBitmapSize(X, Y);
  1456. end;
  1457. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1458. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1459. begin
  1460. result.r := r;
  1461. result.g := g;
  1462. result.b := b;
  1463. result.a := a;
  1464. end;
  1465. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1466. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1467. begin
  1468. result.r := r;
  1469. result.g := g;
  1470. result.b := b;
  1471. result.a := a;
  1472. end;
  1473. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1474. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1475. begin
  1476. result.r := r;
  1477. result.g := g;
  1478. result.b := b;
  1479. result.a := a;
  1480. end;
  1481. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1482. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1483. var
  1484. i: Integer;
  1485. begin
  1486. result := false;
  1487. for i := 0 to high(r1.arr) do
  1488. if (r1.arr[i] <> r2.arr[i]) then
  1489. exit;
  1490. result := true;
  1491. end;
  1492. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1493. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1494. var
  1495. i: Integer;
  1496. begin
  1497. result := false;
  1498. for i := 0 to high(r1.arr) do
  1499. if (r1.arr[i] <> r2.arr[i]) then
  1500. exit;
  1501. result := true;
  1502. end;
  1503. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1504. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1505. var
  1506. desc: TFormatDescriptor;
  1507. p, tmp: PByte;
  1508. x, y, i: Integer;
  1509. md: Pointer;
  1510. px: TglBitmapPixelData;
  1511. begin
  1512. result := nil;
  1513. desc := TFormatDescriptor.Get(aFormat);
  1514. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1515. exit;
  1516. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1517. md := desc.CreateMappingData;
  1518. try
  1519. tmp := p;
  1520. desc.PreparePixel(px);
  1521. for y := 0 to 4 do
  1522. for x := 0 to 4 do begin
  1523. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1524. for i := 0 to 3 do begin
  1525. if ((y < 3) and (y = i)) or
  1526. ((y = 3) and (i < 3)) or
  1527. ((y = 4) and (i = 3))
  1528. then
  1529. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1530. else if ((y < 4) and (i = 3)) or
  1531. ((y = 4) and (i < 3))
  1532. then
  1533. px.Data.arr[i] := px.Range.arr[i]
  1534. else
  1535. px.Data.arr[i] := 0; //px.Range.arr[i];
  1536. end;
  1537. desc.Map(px, tmp, md);
  1538. end;
  1539. finally
  1540. desc.FreeMappingData(md);
  1541. end;
  1542. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1543. end;
  1544. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1545. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1546. begin
  1547. result.r := r;
  1548. result.g := g;
  1549. result.b := b;
  1550. result.a := a;
  1551. end;
  1552. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1553. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1554. begin
  1555. result := [];
  1556. if (aFormat in [
  1557. //8bpp
  1558. tfAlpha4ub1, tfAlpha8ub1,
  1559. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1560. //16bpp
  1561. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1562. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1563. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1564. //24bpp
  1565. tfBGR8ub3, tfRGB8ub3,
  1566. //32bpp
  1567. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1568. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1569. then
  1570. result := result + [ ftBMP ];
  1571. if (aFormat in [
  1572. //8bbp
  1573. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1574. //16bbp
  1575. tfAlpha16us1, tfLuminance16us1,
  1576. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1577. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1578. //24bbp
  1579. tfBGR8ub3,
  1580. //32bbp
  1581. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1582. tfDepth24ui1, tfDepth32ui1])
  1583. then
  1584. result := result + [ftTGA];
  1585. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1586. result := result + [ftDDS];
  1587. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1588. if aFormat in [
  1589. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1590. tfRGB8ub3, tfRGBA8ui1,
  1591. tfBGR8ub3, tfBGRA8ui1] then
  1592. result := result + [ftPNG];
  1593. {$ENDIF}
  1594. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1595. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1596. result := result + [ftJPEG];
  1597. {$ENDIF}
  1598. end;
  1599. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1600. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1601. begin
  1602. while (aNumber and 1) = 0 do
  1603. aNumber := aNumber shr 1;
  1604. result := aNumber = 1;
  1605. end;
  1606. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1607. function GetTopMostBit(aBitSet: QWord): Integer;
  1608. begin
  1609. result := 0;
  1610. while aBitSet > 0 do begin
  1611. inc(result);
  1612. aBitSet := aBitSet shr 1;
  1613. end;
  1614. end;
  1615. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1616. function CountSetBits(aBitSet: QWord): Integer;
  1617. begin
  1618. result := 0;
  1619. while aBitSet > 0 do begin
  1620. if (aBitSet and 1) = 1 then
  1621. inc(result);
  1622. aBitSet := aBitSet shr 1;
  1623. end;
  1624. end;
  1625. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1626. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1627. begin
  1628. result := Trunc(
  1629. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1630. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1631. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1632. end;
  1633. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1634. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1635. begin
  1636. result := Trunc(
  1637. DEPTH_WEIGHT_R * aPixel.Data.r +
  1638. DEPTH_WEIGHT_G * aPixel.Data.g +
  1639. DEPTH_WEIGHT_B * aPixel.Data.b);
  1640. end;
  1641. {$IFDEF GLB_SDL_IMAGE}
  1642. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1643. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1644. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1646. begin
  1647. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1648. end;
  1649. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1650. begin
  1651. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1652. end;
  1653. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1654. begin
  1655. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1656. end;
  1657. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1658. begin
  1659. result := 0;
  1660. end;
  1661. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1662. begin
  1663. result := SDL_AllocRW;
  1664. if result = nil then
  1665. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1666. result^.seek := glBitmapRWseek;
  1667. result^.read := glBitmapRWread;
  1668. result^.write := glBitmapRWwrite;
  1669. result^.close := glBitmapRWclose;
  1670. result^.unknown.data1 := Stream;
  1671. end;
  1672. {$ENDIF}
  1673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1674. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1675. begin
  1676. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1677. end;
  1678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1679. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1680. begin
  1681. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1682. end;
  1683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1684. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1685. begin
  1686. glBitmapDefaultMipmap := aValue;
  1687. end;
  1688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1689. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1690. begin
  1691. glBitmapDefaultFormat := aFormat;
  1692. end;
  1693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1694. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1695. begin
  1696. glBitmapDefaultFilterMin := aMin;
  1697. glBitmapDefaultFilterMag := aMag;
  1698. end;
  1699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1700. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1701. begin
  1702. glBitmapDefaultWrapS := S;
  1703. glBitmapDefaultWrapT := T;
  1704. glBitmapDefaultWrapR := R;
  1705. end;
  1706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1707. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1708. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1709. begin
  1710. glDefaultSwizzle[0] := r;
  1711. glDefaultSwizzle[1] := g;
  1712. glDefaultSwizzle[2] := b;
  1713. glDefaultSwizzle[3] := a;
  1714. end;
  1715. {$IFEND}
  1716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1717. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1718. begin
  1719. result := glBitmapDefaultDeleteTextureOnFree;
  1720. end;
  1721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1722. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1723. begin
  1724. result := glBitmapDefaultFreeDataAfterGenTextures;
  1725. end;
  1726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1727. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1728. begin
  1729. result := glBitmapDefaultMipmap;
  1730. end;
  1731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1732. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1733. begin
  1734. result := glBitmapDefaultFormat;
  1735. end;
  1736. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1737. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1738. begin
  1739. aMin := glBitmapDefaultFilterMin;
  1740. aMag := glBitmapDefaultFilterMag;
  1741. end;
  1742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1743. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1744. begin
  1745. S := glBitmapDefaultWrapS;
  1746. T := glBitmapDefaultWrapT;
  1747. R := glBitmapDefaultWrapR;
  1748. end;
  1749. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1751. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1752. begin
  1753. r := glDefaultSwizzle[0];
  1754. g := glDefaultSwizzle[1];
  1755. b := glDefaultSwizzle[2];
  1756. a := glDefaultSwizzle[3];
  1757. end;
  1758. {$IFEND}
  1759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1762. function TFormatDescriptor.CreateMappingData: Pointer;
  1763. begin
  1764. result := nil;
  1765. end;
  1766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1767. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1768. begin
  1769. //DUMMY
  1770. end;
  1771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1772. function TFormatDescriptor.IsEmpty: Boolean;
  1773. begin
  1774. result := (fFormat = tfEmpty);
  1775. end;
  1776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1777. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1778. var
  1779. i: Integer;
  1780. m: TglBitmapRec4ul;
  1781. begin
  1782. result := false;
  1783. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1784. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1785. m := Mask;
  1786. for i := 0 to 3 do
  1787. if (aMask.arr[i] <> m.arr[i]) then
  1788. exit;
  1789. result := true;
  1790. end;
  1791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1792. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1793. begin
  1794. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1795. aPixel.Data := Range;
  1796. aPixel.Format := fFormat;
  1797. aPixel.Range := Range;
  1798. end;
  1799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1800. constructor TFormatDescriptor.Create;
  1801. begin
  1802. inherited Create;
  1803. end;
  1804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1807. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1808. begin
  1809. aData^ := aPixel.Data.a;
  1810. inc(aData);
  1811. end;
  1812. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1813. begin
  1814. aPixel.Data.r := 0;
  1815. aPixel.Data.g := 0;
  1816. aPixel.Data.b := 0;
  1817. aPixel.Data.a := aData^;
  1818. inc(aData);
  1819. end;
  1820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1821. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1824. begin
  1825. aData^ := LuminanceWeight(aPixel);
  1826. inc(aData);
  1827. end;
  1828. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1829. begin
  1830. aPixel.Data.r := aData^;
  1831. aPixel.Data.g := aData^;
  1832. aPixel.Data.b := aData^;
  1833. aPixel.Data.a := 0;
  1834. inc(aData);
  1835. end;
  1836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1837. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1840. var
  1841. i: Integer;
  1842. begin
  1843. aData^ := 0;
  1844. for i := 0 to 3 do
  1845. if (Range.arr[i] > 0) then
  1846. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1847. inc(aData);
  1848. end;
  1849. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1850. var
  1851. i: Integer;
  1852. begin
  1853. for i := 0 to 3 do
  1854. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1855. inc(aData);
  1856. end;
  1857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1858. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1861. begin
  1862. inherited Map(aPixel, aData, aMapData);
  1863. aData^ := aPixel.Data.a;
  1864. inc(aData);
  1865. end;
  1866. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1867. begin
  1868. inherited Unmap(aData, aPixel, aMapData);
  1869. aPixel.Data.a := aData^;
  1870. inc(aData);
  1871. end;
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1876. begin
  1877. aData^ := aPixel.Data.r;
  1878. inc(aData);
  1879. aData^ := aPixel.Data.g;
  1880. inc(aData);
  1881. aData^ := aPixel.Data.b;
  1882. inc(aData);
  1883. end;
  1884. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1885. begin
  1886. aPixel.Data.r := aData^;
  1887. inc(aData);
  1888. aPixel.Data.g := aData^;
  1889. inc(aData);
  1890. aPixel.Data.b := aData^;
  1891. inc(aData);
  1892. aPixel.Data.a := 0;
  1893. end;
  1894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1895. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1898. begin
  1899. aData^ := aPixel.Data.b;
  1900. inc(aData);
  1901. aData^ := aPixel.Data.g;
  1902. inc(aData);
  1903. aData^ := aPixel.Data.r;
  1904. inc(aData);
  1905. end;
  1906. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1907. begin
  1908. aPixel.Data.b := aData^;
  1909. inc(aData);
  1910. aPixel.Data.g := aData^;
  1911. inc(aData);
  1912. aPixel.Data.r := aData^;
  1913. inc(aData);
  1914. aPixel.Data.a := 0;
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1920. begin
  1921. inherited Map(aPixel, aData, aMapData);
  1922. aData^ := aPixel.Data.a;
  1923. inc(aData);
  1924. end;
  1925. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1926. begin
  1927. inherited Unmap(aData, aPixel, aMapData);
  1928. aPixel.Data.a := aData^;
  1929. inc(aData);
  1930. end;
  1931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1932. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1935. begin
  1936. inherited Map(aPixel, aData, aMapData);
  1937. aData^ := aPixel.Data.a;
  1938. inc(aData);
  1939. end;
  1940. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1941. begin
  1942. inherited Unmap(aData, aPixel, aMapData);
  1943. aPixel.Data.a := aData^;
  1944. inc(aData);
  1945. end;
  1946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1947. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1950. begin
  1951. PWord(aData)^ := aPixel.Data.a;
  1952. inc(aData, 2);
  1953. end;
  1954. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1955. begin
  1956. aPixel.Data.r := 0;
  1957. aPixel.Data.g := 0;
  1958. aPixel.Data.b := 0;
  1959. aPixel.Data.a := PWord(aData)^;
  1960. inc(aData, 2);
  1961. end;
  1962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1963. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1966. begin
  1967. PWord(aData)^ := LuminanceWeight(aPixel);
  1968. inc(aData, 2);
  1969. end;
  1970. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1971. begin
  1972. aPixel.Data.r := PWord(aData)^;
  1973. aPixel.Data.g := PWord(aData)^;
  1974. aPixel.Data.b := PWord(aData)^;
  1975. aPixel.Data.a := 0;
  1976. inc(aData, 2);
  1977. end;
  1978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1979. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1982. var
  1983. i: Integer;
  1984. begin
  1985. PWord(aData)^ := 0;
  1986. for i := 0 to 3 do
  1987. if (Range.arr[i] > 0) then
  1988. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1989. inc(aData, 2);
  1990. end;
  1991. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1992. var
  1993. i: Integer;
  1994. begin
  1995. for i := 0 to 3 do
  1996. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  1997. inc(aData, 2);
  1998. end;
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2003. begin
  2004. PWord(aData)^ := DepthWeight(aPixel);
  2005. inc(aData, 2);
  2006. end;
  2007. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2008. begin
  2009. aPixel.Data.r := PWord(aData)^;
  2010. aPixel.Data.g := PWord(aData)^;
  2011. aPixel.Data.b := PWord(aData)^;
  2012. aPixel.Data.a := PWord(aData)^;;
  2013. inc(aData, 2);
  2014. end;
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2019. begin
  2020. inherited Map(aPixel, aData, aMapData);
  2021. PWord(aData)^ := aPixel.Data.a;
  2022. inc(aData, 2);
  2023. end;
  2024. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2025. begin
  2026. inherited Unmap(aData, aPixel, aMapData);
  2027. aPixel.Data.a := PWord(aData)^;
  2028. inc(aData, 2);
  2029. end;
  2030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2031. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2034. begin
  2035. PWord(aData)^ := aPixel.Data.r;
  2036. inc(aData, 2);
  2037. PWord(aData)^ := aPixel.Data.g;
  2038. inc(aData, 2);
  2039. PWord(aData)^ := aPixel.Data.b;
  2040. inc(aData, 2);
  2041. end;
  2042. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2043. begin
  2044. aPixel.Data.r := PWord(aData)^;
  2045. inc(aData, 2);
  2046. aPixel.Data.g := PWord(aData)^;
  2047. inc(aData, 2);
  2048. aPixel.Data.b := PWord(aData)^;
  2049. inc(aData, 2);
  2050. aPixel.Data.a := 0;
  2051. end;
  2052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2053. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2056. begin
  2057. PWord(aData)^ := aPixel.Data.b;
  2058. inc(aData, 2);
  2059. PWord(aData)^ := aPixel.Data.g;
  2060. inc(aData, 2);
  2061. PWord(aData)^ := aPixel.Data.r;
  2062. inc(aData, 2);
  2063. end;
  2064. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2065. begin
  2066. aPixel.Data.b := PWord(aData)^;
  2067. inc(aData, 2);
  2068. aPixel.Data.g := PWord(aData)^;
  2069. inc(aData, 2);
  2070. aPixel.Data.r := PWord(aData)^;
  2071. inc(aData, 2);
  2072. aPixel.Data.a := 0;
  2073. end;
  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2078. begin
  2079. inherited Map(aPixel, aData, aMapData);
  2080. PWord(aData)^ := aPixel.Data.a;
  2081. inc(aData, 2);
  2082. end;
  2083. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2084. begin
  2085. inherited Unmap(aData, aPixel, aMapData);
  2086. aPixel.Data.a := PWord(aData)^;
  2087. inc(aData, 2);
  2088. end;
  2089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2090. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2092. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2093. begin
  2094. PWord(aData)^ := aPixel.Data.a;
  2095. inc(aData, 2);
  2096. inherited Map(aPixel, aData, aMapData);
  2097. end;
  2098. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2099. begin
  2100. aPixel.Data.a := PWord(aData)^;
  2101. inc(aData, 2);
  2102. inherited Unmap(aData, aPixel, aMapData);
  2103. end;
  2104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2105. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2108. begin
  2109. inherited Map(aPixel, aData, aMapData);
  2110. PWord(aData)^ := aPixel.Data.a;
  2111. inc(aData, 2);
  2112. end;
  2113. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2114. begin
  2115. inherited Unmap(aData, aPixel, aMapData);
  2116. aPixel.Data.a := PWord(aData)^;
  2117. inc(aData, 2);
  2118. end;
  2119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2120. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2122. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2123. begin
  2124. PWord(aData)^ := aPixel.Data.a;
  2125. inc(aData, 2);
  2126. inherited Map(aPixel, aData, aMapData);
  2127. end;
  2128. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2129. begin
  2130. aPixel.Data.a := PWord(aData)^;
  2131. inc(aData, 2);
  2132. inherited Unmap(aData, aPixel, aMapData);
  2133. end;
  2134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2138. var
  2139. i: Integer;
  2140. begin
  2141. PCardinal(aData)^ := 0;
  2142. for i := 0 to 3 do
  2143. if (Range.arr[i] > 0) then
  2144. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2145. inc(aData, 4);
  2146. end;
  2147. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2148. var
  2149. i: Integer;
  2150. begin
  2151. for i := 0 to 3 do
  2152. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2153. inc(aData, 2);
  2154. end;
  2155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2159. begin
  2160. PCardinal(aData)^ := DepthWeight(aPixel);
  2161. inc(aData, 4);
  2162. end;
  2163. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2164. begin
  2165. aPixel.Data.r := PCardinal(aData)^;
  2166. aPixel.Data.g := PCardinal(aData)^;
  2167. aPixel.Data.b := PCardinal(aData)^;
  2168. aPixel.Data.a := PCardinal(aData)^;
  2169. inc(aData, 4);
  2170. end;
  2171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. procedure TfdAlpha4ub1.SetValues;
  2175. begin
  2176. inherited SetValues;
  2177. fBitsPerPixel := 8;
  2178. fFormat := tfAlpha4ub1;
  2179. fWithAlpha := tfAlpha4ub1;
  2180. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2181. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2182. {$IFNDEF OPENGL_ES}
  2183. fOpenGLFormat := tfAlpha4ub1;
  2184. fglFormat := GL_ALPHA;
  2185. fglInternalFormat := GL_ALPHA4;
  2186. fglDataFormat := GL_UNSIGNED_BYTE;
  2187. {$ELSE}
  2188. fOpenGLFormat := tfAlpha8ub1;
  2189. {$ENDIF}
  2190. end;
  2191. procedure TfdAlpha8ub1.SetValues;
  2192. begin
  2193. inherited SetValues;
  2194. fBitsPerPixel := 8;
  2195. fFormat := tfAlpha8ub1;
  2196. fWithAlpha := tfAlpha8ub1;
  2197. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2198. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2199. fOpenGLFormat := tfAlpha8ub1;
  2200. fglFormat := GL_ALPHA;
  2201. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2202. fglDataFormat := GL_UNSIGNED_BYTE;
  2203. end;
  2204. procedure TfdAlpha16us1.SetValues;
  2205. begin
  2206. inherited SetValues;
  2207. fBitsPerPixel := 16;
  2208. fFormat := tfAlpha16us1;
  2209. fWithAlpha := tfAlpha16us1;
  2210. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2211. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2212. {$IFNDEF OPENGL_ES}
  2213. fOpenGLFormat := tfAlpha16us1;
  2214. fglFormat := GL_ALPHA;
  2215. fglInternalFormat := GL_ALPHA16;
  2216. fglDataFormat := GL_UNSIGNED_SHORT;
  2217. {$ELSE}
  2218. fOpenGLFormat := tfAlpha8ub1;
  2219. {$ENDIF}
  2220. end;
  2221. procedure TfdLuminance4ub1.SetValues;
  2222. begin
  2223. inherited SetValues;
  2224. fBitsPerPixel := 8;
  2225. fFormat := tfLuminance4ub1;
  2226. fWithAlpha := tfLuminance4Alpha4ub2;
  2227. fWithoutAlpha := tfLuminance4ub1;
  2228. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2229. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2230. {$IFNDEF OPENGL_ES}
  2231. fOpenGLFormat := tfLuminance4ub1;
  2232. fglFormat := GL_LUMINANCE;
  2233. fglInternalFormat := GL_LUMINANCE4;
  2234. fglDataFormat := GL_UNSIGNED_BYTE;
  2235. {$ELSE}
  2236. fOpenGLFormat := tfLuminance8ub1;
  2237. {$ENDIF}
  2238. end;
  2239. procedure TfdLuminance8ub1.SetValues;
  2240. begin
  2241. inherited SetValues;
  2242. fBitsPerPixel := 8;
  2243. fFormat := tfLuminance8ub1;
  2244. fWithAlpha := tfLuminance8Alpha8ub2;
  2245. fWithoutAlpha := tfLuminance8ub1;
  2246. fOpenGLFormat := tfLuminance8ub1;
  2247. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2248. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2249. fglFormat := GL_LUMINANCE;
  2250. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2251. fglDataFormat := GL_UNSIGNED_BYTE;
  2252. end;
  2253. procedure TfdLuminance16us1.SetValues;
  2254. begin
  2255. inherited SetValues;
  2256. fBitsPerPixel := 16;
  2257. fFormat := tfLuminance16us1;
  2258. fWithAlpha := tfLuminance16Alpha16us2;
  2259. fWithoutAlpha := tfLuminance16us1;
  2260. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2261. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2262. {$IFNDEF OPENGL_ES}
  2263. fOpenGLFormat := tfLuminance16us1;
  2264. fglFormat := GL_LUMINANCE;
  2265. fglInternalFormat := GL_LUMINANCE16;
  2266. fglDataFormat := GL_UNSIGNED_SHORT;
  2267. {$ELSE}
  2268. fOpenGLFormat := tfLuminance8ub1;
  2269. {$ENDIF}
  2270. end;
  2271. procedure TfdLuminance4Alpha4ub2.SetValues;
  2272. begin
  2273. inherited SetValues;
  2274. fBitsPerPixel := 16;
  2275. fFormat := tfLuminance4Alpha4ub2;
  2276. fWithAlpha := tfLuminance4Alpha4ub2;
  2277. fWithoutAlpha := tfLuminance4ub1;
  2278. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2279. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2280. {$IFNDEF OPENGL_ES}
  2281. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2282. fglFormat := GL_LUMINANCE_ALPHA;
  2283. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2284. fglDataFormat := GL_UNSIGNED_BYTE;
  2285. {$ELSE}
  2286. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2287. {$ENDIF}
  2288. end;
  2289. procedure TfdLuminance6Alpha2ub2.SetValues;
  2290. begin
  2291. inherited SetValues;
  2292. fBitsPerPixel := 16;
  2293. fFormat := tfLuminance6Alpha2ub2;
  2294. fWithAlpha := tfLuminance6Alpha2ub2;
  2295. fWithoutAlpha := tfLuminance8ub1;
  2296. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2297. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2298. {$IFNDEF OPENGL_ES}
  2299. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2300. fglFormat := GL_LUMINANCE_ALPHA;
  2301. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2302. fglDataFormat := GL_UNSIGNED_BYTE;
  2303. {$ELSE}
  2304. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2305. {$ENDIF}
  2306. end;
  2307. procedure TfdLuminance8Alpha8ub2.SetValues;
  2308. begin
  2309. inherited SetValues;
  2310. fBitsPerPixel := 16;
  2311. fFormat := tfLuminance8Alpha8ub2;
  2312. fWithAlpha := tfLuminance8Alpha8ub2;
  2313. fWithoutAlpha := tfLuminance8ub1;
  2314. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2315. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2316. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2317. fglFormat := GL_LUMINANCE_ALPHA;
  2318. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2319. fglDataFormat := GL_UNSIGNED_BYTE;
  2320. end;
  2321. procedure TfdLuminance12Alpha4us2.SetValues;
  2322. begin
  2323. inherited SetValues;
  2324. fBitsPerPixel := 32;
  2325. fFormat := tfLuminance12Alpha4us2;
  2326. fWithAlpha := tfLuminance12Alpha4us2;
  2327. fWithoutAlpha := tfLuminance16us1;
  2328. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2329. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2330. {$IFNDEF OPENGL_ES}
  2331. fOpenGLFormat := tfLuminance12Alpha4us2;
  2332. fglFormat := GL_LUMINANCE_ALPHA;
  2333. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2334. fglDataFormat := GL_UNSIGNED_SHORT;
  2335. {$ELSE}
  2336. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2337. {$ENDIF}
  2338. end;
  2339. procedure TfdLuminance16Alpha16us2.SetValues;
  2340. begin
  2341. inherited SetValues;
  2342. fBitsPerPixel := 32;
  2343. fFormat := tfLuminance16Alpha16us2;
  2344. fWithAlpha := tfLuminance16Alpha16us2;
  2345. fWithoutAlpha := tfLuminance16us1;
  2346. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2347. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2348. {$IFNDEF OPENGL_ES}
  2349. fOpenGLFormat := tfLuminance16Alpha16us2;
  2350. fglFormat := GL_LUMINANCE_ALPHA;
  2351. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2352. fglDataFormat := GL_UNSIGNED_SHORT;
  2353. {$ELSE}
  2354. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2355. {$ENDIF}
  2356. end;
  2357. procedure TfdR3G3B2ub1.SetValues;
  2358. begin
  2359. inherited SetValues;
  2360. fBitsPerPixel := 8;
  2361. fFormat := tfR3G3B2ub1;
  2362. fWithAlpha := tfRGBA4us1;
  2363. fWithoutAlpha := tfR3G3B2ub1;
  2364. fRGBInverted := tfEmpty;
  2365. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2366. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2367. {$IFNDEF OPENGL_ES}
  2368. fOpenGLFormat := tfR3G3B2ub1;
  2369. fglFormat := GL_RGB;
  2370. fglInternalFormat := GL_R3_G3_B2;
  2371. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2372. {$ELSE}
  2373. fOpenGLFormat := tfR5G6B5us1;
  2374. {$ENDIF}
  2375. end;
  2376. procedure TfdRGBX4us1.SetValues;
  2377. begin
  2378. inherited SetValues;
  2379. fBitsPerPixel := 16;
  2380. fFormat := tfRGBX4us1;
  2381. fWithAlpha := tfRGBA4us1;
  2382. fWithoutAlpha := tfRGBX4us1;
  2383. fRGBInverted := tfBGRX4us1;
  2384. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2385. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2386. {$IFNDEF OPENGL_ES}
  2387. fOpenGLFormat := tfRGBX4us1;
  2388. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2389. fglInternalFormat := GL_RGB4;
  2390. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2391. {$ELSE}
  2392. fOpenGLFormat := tfR5G6B5us1;
  2393. {$ENDIF}
  2394. end;
  2395. procedure TfdXRGB4us1.SetValues;
  2396. begin
  2397. inherited SetValues;
  2398. fBitsPerPixel := 16;
  2399. fFormat := tfXRGB4us1;
  2400. fWithAlpha := tfARGB4us1;
  2401. fWithoutAlpha := tfXRGB4us1;
  2402. fRGBInverted := tfXBGR4us1;
  2403. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2404. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2405. {$IFNDEF OPENGL_ES}
  2406. fOpenGLFormat := tfXRGB4us1;
  2407. fglFormat := GL_BGRA;
  2408. fglInternalFormat := GL_RGB4;
  2409. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2410. {$ELSE}
  2411. fOpenGLFormat := tfR5G6B5us1;
  2412. {$ENDIF}
  2413. end;
  2414. procedure TfdR5G6B5us1.SetValues;
  2415. begin
  2416. inherited SetValues;
  2417. fBitsPerPixel := 16;
  2418. fFormat := tfR5G6B5us1;
  2419. fWithAlpha := tfRGB5A1us1;
  2420. fWithoutAlpha := tfR5G6B5us1;
  2421. fRGBInverted := tfB5G6R5us1;
  2422. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2423. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2424. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2425. fOpenGLFormat := tfR5G6B5us1;
  2426. fglFormat := GL_RGB;
  2427. fglInternalFormat := GL_RGB565;
  2428. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2429. {$ELSE}
  2430. fOpenGLFormat := tfRGB8ub3;
  2431. {$IFEND}
  2432. end;
  2433. procedure TfdRGB5X1us1.SetValues;
  2434. begin
  2435. inherited SetValues;
  2436. fBitsPerPixel := 16;
  2437. fFormat := tfRGB5X1us1;
  2438. fWithAlpha := tfRGB5A1us1;
  2439. fWithoutAlpha := tfRGB5X1us1;
  2440. fRGBInverted := tfBGR5X1us1;
  2441. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2442. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2443. {$IFNDEF OPENGL_ES}
  2444. fOpenGLFormat := tfRGB5X1us1;
  2445. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2446. fglInternalFormat := GL_RGB5;
  2447. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2448. {$ELSE}
  2449. fOpenGLFormat := tfR5G6B5us1;
  2450. {$ENDIF}
  2451. end;
  2452. procedure TfdX1RGB5us1.SetValues;
  2453. begin
  2454. inherited SetValues;
  2455. fBitsPerPixel := 16;
  2456. fFormat := tfX1RGB5us1;
  2457. fWithAlpha := tfA1RGB5us1;
  2458. fWithoutAlpha := tfX1RGB5us1;
  2459. fRGBInverted := tfX1BGR5us1;
  2460. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2461. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2462. {$IFNDEF OPENGL_ES}
  2463. fOpenGLFormat := tfX1RGB5us1;
  2464. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2465. fglInternalFormat := GL_RGB5;
  2466. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2467. {$ELSE}
  2468. fOpenGLFormat := tfR5G6B5us1;
  2469. {$ENDIF}
  2470. end;
  2471. procedure TfdRGB8ub3.SetValues;
  2472. begin
  2473. inherited SetValues;
  2474. fBitsPerPixel := 24;
  2475. fFormat := tfRGB8ub3;
  2476. fWithAlpha := tfRGBA8ub4;
  2477. fWithoutAlpha := tfRGB8ub3;
  2478. fRGBInverted := tfBGR8ub3;
  2479. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2480. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2481. fOpenGLFormat := tfRGB8ub3;
  2482. fglFormat := GL_RGB;
  2483. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2484. fglDataFormat := GL_UNSIGNED_BYTE;
  2485. end;
  2486. procedure TfdRGBX8ui1.SetValues;
  2487. begin
  2488. inherited SetValues;
  2489. fBitsPerPixel := 32;
  2490. fFormat := tfRGBX8ui1;
  2491. fWithAlpha := tfRGBA8ui1;
  2492. fWithoutAlpha := tfRGBX8ui1;
  2493. fRGBInverted := tfBGRX8ui1;
  2494. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2495. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2496. {$IFNDEF OPENGL_ES}
  2497. fOpenGLFormat := tfRGBX8ui1;
  2498. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2499. fglInternalFormat := GL_RGB8;
  2500. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2501. {$ELSE}
  2502. fOpenGLFormat := tfRGB8ub3;
  2503. {$ENDIF}
  2504. end;
  2505. procedure TfdXRGB8ui1.SetValues;
  2506. begin
  2507. inherited SetValues;
  2508. fBitsPerPixel := 32;
  2509. fFormat := tfXRGB8ui1;
  2510. fWithAlpha := tfXRGB8ui1;
  2511. fWithoutAlpha := tfXRGB8ui1;
  2512. fOpenGLFormat := tfXRGB8ui1;
  2513. fRGBInverted := tfXBGR8ui1;
  2514. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2515. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2516. {$IFNDEF OPENGL_ES}
  2517. fOpenGLFormat := tfXRGB8ui1;
  2518. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2519. fglInternalFormat := GL_RGB8;
  2520. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2521. {$ELSE}
  2522. fOpenGLFormat := tfRGB8ub3;
  2523. {$ENDIF}
  2524. end;
  2525. procedure TfdRGB10X2ui1.SetValues;
  2526. begin
  2527. inherited SetValues;
  2528. fBitsPerPixel := 32;
  2529. fFormat := tfRGB10X2ui1;
  2530. fWithAlpha := tfRGB10A2ui1;
  2531. fWithoutAlpha := tfRGB10X2ui1;
  2532. fRGBInverted := tfBGR10X2ui1;
  2533. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2534. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2535. {$IFNDEF OPENGL_ES}
  2536. fOpenGLFormat := tfRGB10X2ui1;
  2537. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2538. fglInternalFormat := GL_RGB10;
  2539. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2540. {$ELSE}
  2541. fOpenGLFormat := tfRGB16us3;
  2542. {$ENDIF}
  2543. end;
  2544. procedure TfdX2RGB10ui1.SetValues;
  2545. begin
  2546. inherited SetValues;
  2547. fBitsPerPixel := 32;
  2548. fFormat := tfX2RGB10ui1;
  2549. fWithAlpha := tfA2RGB10ui1;
  2550. fWithoutAlpha := tfX2RGB10ui1;
  2551. fRGBInverted := tfX2BGR10ui1;
  2552. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2553. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2554. {$IFNDEF OPENGL_ES}
  2555. fOpenGLFormat := tfX2RGB10ui1;
  2556. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2557. fglInternalFormat := GL_RGB10;
  2558. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2559. {$ELSE}
  2560. fOpenGLFormat := tfRGB16us3;
  2561. {$ENDIF}
  2562. end;
  2563. procedure TfdRGB16us3.SetValues;
  2564. begin
  2565. inherited SetValues;
  2566. fBitsPerPixel := 48;
  2567. fFormat := tfRGB16us3;
  2568. fWithAlpha := tfRGBA16us4;
  2569. fWithoutAlpha := tfRGB16us3;
  2570. fRGBInverted := tfBGR16us3;
  2571. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2572. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2573. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2574. fOpenGLFormat := tfRGB16us3;
  2575. fglFormat := GL_RGB;
  2576. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2577. fglDataFormat := GL_UNSIGNED_SHORT;
  2578. {$ELSE}
  2579. fOpenGLFormat := tfRGB8ub3;
  2580. {$IFEND}
  2581. end;
  2582. procedure TfdRGBA4us1.SetValues;
  2583. begin
  2584. inherited SetValues;
  2585. fBitsPerPixel := 16;
  2586. fFormat := tfRGBA4us1;
  2587. fWithAlpha := tfRGBA4us1;
  2588. fWithoutAlpha := tfRGBX4us1;
  2589. fOpenGLFormat := tfRGBA4us1;
  2590. fRGBInverted := tfBGRA4us1;
  2591. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2592. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2593. fglFormat := GL_RGBA;
  2594. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2595. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2596. end;
  2597. procedure TfdARGB4us1.SetValues;
  2598. begin
  2599. inherited SetValues;
  2600. fBitsPerPixel := 16;
  2601. fFormat := tfARGB4us1;
  2602. fWithAlpha := tfARGB4us1;
  2603. fWithoutAlpha := tfXRGB4us1;
  2604. fRGBInverted := tfABGR4us1;
  2605. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2606. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2607. {$IFNDEF OPENGL_ES}
  2608. fOpenGLFormat := tfARGB4us1;
  2609. fglFormat := GL_BGRA;
  2610. fglInternalFormat := GL_RGBA4;
  2611. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2612. {$ELSE}
  2613. fOpenGLFormat := tfRGBA4us1;
  2614. {$ENDIF}
  2615. end;
  2616. procedure TfdRGB5A1us1.SetValues;
  2617. begin
  2618. inherited SetValues;
  2619. fBitsPerPixel := 16;
  2620. fFormat := tfRGB5A1us1;
  2621. fWithAlpha := tfRGB5A1us1;
  2622. fWithoutAlpha := tfRGB5X1us1;
  2623. fOpenGLFormat := tfRGB5A1us1;
  2624. fRGBInverted := tfBGR5A1us1;
  2625. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2626. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2627. fglFormat := GL_RGBA;
  2628. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2629. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2630. end;
  2631. procedure TfdA1RGB5us1.SetValues;
  2632. begin
  2633. inherited SetValues;
  2634. fBitsPerPixel := 16;
  2635. fFormat := tfA1RGB5us1;
  2636. fWithAlpha := tfA1RGB5us1;
  2637. fWithoutAlpha := tfX1RGB5us1;
  2638. fRGBInverted := tfA1BGR5us1;
  2639. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2640. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2641. {$IFNDEF OPENGL_ES}
  2642. fOpenGLFormat := tfA1RGB5us1;
  2643. fglFormat := GL_BGRA;
  2644. fglInternalFormat := GL_RGB5_A1;
  2645. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2646. {$ELSE}
  2647. fOpenGLFormat := tfRGB5A1us1;
  2648. {$ENDIF}
  2649. end;
  2650. procedure TfdRGBA8ui1.SetValues;
  2651. begin
  2652. inherited SetValues;
  2653. fBitsPerPixel := 32;
  2654. fFormat := tfRGBA8ui1;
  2655. fWithAlpha := tfRGBA8ui1;
  2656. fWithoutAlpha := tfRGBX8ui1;
  2657. fRGBInverted := tfBGRA8ui1;
  2658. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2659. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2660. {$IFNDEF OPENGL_ES}
  2661. fOpenGLFormat := tfRGBA8ui1;
  2662. fglFormat := GL_RGBA;
  2663. fglInternalFormat := GL_RGBA8;
  2664. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2665. {$ELSE}
  2666. fOpenGLFormat := tfRGBA8ub4;
  2667. {$ENDIF}
  2668. end;
  2669. procedure TfdARGB8ui1.SetValues;
  2670. begin
  2671. inherited SetValues;
  2672. fBitsPerPixel := 32;
  2673. fFormat := tfARGB8ui1;
  2674. fWithAlpha := tfARGB8ui1;
  2675. fWithoutAlpha := tfXRGB8ui1;
  2676. fRGBInverted := tfABGR8ui1;
  2677. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2678. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2679. {$IFNDEF OPENGL_ES}
  2680. fOpenGLFormat := tfARGB8ui1;
  2681. fglFormat := GL_BGRA;
  2682. fglInternalFormat := GL_RGBA8;
  2683. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2684. {$ELSE}
  2685. fOpenGLFormat := tfRGBA8ub4;
  2686. {$ENDIF}
  2687. end;
  2688. procedure TfdRGBA8ub4.SetValues;
  2689. begin
  2690. inherited SetValues;
  2691. fBitsPerPixel := 32;
  2692. fFormat := tfRGBA8ub4;
  2693. fWithAlpha := tfRGBA8ub4;
  2694. fWithoutAlpha := tfRGB8ub3;
  2695. fOpenGLFormat := tfRGBA8ub4;
  2696. fRGBInverted := tfBGRA8ub4;
  2697. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2698. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2699. fglFormat := GL_RGBA;
  2700. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2701. fglDataFormat := GL_UNSIGNED_BYTE;
  2702. end;
  2703. procedure TfdRGB10A2ui1.SetValues;
  2704. begin
  2705. inherited SetValues;
  2706. fBitsPerPixel := 32;
  2707. fFormat := tfRGB10A2ui1;
  2708. fWithAlpha := tfRGB10A2ui1;
  2709. fWithoutAlpha := tfRGB10X2ui1;
  2710. fRGBInverted := tfBGR10A2ui1;
  2711. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2712. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2713. {$IFNDEF OPENGL_ES}
  2714. fOpenGLFormat := tfRGB10A2ui1;
  2715. fglFormat := GL_RGBA;
  2716. fglInternalFormat := GL_RGB10_A2;
  2717. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2718. {$ELSE}
  2719. fOpenGLFormat := tfA2RGB10ui1;
  2720. {$ENDIF}
  2721. end;
  2722. procedure TfdA2RGB10ui1.SetValues;
  2723. begin
  2724. inherited SetValues;
  2725. fBitsPerPixel := 32;
  2726. fFormat := tfA2RGB10ui1;
  2727. fWithAlpha := tfA2RGB10ui1;
  2728. fWithoutAlpha := tfX2RGB10ui1;
  2729. fRGBInverted := tfA2BGR10ui1;
  2730. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2731. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2732. {$IF NOT DEFINED(OPENGL_ES)}
  2733. fOpenGLFormat := tfA2RGB10ui1;
  2734. fglFormat := GL_BGRA;
  2735. fglInternalFormat := GL_RGB10_A2;
  2736. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2737. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2738. fOpenGLFormat := tfA2RGB10ui1;
  2739. fglFormat := GL_RGBA;
  2740. fglInternalFormat := GL_RGB10_A2;
  2741. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2742. {$ELSE}
  2743. fOpenGLFormat := tfRGBA8ui1;
  2744. {$IFEND}
  2745. end;
  2746. procedure TfdRGBA16us4.SetValues;
  2747. begin
  2748. inherited SetValues;
  2749. fBitsPerPixel := 64;
  2750. fFormat := tfRGBA16us4;
  2751. fWithAlpha := tfRGBA16us4;
  2752. fWithoutAlpha := tfRGB16us3;
  2753. fRGBInverted := tfBGRA16us4;
  2754. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2755. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2756. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2757. fOpenGLFormat := tfRGBA16us4;
  2758. fglFormat := GL_RGBA;
  2759. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2760. fglDataFormat := GL_UNSIGNED_SHORT;
  2761. {$ELSE}
  2762. fOpenGLFormat := tfRGBA8ub4;
  2763. {$IFEND}
  2764. end;
  2765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2768. procedure TfdBGRX4us1.SetValues;
  2769. begin
  2770. inherited SetValues;
  2771. fBitsPerPixel := 16;
  2772. fFormat := tfBGRX4us1;
  2773. fWithAlpha := tfBGRA4us1;
  2774. fWithoutAlpha := tfBGRX4us1;
  2775. fRGBInverted := tfRGBX4us1;
  2776. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2777. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2778. {$IFNDEF OPENGL_ES}
  2779. fOpenGLFormat := tfBGRX4us1;
  2780. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2781. fglInternalFormat := GL_RGB4;
  2782. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2783. {$ELSE}
  2784. fOpenGLFormat := tfR5G6B5us1;
  2785. {$ENDIF}
  2786. end;
  2787. procedure TfdXBGR4us1.SetValues;
  2788. begin
  2789. inherited SetValues;
  2790. fBitsPerPixel := 16;
  2791. fFormat := tfXBGR4us1;
  2792. fWithAlpha := tfABGR4us1;
  2793. fWithoutAlpha := tfXBGR4us1;
  2794. fRGBInverted := tfXRGB4us1;
  2795. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2796. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2797. {$IFNDEF OPENGL_ES}
  2798. fOpenGLFormat := tfXBGR4us1;
  2799. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2800. fglInternalFormat := GL_RGB4;
  2801. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2802. {$ELSE}
  2803. fOpenGLFormat := tfR5G6B5us1;
  2804. {$ENDIF}
  2805. end;
  2806. procedure TfdB5G6R5us1.SetValues;
  2807. begin
  2808. inherited SetValues;
  2809. fBitsPerPixel := 16;
  2810. fFormat := tfB5G6R5us1;
  2811. fWithAlpha := tfBGR5A1us1;
  2812. fWithoutAlpha := tfB5G6R5us1;
  2813. fRGBInverted := tfR5G6B5us1;
  2814. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2815. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2816. {$IFNDEF OPENGL_ES}
  2817. fOpenGLFormat := tfB5G6R5us1;
  2818. fglFormat := GL_RGB;
  2819. fglInternalFormat := GL_RGB565;
  2820. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2821. {$ELSE}
  2822. fOpenGLFormat := tfR5G6B5us1;
  2823. {$ENDIF}
  2824. end;
  2825. procedure TfdBGR5X1us1.SetValues;
  2826. begin
  2827. inherited SetValues;
  2828. fBitsPerPixel := 16;
  2829. fFormat := tfBGR5X1us1;
  2830. fWithAlpha := tfBGR5A1us1;
  2831. fWithoutAlpha := tfBGR5X1us1;
  2832. fRGBInverted := tfRGB5X1us1;
  2833. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2834. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2835. {$IFNDEF OPENGL_ES}
  2836. fOpenGLFormat := tfBGR5X1us1;
  2837. fglFormat := GL_BGRA;
  2838. fglInternalFormat := GL_RGB5;
  2839. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2840. {$ELSE}
  2841. fOpenGLFormat := tfR5G6B5us1;
  2842. {$ENDIF}
  2843. end;
  2844. procedure TfdX1BGR5us1.SetValues;
  2845. begin
  2846. inherited SetValues;
  2847. fBitsPerPixel := 16;
  2848. fFormat := tfX1BGR5us1;
  2849. fWithAlpha := tfA1BGR5us1;
  2850. fWithoutAlpha := tfX1BGR5us1;
  2851. fRGBInverted := tfX1RGB5us1;
  2852. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2853. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2854. {$IFNDEF OPENGL_ES}
  2855. fOpenGLFormat := tfX1BGR5us1;
  2856. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2857. fglInternalFormat := GL_RGB5;
  2858. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2859. {$ELSE}
  2860. fOpenGLFormat := tfR5G6B5us1;
  2861. {$ENDIF}
  2862. end;
  2863. procedure TfdBGR8ub3.SetValues;
  2864. begin
  2865. inherited SetValues;
  2866. fBitsPerPixel := 24;
  2867. fFormat := tfBGR8ub3;
  2868. fWithAlpha := tfBGRA8ub4;
  2869. fWithoutAlpha := tfBGR8ub3;
  2870. fRGBInverted := tfRGB8ub3;
  2871. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2872. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2873. {$IFNDEF OPENGL_ES}
  2874. fOpenGLFormat := tfBGR8ub3;
  2875. fglFormat := GL_BGR;
  2876. fglInternalFormat := GL_RGB8;
  2877. fglDataFormat := GL_UNSIGNED_BYTE;
  2878. {$ELSE}
  2879. fOpenGLFormat := tfRGB8ub3;
  2880. {$ENDIF}
  2881. end;
  2882. procedure TfdBGRX8ui1.SetValues;
  2883. begin
  2884. inherited SetValues;
  2885. fBitsPerPixel := 32;
  2886. fFormat := tfBGRX8ui1;
  2887. fWithAlpha := tfBGRA8ui1;
  2888. fWithoutAlpha := tfBGRX8ui1;
  2889. fRGBInverted := tfRGBX8ui1;
  2890. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2891. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2892. {$IFNDEF OPENGL_ES}
  2893. fOpenGLFormat := tfBGRX8ui1;
  2894. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2895. fglInternalFormat := GL_RGB8;
  2896. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2897. {$ELSE}
  2898. fOpenGLFormat := tfRGB8ub3;
  2899. {$ENDIF}
  2900. end;
  2901. procedure TfdXBGR8ui1.SetValues;
  2902. begin
  2903. inherited SetValues;
  2904. fBitsPerPixel := 32;
  2905. fFormat := tfXBGR8ui1;
  2906. fWithAlpha := tfABGR8ui1;
  2907. fWithoutAlpha := tfXBGR8ui1;
  2908. fRGBInverted := tfXRGB8ui1;
  2909. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2910. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2911. {$IFNDEF OPENGL_ES}
  2912. fOpenGLFormat := tfXBGR8ui1;
  2913. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2914. fglInternalFormat := GL_RGB8;
  2915. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2916. {$ELSE}
  2917. fOpenGLFormat := tfRGB8ub3;
  2918. {$ENDIF}
  2919. end;
  2920. procedure TfdBGR10X2ui1.SetValues;
  2921. begin
  2922. inherited SetValues;
  2923. fBitsPerPixel := 32;
  2924. fFormat := tfBGR10X2ui1;
  2925. fWithAlpha := tfBGR10A2ui1;
  2926. fWithoutAlpha := tfBGR10X2ui1;
  2927. fRGBInverted := tfRGB10X2ui1;
  2928. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2929. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2930. {$IFNDEF OPENGL_ES}
  2931. fOpenGLFormat := tfBGR10X2ui1;
  2932. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2933. fglInternalFormat := GL_RGB10;
  2934. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2935. {$ELSE}
  2936. fOpenGLFormat := tfRGB16us3;
  2937. {$ENDIF}
  2938. end;
  2939. procedure TfdX2BGR10ui1.SetValues;
  2940. begin
  2941. inherited SetValues;
  2942. fBitsPerPixel := 32;
  2943. fFormat := tfX2BGR10ui1;
  2944. fWithAlpha := tfA2BGR10ui1;
  2945. fWithoutAlpha := tfX2BGR10ui1;
  2946. fRGBInverted := tfX2RGB10ui1;
  2947. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2948. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2949. {$IFNDEF OPENGL_ES}
  2950. fOpenGLFormat := tfX2BGR10ui1;
  2951. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2952. fglInternalFormat := GL_RGB10;
  2953. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2954. {$ELSE}
  2955. fOpenGLFormat := tfRGB16us3;
  2956. {$ENDIF}
  2957. end;
  2958. procedure TfdBGR16us3.SetValues;
  2959. begin
  2960. inherited SetValues;
  2961. fBitsPerPixel := 48;
  2962. fFormat := tfBGR16us3;
  2963. fWithAlpha := tfBGRA16us4;
  2964. fWithoutAlpha := tfBGR16us3;
  2965. fRGBInverted := tfRGB16us3;
  2966. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2967. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2968. {$IFNDEF OPENGL_ES}
  2969. fOpenGLFormat := tfBGR16us3;
  2970. fglFormat := GL_BGR;
  2971. fglInternalFormat := GL_RGB16;
  2972. fglDataFormat := GL_UNSIGNED_SHORT;
  2973. {$ELSE}
  2974. fOpenGLFormat := tfRGB16us3;
  2975. {$ENDIF}
  2976. end;
  2977. procedure TfdBGRA4us1.SetValues;
  2978. begin
  2979. inherited SetValues;
  2980. fBitsPerPixel := 16;
  2981. fFormat := tfBGRA4us1;
  2982. fWithAlpha := tfBGRA4us1;
  2983. fWithoutAlpha := tfBGRX4us1;
  2984. fRGBInverted := tfRGBA4us1;
  2985. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2986. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2987. {$IFNDEF OPENGL_ES}
  2988. fOpenGLFormat := tfBGRA4us1;
  2989. fglFormat := GL_BGRA;
  2990. fglInternalFormat := GL_RGBA4;
  2991. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2992. {$ELSE}
  2993. fOpenGLFormat := tfRGBA4us1;
  2994. {$ENDIF}
  2995. end;
  2996. procedure TfdABGR4us1.SetValues;
  2997. begin
  2998. inherited SetValues;
  2999. fBitsPerPixel := 16;
  3000. fFormat := tfABGR4us1;
  3001. fWithAlpha := tfABGR4us1;
  3002. fWithoutAlpha := tfXBGR4us1;
  3003. fRGBInverted := tfARGB4us1;
  3004. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3005. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3006. {$IFNDEF OPENGL_ES}
  3007. fOpenGLFormat := tfABGR4us1;
  3008. fglFormat := GL_RGBA;
  3009. fglInternalFormat := GL_RGBA4;
  3010. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3011. {$ELSE}
  3012. fOpenGLFormat := tfRGBA4us1;
  3013. {$ENDIF}
  3014. end;
  3015. procedure TfdBGR5A1us1.SetValues;
  3016. begin
  3017. inherited SetValues;
  3018. fBitsPerPixel := 16;
  3019. fFormat := tfBGR5A1us1;
  3020. fWithAlpha := tfBGR5A1us1;
  3021. fWithoutAlpha := tfBGR5X1us1;
  3022. fRGBInverted := tfRGB5A1us1;
  3023. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3024. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3025. {$IFNDEF OPENGL_ES}
  3026. fOpenGLFormat := tfBGR5A1us1;
  3027. fglFormat := GL_BGRA;
  3028. fglInternalFormat := GL_RGB5_A1;
  3029. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3030. {$ELSE}
  3031. fOpenGLFormat := tfRGB5A1us1;
  3032. {$ENDIF}
  3033. end;
  3034. procedure TfdA1BGR5us1.SetValues;
  3035. begin
  3036. inherited SetValues;
  3037. fBitsPerPixel := 16;
  3038. fFormat := tfA1BGR5us1;
  3039. fWithAlpha := tfA1BGR5us1;
  3040. fWithoutAlpha := tfX1BGR5us1;
  3041. fRGBInverted := tfA1RGB5us1;
  3042. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3043. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3044. {$IFNDEF OPENGL_ES}
  3045. fOpenGLFormat := tfA1BGR5us1;
  3046. fglFormat := GL_RGBA;
  3047. fglInternalFormat := GL_RGB5_A1;
  3048. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3049. {$ELSE}
  3050. fOpenGLFormat := tfRGB5A1us1;
  3051. {$ENDIF}
  3052. end;
  3053. procedure TfdBGRA8ui1.SetValues;
  3054. begin
  3055. inherited SetValues;
  3056. fBitsPerPixel := 32;
  3057. fFormat := tfBGRA8ui1;
  3058. fWithAlpha := tfBGRA8ui1;
  3059. fWithoutAlpha := tfBGRX8ui1;
  3060. fRGBInverted := tfRGBA8ui1;
  3061. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3062. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3063. {$IFNDEF OPENGL_ES}
  3064. fOpenGLFormat := tfBGRA8ui1;
  3065. fglFormat := GL_BGRA;
  3066. fglInternalFormat := GL_RGBA8;
  3067. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3068. {$ELSE}
  3069. fOpenGLFormat := tfRGBA8ub4;
  3070. {$ENDIF}
  3071. end;
  3072. procedure TfdABGR8ui1.SetValues;
  3073. begin
  3074. inherited SetValues;
  3075. fBitsPerPixel := 32;
  3076. fFormat := tfABGR8ui1;
  3077. fWithAlpha := tfABGR8ui1;
  3078. fWithoutAlpha := tfXBGR8ui1;
  3079. fRGBInverted := tfARGB8ui1;
  3080. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3081. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3082. {$IFNDEF OPENGL_ES}
  3083. fOpenGLFormat := tfABGR8ui1;
  3084. fglFormat := GL_RGBA;
  3085. fglInternalFormat := GL_RGBA8;
  3086. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3087. {$ELSE}
  3088. fOpenGLFormat := tfRGBA8ub4
  3089. {$ENDIF}
  3090. end;
  3091. procedure TfdBGRA8ub4.SetValues;
  3092. begin
  3093. inherited SetValues;
  3094. fBitsPerPixel := 32;
  3095. fFormat := tfBGRA8ub4;
  3096. fWithAlpha := tfBGRA8ub4;
  3097. fWithoutAlpha := tfBGR8ub3;
  3098. fRGBInverted := tfRGBA8ub4;
  3099. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3100. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3101. {$IFNDEF OPENGL_ES}
  3102. fOpenGLFormat := tfBGRA8ub4;
  3103. fglFormat := GL_BGRA;
  3104. fglInternalFormat := GL_RGBA8;
  3105. fglDataFormat := GL_UNSIGNED_BYTE;
  3106. {$ELSE}
  3107. fOpenGLFormat := tfRGBA8ub4;
  3108. {$ENDIF}
  3109. end;
  3110. procedure TfdBGR10A2ui1.SetValues;
  3111. begin
  3112. inherited SetValues;
  3113. fBitsPerPixel := 32;
  3114. fFormat := tfBGR10A2ui1;
  3115. fWithAlpha := tfBGR10A2ui1;
  3116. fWithoutAlpha := tfBGR10X2ui1;
  3117. fRGBInverted := tfRGB10A2ui1;
  3118. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3119. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3120. {$IFNDEF OPENGL_ES}
  3121. fOpenGLFormat := tfBGR10A2ui1;
  3122. fglFormat := GL_BGRA;
  3123. fglInternalFormat := GL_RGB10_A2;
  3124. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3125. {$ELSE}
  3126. fOpenGLFormat := tfA2RGB10ui1;
  3127. {$ENDIF}
  3128. end;
  3129. procedure TfdA2BGR10ui1.SetValues;
  3130. begin
  3131. inherited SetValues;
  3132. fBitsPerPixel := 32;
  3133. fFormat := tfA2BGR10ui1;
  3134. fWithAlpha := tfA2BGR10ui1;
  3135. fWithoutAlpha := tfX2BGR10ui1;
  3136. fRGBInverted := tfA2RGB10ui1;
  3137. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3138. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3139. {$IFNDEF OPENGL_ES}
  3140. fOpenGLFormat := tfA2BGR10ui1;
  3141. fglFormat := GL_RGBA;
  3142. fglInternalFormat := GL_RGB10_A2;
  3143. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3144. {$ELSE}
  3145. fOpenGLFormat := tfA2RGB10ui1;
  3146. {$ENDIF}
  3147. end;
  3148. procedure TfdBGRA16us4.SetValues;
  3149. begin
  3150. inherited SetValues;
  3151. fBitsPerPixel := 64;
  3152. fFormat := tfBGRA16us4;
  3153. fWithAlpha := tfBGRA16us4;
  3154. fWithoutAlpha := tfBGR16us3;
  3155. fRGBInverted := tfRGBA16us4;
  3156. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3157. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3158. {$IFNDEF OPENGL_ES}
  3159. fOpenGLFormat := tfBGRA16us4;
  3160. fglFormat := GL_BGRA;
  3161. fglInternalFormat := GL_RGBA16;
  3162. fglDataFormat := GL_UNSIGNED_SHORT;
  3163. {$ELSE}
  3164. fOpenGLFormat := tfRGBA16us4;
  3165. {$ENDIF}
  3166. end;
  3167. procedure TfdDepth16us1.SetValues;
  3168. begin
  3169. inherited SetValues;
  3170. fBitsPerPixel := 16;
  3171. fFormat := tfDepth16us1;
  3172. fWithoutAlpha := tfDepth16us1;
  3173. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3174. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3175. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3176. fOpenGLFormat := tfDepth16us1;
  3177. fglFormat := GL_DEPTH_COMPONENT;
  3178. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3179. fglDataFormat := GL_UNSIGNED_SHORT;
  3180. {$IFEND}
  3181. end;
  3182. procedure TfdDepth24ui1.SetValues;
  3183. begin
  3184. inherited SetValues;
  3185. fBitsPerPixel := 32;
  3186. fFormat := tfDepth24ui1;
  3187. fWithoutAlpha := tfDepth24ui1;
  3188. fOpenGLFormat := tfDepth24ui1;
  3189. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3190. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3191. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3192. fOpenGLFormat := tfDepth24ui1;
  3193. fglFormat := GL_DEPTH_COMPONENT;
  3194. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3195. fglDataFormat := GL_UNSIGNED_INT;
  3196. {$IFEND}
  3197. end;
  3198. procedure TfdDepth32ui1.SetValues;
  3199. begin
  3200. inherited SetValues;
  3201. fBitsPerPixel := 32;
  3202. fFormat := tfDepth32ui1;
  3203. fWithoutAlpha := tfDepth32ui1;
  3204. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3205. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3206. {$IF NOT DEFINED(OPENGL_ES)}
  3207. fOpenGLFormat := tfDepth32ui1;
  3208. fglFormat := GL_DEPTH_COMPONENT;
  3209. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3210. fglDataFormat := GL_UNSIGNED_INT;
  3211. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3212. fOpenGLFormat := tfDepth24ui1;
  3213. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3214. fOpenGLFormat := tfDepth16us1;
  3215. {$IFEND}
  3216. end;
  3217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3218. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3220. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3221. begin
  3222. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3223. end;
  3224. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3225. begin
  3226. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3227. end;
  3228. procedure TfdS3tcDtx1RGBA.SetValues;
  3229. begin
  3230. inherited SetValues;
  3231. fFormat := tfS3tcDtx1RGBA;
  3232. fWithAlpha := tfS3tcDtx1RGBA;
  3233. fUncompressed := tfRGB5A1us1;
  3234. fBitsPerPixel := 4;
  3235. fIsCompressed := true;
  3236. {$IFNDEF OPENGL_ES}
  3237. fOpenGLFormat := tfS3tcDtx1RGBA;
  3238. fglFormat := GL_COMPRESSED_RGBA;
  3239. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3240. fglDataFormat := GL_UNSIGNED_BYTE;
  3241. {$ELSE}
  3242. fOpenGLFormat := fUncompressed;
  3243. {$ENDIF}
  3244. end;
  3245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3246. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3249. begin
  3250. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3251. end;
  3252. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3253. begin
  3254. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3255. end;
  3256. procedure TfdS3tcDtx3RGBA.SetValues;
  3257. begin
  3258. inherited SetValues;
  3259. fFormat := tfS3tcDtx3RGBA;
  3260. fWithAlpha := tfS3tcDtx3RGBA;
  3261. fUncompressed := tfRGBA8ub4;
  3262. fBitsPerPixel := 8;
  3263. fIsCompressed := true;
  3264. {$IFNDEF OPENGL_ES}
  3265. fOpenGLFormat := tfS3tcDtx3RGBA;
  3266. fglFormat := GL_COMPRESSED_RGBA;
  3267. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3268. fglDataFormat := GL_UNSIGNED_BYTE;
  3269. {$ELSE}
  3270. fOpenGLFormat := fUncompressed;
  3271. {$ENDIF}
  3272. end;
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3276. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3277. begin
  3278. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3279. end;
  3280. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3281. begin
  3282. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3283. end;
  3284. procedure TfdS3tcDtx5RGBA.SetValues;
  3285. begin
  3286. inherited SetValues;
  3287. fFormat := tfS3tcDtx3RGBA;
  3288. fWithAlpha := tfS3tcDtx3RGBA;
  3289. fUncompressed := tfRGBA8ub4;
  3290. fBitsPerPixel := 8;
  3291. fIsCompressed := true;
  3292. {$IFNDEF OPENGL_ES}
  3293. fOpenGLFormat := tfS3tcDtx3RGBA;
  3294. fglFormat := GL_COMPRESSED_RGBA;
  3295. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3296. fglDataFormat := GL_UNSIGNED_BYTE;
  3297. {$ELSE}
  3298. fOpenGLFormat := fUncompressed;
  3299. {$ENDIF}
  3300. end;
  3301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3302. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3304. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3305. begin
  3306. result := (fPrecision.r > 0);
  3307. end;
  3308. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3309. begin
  3310. result := (fPrecision.g > 0);
  3311. end;
  3312. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3313. begin
  3314. result := (fPrecision.b > 0);
  3315. end;
  3316. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3317. begin
  3318. result := (fPrecision.a > 0);
  3319. end;
  3320. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3321. begin
  3322. result := HasRed or HasGreen or HasBlue;
  3323. end;
  3324. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3325. begin
  3326. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3327. end;
  3328. function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
  3329. begin
  3330. result := (OpenGLFormat = Format);
  3331. end;
  3332. procedure TglBitmapFormatDescriptor.SetValues;
  3333. begin
  3334. fFormat := tfEmpty;
  3335. fWithAlpha := tfEmpty;
  3336. fWithoutAlpha := tfEmpty;
  3337. fOpenGLFormat := tfEmpty;
  3338. fRGBInverted := tfEmpty;
  3339. fUncompressed := tfEmpty;
  3340. fBitsPerPixel := 0;
  3341. fIsCompressed := false;
  3342. fglFormat := 0;
  3343. fglInternalFormat := 0;
  3344. fglDataFormat := 0;
  3345. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3346. FillChar(fShift, 0, SizeOf(fShift));
  3347. end;
  3348. procedure TglBitmapFormatDescriptor.CalcValues;
  3349. var
  3350. i: Integer;
  3351. begin
  3352. fBytesPerPixel := fBitsPerPixel / 8;
  3353. fChannelCount := 0;
  3354. for i := 0 to 3 do begin
  3355. if (fPrecision.arr[i] > 0) then
  3356. inc(fChannelCount);
  3357. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3358. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3359. end;
  3360. end;
  3361. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3362. var
  3363. w, h: Integer;
  3364. begin
  3365. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3366. w := Max(1, aSize.X);
  3367. h := Max(1, aSize.Y);
  3368. result := GetSize(w, h);
  3369. end else
  3370. result := 0;
  3371. end;
  3372. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3373. begin
  3374. result := 0;
  3375. if (aWidth <= 0) or (aHeight <= 0) then
  3376. exit;
  3377. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3378. end;
  3379. constructor TglBitmapFormatDescriptor.Create;
  3380. begin
  3381. inherited Create;
  3382. SetValues;
  3383. CalcValues;
  3384. end;
  3385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3386. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3387. var
  3388. f: TglBitmapFormat;
  3389. begin
  3390. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3391. result := TFormatDescriptor.Get(f);
  3392. if (result.glInternalFormat = aInternalFormat) then
  3393. exit;
  3394. end;
  3395. result := TFormatDescriptor.Get(tfEmpty);
  3396. end;
  3397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3398. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3400. class procedure TFormatDescriptor.Init;
  3401. begin
  3402. if not Assigned(FormatDescriptorCS) then
  3403. FormatDescriptorCS := TCriticalSection.Create;
  3404. end;
  3405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3406. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3407. begin
  3408. FormatDescriptorCS.Enter;
  3409. try
  3410. result := FormatDescriptors[aFormat];
  3411. if not Assigned(result) then begin
  3412. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3413. FormatDescriptors[aFormat] := result;
  3414. end;
  3415. finally
  3416. FormatDescriptorCS.Leave;
  3417. end;
  3418. end;
  3419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3420. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3421. begin
  3422. result := Get(Get(aFormat).WithAlpha);
  3423. end;
  3424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3425. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3426. var
  3427. ft: TglBitmapFormat;
  3428. begin
  3429. // find matching format with OpenGL support
  3430. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3431. result := Get(ft);
  3432. if (result.MaskMatch(aMask)) and
  3433. (result.glFormat <> 0) and
  3434. (result.glInternalFormat <> 0) and
  3435. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3436. then
  3437. exit;
  3438. end;
  3439. // find matching format without OpenGL Support
  3440. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3441. result := Get(ft);
  3442. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3443. exit;
  3444. end;
  3445. result := TFormatDescriptor.Get(tfEmpty);
  3446. end;
  3447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3448. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3449. var
  3450. ft: TglBitmapFormat;
  3451. begin
  3452. // find matching format with OpenGL support
  3453. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3454. result := Get(ft);
  3455. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3456. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3457. (result.glFormat <> 0) and
  3458. (result.glInternalFormat <> 0) and
  3459. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3460. then
  3461. exit;
  3462. end;
  3463. // find matching format without OpenGL Support
  3464. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3465. result := Get(ft);
  3466. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3467. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3468. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3469. exit;
  3470. end;
  3471. result := TFormatDescriptor.Get(tfEmpty);
  3472. end;
  3473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3474. class procedure TFormatDescriptor.Clear;
  3475. var
  3476. f: TglBitmapFormat;
  3477. begin
  3478. FormatDescriptorCS.Enter;
  3479. try
  3480. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3481. FreeAndNil(FormatDescriptors[f]);
  3482. finally
  3483. FormatDescriptorCS.Leave;
  3484. end;
  3485. end;
  3486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3487. class procedure TFormatDescriptor.Finalize;
  3488. begin
  3489. Clear;
  3490. FreeAndNil(FormatDescriptorCS);
  3491. end;
  3492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3493. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3496. var
  3497. i: Integer;
  3498. begin
  3499. for i := 0 to 3 do begin
  3500. fShift.arr[i] := 0;
  3501. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3502. aMask.arr[i] := aMask.arr[i] shr 1;
  3503. inc(fShift.arr[i]);
  3504. end;
  3505. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3506. end;
  3507. fBitsPerPixel := aBPP;
  3508. CalcValues;
  3509. end;
  3510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3511. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3512. begin
  3513. fBitsPerPixel := aBBP;
  3514. fPrecision := aPrec;
  3515. fShift := aShift;
  3516. CalcValues;
  3517. end;
  3518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3520. var
  3521. data: QWord;
  3522. begin
  3523. data :=
  3524. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3525. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3526. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3527. ((aPixel.Data.a and Range.a) shl Shift.a);
  3528. case BitsPerPixel of
  3529. 8: aData^ := data;
  3530. 16: PWord(aData)^ := data;
  3531. 32: PCardinal(aData)^ := data;
  3532. 64: PQWord(aData)^ := data;
  3533. else
  3534. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3535. end;
  3536. inc(aData, Round(BytesPerPixel));
  3537. end;
  3538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3539. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3540. var
  3541. data: QWord;
  3542. i: Integer;
  3543. begin
  3544. case BitsPerPixel of
  3545. 8: data := aData^;
  3546. 16: data := PWord(aData)^;
  3547. 32: data := PCardinal(aData)^;
  3548. 64: data := PQWord(aData)^;
  3549. else
  3550. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3551. end;
  3552. for i := 0 to 3 do
  3553. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3554. inc(aData, Round(BytesPerPixel));
  3555. end;
  3556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3557. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. procedure TbmpColorTableFormat.SetValues;
  3560. begin
  3561. inherited SetValues;
  3562. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3563. end;
  3564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3566. begin
  3567. fFormat := aFormat;
  3568. fBitsPerPixel := aBPP;
  3569. fPrecision := aPrec;
  3570. fShift := aShift;
  3571. CalcValues;
  3572. end;
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. procedure TbmpColorTableFormat.CalcValues;
  3575. begin
  3576. inherited CalcValues;
  3577. end;
  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3579. procedure TbmpColorTableFormat.CreateColorTable;
  3580. var
  3581. i: Integer;
  3582. begin
  3583. SetLength(fColorTable, 256);
  3584. if not HasColor then begin
  3585. // alpha
  3586. for i := 0 to High(fColorTable) do begin
  3587. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3588. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3589. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3590. fColorTable[i].a := 0;
  3591. end;
  3592. end else begin
  3593. // normal
  3594. for i := 0 to High(fColorTable) do begin
  3595. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3596. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3597. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3598. fColorTable[i].a := 0;
  3599. end;
  3600. end;
  3601. end;
  3602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3603. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3604. begin
  3605. result := Pointer(0);
  3606. end;
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3609. begin
  3610. if (BitsPerPixel <> 8) then
  3611. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3612. if not HasColor then
  3613. // alpha
  3614. aData^ := aPixel.Data.a
  3615. else
  3616. // normal
  3617. aData^ := Round(
  3618. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3619. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3620. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3621. inc(aData);
  3622. end;
  3623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3624. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3625. function ReadValue: Byte;
  3626. var
  3627. i: PtrUInt;
  3628. begin
  3629. if (BitsPerPixel = 8) then begin
  3630. result := aData^;
  3631. inc(aData);
  3632. end else begin
  3633. i := {%H-}PtrUInt(aMapData);
  3634. if (BitsPerPixel > 1) then
  3635. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3636. else
  3637. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3638. inc(i, BitsPerPixel);
  3639. while (i >= 8) do begin
  3640. inc(aData);
  3641. dec(i, 8);
  3642. end;
  3643. aMapData := {%H-}Pointer(i);
  3644. end;
  3645. end;
  3646. begin
  3647. if (BitsPerPixel > 8) then
  3648. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3649. with fColorTable[ReadValue] do begin
  3650. aPixel.Data.r := r;
  3651. aPixel.Data.g := g;
  3652. aPixel.Data.b := b;
  3653. aPixel.Data.a := a;
  3654. end;
  3655. end;
  3656. destructor TbmpColorTableFormat.Destroy;
  3657. begin
  3658. SetLength(fColorTable, 0);
  3659. inherited Destroy;
  3660. end;
  3661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3665. var
  3666. i: Integer;
  3667. begin
  3668. for i := 0 to 3 do begin
  3669. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3670. if (aSourceFD.Range.arr[i] > 0) then
  3671. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3672. else
  3673. aPixel.Data.arr[i] := 0;
  3674. end;
  3675. end;
  3676. end;
  3677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3678. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3679. begin
  3680. with aFuncRec do begin
  3681. if (Source.Range.r > 0) then
  3682. Dest.Data.r := Source.Data.r;
  3683. if (Source.Range.g > 0) then
  3684. Dest.Data.g := Source.Data.g;
  3685. if (Source.Range.b > 0) then
  3686. Dest.Data.b := Source.Data.b;
  3687. if (Source.Range.a > 0) then
  3688. Dest.Data.a := Source.Data.a;
  3689. end;
  3690. end;
  3691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3692. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3693. var
  3694. i: Integer;
  3695. begin
  3696. with aFuncRec do begin
  3697. for i := 0 to 3 do
  3698. if (Source.Range.arr[i] > 0) then
  3699. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3700. end;
  3701. end;
  3702. type
  3703. TShiftData = packed record
  3704. case Integer of
  3705. 0: (r, g, b, a: SmallInt);
  3706. 1: (arr: array[0..3] of SmallInt);
  3707. end;
  3708. PShiftData = ^TShiftData;
  3709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3710. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3711. var
  3712. i: Integer;
  3713. begin
  3714. with aFuncRec do
  3715. for i := 0 to 3 do
  3716. if (Source.Range.arr[i] > 0) then
  3717. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3718. end;
  3719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3720. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3721. var
  3722. i: Integer;
  3723. begin
  3724. with aFuncRec do begin
  3725. Dest.Data := Source.Data;
  3726. for i := 0 to 3 do
  3727. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3728. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3729. end;
  3730. end;
  3731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3732. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3733. var
  3734. i: Integer;
  3735. begin
  3736. with aFuncRec do begin
  3737. for i := 0 to 3 do
  3738. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3739. end;
  3740. end;
  3741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3742. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3743. var
  3744. Temp: Single;
  3745. begin
  3746. with FuncRec do begin
  3747. if (FuncRec.Args = nil) then begin //source has no alpha
  3748. Temp :=
  3749. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3750. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3751. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3752. Dest.Data.a := Round(Dest.Range.a * Temp);
  3753. end else
  3754. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3755. end;
  3756. end;
  3757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3758. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3759. type
  3760. PglBitmapPixelData = ^TglBitmapPixelData;
  3761. begin
  3762. with FuncRec do begin
  3763. Dest.Data.r := Source.Data.r;
  3764. Dest.Data.g := Source.Data.g;
  3765. Dest.Data.b := Source.Data.b;
  3766. with PglBitmapPixelData(Args)^ do
  3767. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3768. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3769. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3770. Dest.Data.a := 0
  3771. else
  3772. Dest.Data.a := Dest.Range.a;
  3773. end;
  3774. end;
  3775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3776. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3777. begin
  3778. with FuncRec do begin
  3779. Dest.Data.r := Source.Data.r;
  3780. Dest.Data.g := Source.Data.g;
  3781. Dest.Data.b := Source.Data.b;
  3782. Dest.Data.a := PCardinal(Args)^;
  3783. end;
  3784. end;
  3785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3786. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3787. type
  3788. PRGBPix = ^TRGBPix;
  3789. TRGBPix = array [0..2] of byte;
  3790. var
  3791. Temp: Byte;
  3792. begin
  3793. while aWidth > 0 do begin
  3794. Temp := PRGBPix(aData)^[0];
  3795. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3796. PRGBPix(aData)^[2] := Temp;
  3797. if aHasAlpha then
  3798. Inc(aData, 4)
  3799. else
  3800. Inc(aData, 3);
  3801. dec(aWidth);
  3802. end;
  3803. end;
  3804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3805. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3807. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3808. begin
  3809. result := TFormatDescriptor.Get(fFormat);
  3810. end;
  3811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3812. function TglBitmapData.GetWidth: Integer;
  3813. begin
  3814. if (ffX in fDimension.Fields) then
  3815. result := fDimension.X
  3816. else
  3817. result := -1;
  3818. end;
  3819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3820. function TglBitmapData.GetHeight: Integer;
  3821. begin
  3822. if (ffY in fDimension.Fields) then
  3823. result := fDimension.Y
  3824. else
  3825. result := -1;
  3826. end;
  3827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3828. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3829. begin
  3830. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3831. result := fScanlines[aIndex]
  3832. else
  3833. result := nil;
  3834. end;
  3835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3836. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3837. begin
  3838. if fFormat = aValue then
  3839. exit;
  3840. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3841. raise EglBitmapUnsupportedFormat.Create(Format);
  3842. SetData(fData, aValue, Width, Height);
  3843. end;
  3844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3845. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3846. var
  3847. TempPos: Integer;
  3848. begin
  3849. if not Assigned(aResType) then begin
  3850. TempPos := Pos('.', aResource);
  3851. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3852. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3853. end;
  3854. end;
  3855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3856. procedure TglBitmapData.UpdateScanlines;
  3857. var
  3858. w, h, i, LineWidth: Integer;
  3859. begin
  3860. w := Width;
  3861. h := Height;
  3862. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3863. if fHasScanlines then begin
  3864. SetLength(fScanlines, h);
  3865. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3866. for i := 0 to h-1 do begin
  3867. fScanlines[i] := fData;
  3868. Inc(fScanlines[i], i * LineWidth);
  3869. end;
  3870. end else
  3871. SetLength(fScanlines, 0);
  3872. end;
  3873. {$IFDEF GLB_SUPPORT_PNG_READ}
  3874. {$IF DEFINED(GLB_LAZ_PNG)}
  3875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3876. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3878. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3879. const
  3880. MAGIC_LEN = 8;
  3881. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3882. var
  3883. reader: TLazReaderPNG;
  3884. intf: TLazIntfImage;
  3885. StreamPos: Int64;
  3886. magic: String[MAGIC_LEN];
  3887. begin
  3888. result := true;
  3889. StreamPos := aStream.Position;
  3890. SetLength(magic, MAGIC_LEN);
  3891. aStream.Read(magic[1], MAGIC_LEN);
  3892. aStream.Position := StreamPos;
  3893. if (magic <> PNG_MAGIC) then begin
  3894. result := false;
  3895. exit;
  3896. end;
  3897. intf := TLazIntfImage.Create(0, 0);
  3898. reader := TLazReaderPNG.Create;
  3899. try try
  3900. reader.UpdateDescription := true;
  3901. reader.ImageRead(aStream, intf);
  3902. AssignFromLazIntfImage(intf);
  3903. except
  3904. result := false;
  3905. aStream.Position := StreamPos;
  3906. exit;
  3907. end;
  3908. finally
  3909. reader.Free;
  3910. intf.Free;
  3911. end;
  3912. end;
  3913. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3915. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3916. var
  3917. Surface: PSDL_Surface;
  3918. RWops: PSDL_RWops;
  3919. begin
  3920. result := false;
  3921. RWops := glBitmapCreateRWops(aStream);
  3922. try
  3923. if IMG_isPNG(RWops) > 0 then begin
  3924. Surface := IMG_LoadPNG_RW(RWops);
  3925. try
  3926. AssignFromSurface(Surface);
  3927. result := true;
  3928. finally
  3929. SDL_FreeSurface(Surface);
  3930. end;
  3931. end;
  3932. finally
  3933. SDL_FreeRW(RWops);
  3934. end;
  3935. end;
  3936. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3938. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3939. begin
  3940. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3941. end;
  3942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3943. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3944. var
  3945. StreamPos: Int64;
  3946. signature: array [0..7] of byte;
  3947. png: png_structp;
  3948. png_info: png_infop;
  3949. TempHeight, TempWidth: Integer;
  3950. Format: TglBitmapFormat;
  3951. png_data: pByte;
  3952. png_rows: array of pByte;
  3953. Row, LineSize: Integer;
  3954. begin
  3955. result := false;
  3956. if not init_libPNG then
  3957. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3958. try
  3959. // signature
  3960. StreamPos := aStream.Position;
  3961. aStream.Read(signature{%H-}, 8);
  3962. aStream.Position := StreamPos;
  3963. if png_check_sig(@signature, 8) <> 0 then begin
  3964. // png read struct
  3965. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3966. if png = nil then
  3967. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3968. // png info
  3969. png_info := png_create_info_struct(png);
  3970. if png_info = nil then begin
  3971. png_destroy_read_struct(@png, nil, nil);
  3972. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3973. end;
  3974. // set read callback
  3975. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  3976. // read informations
  3977. png_read_info(png, png_info);
  3978. // size
  3979. TempHeight := png_get_image_height(png, png_info);
  3980. TempWidth := png_get_image_width(png, png_info);
  3981. // format
  3982. case png_get_color_type(png, png_info) of
  3983. PNG_COLOR_TYPE_GRAY:
  3984. Format := tfLuminance8ub1;
  3985. PNG_COLOR_TYPE_GRAY_ALPHA:
  3986. Format := tfLuminance8Alpha8us1;
  3987. PNG_COLOR_TYPE_RGB:
  3988. Format := tfRGB8ub3;
  3989. PNG_COLOR_TYPE_RGB_ALPHA:
  3990. Format := tfRGBA8ub4;
  3991. else
  3992. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3993. end;
  3994. // cut upper 8 bit from 16 bit formats
  3995. if png_get_bit_depth(png, png_info) > 8 then
  3996. png_set_strip_16(png);
  3997. // expand bitdepth smaller than 8
  3998. if png_get_bit_depth(png, png_info) < 8 then
  3999. png_set_expand(png);
  4000. // allocating mem for scanlines
  4001. LineSize := png_get_rowbytes(png, png_info);
  4002. GetMem(png_data, TempHeight * LineSize);
  4003. try
  4004. SetLength(png_rows, TempHeight);
  4005. for Row := Low(png_rows) to High(png_rows) do begin
  4006. png_rows[Row] := png_data;
  4007. Inc(png_rows[Row], Row * LineSize);
  4008. end;
  4009. // read complete image into scanlines
  4010. png_read_image(png, @png_rows[0]);
  4011. // read end
  4012. png_read_end(png, png_info);
  4013. // destroy read struct
  4014. png_destroy_read_struct(@png, @png_info, nil);
  4015. SetLength(png_rows, 0);
  4016. // set new data
  4017. SetData(png_data, Format, TempWidth, TempHeight);
  4018. result := true;
  4019. except
  4020. if Assigned(png_data) then
  4021. FreeMem(png_data);
  4022. raise;
  4023. end;
  4024. end;
  4025. finally
  4026. quit_libPNG;
  4027. end;
  4028. end;
  4029. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4031. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4032. var
  4033. StreamPos: Int64;
  4034. Png: TPNGObject;
  4035. Header: String[8];
  4036. Row, Col, PixSize, LineSize: Integer;
  4037. NewImage, pSource, pDest, pAlpha: pByte;
  4038. PngFormat: TglBitmapFormat;
  4039. FormatDesc: TFormatDescriptor;
  4040. const
  4041. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4042. begin
  4043. result := false;
  4044. StreamPos := aStream.Position;
  4045. aStream.Read(Header[0], SizeOf(Header));
  4046. aStream.Position := StreamPos;
  4047. {Test if the header matches}
  4048. if Header = PngHeader then begin
  4049. Png := TPNGObject.Create;
  4050. try
  4051. Png.LoadFromStream(aStream);
  4052. case Png.Header.ColorType of
  4053. COLOR_GRAYSCALE:
  4054. PngFormat := tfLuminance8ub1;
  4055. COLOR_GRAYSCALEALPHA:
  4056. PngFormat := tfLuminance8Alpha8us1;
  4057. COLOR_RGB:
  4058. PngFormat := tfBGR8ub3;
  4059. COLOR_RGBALPHA:
  4060. PngFormat := tfBGRA8ub4;
  4061. else
  4062. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4063. end;
  4064. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4065. PixSize := Round(FormatDesc.PixelSize);
  4066. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4067. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4068. try
  4069. pDest := NewImage;
  4070. case Png.Header.ColorType of
  4071. COLOR_RGB, COLOR_GRAYSCALE:
  4072. begin
  4073. for Row := 0 to Png.Height -1 do begin
  4074. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4075. Inc(pDest, LineSize);
  4076. end;
  4077. end;
  4078. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4079. begin
  4080. PixSize := PixSize -1;
  4081. for Row := 0 to Png.Height -1 do begin
  4082. pSource := Png.Scanline[Row];
  4083. pAlpha := pByte(Png.AlphaScanline[Row]);
  4084. for Col := 0 to Png.Width -1 do begin
  4085. Move (pSource^, pDest^, PixSize);
  4086. Inc(pSource, PixSize);
  4087. Inc(pDest, PixSize);
  4088. pDest^ := pAlpha^;
  4089. inc(pAlpha);
  4090. Inc(pDest);
  4091. end;
  4092. end;
  4093. end;
  4094. else
  4095. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4096. end;
  4097. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4098. result := true;
  4099. except
  4100. if Assigned(NewImage) then
  4101. FreeMem(NewImage);
  4102. raise;
  4103. end;
  4104. finally
  4105. Png.Free;
  4106. end;
  4107. end;
  4108. end;
  4109. {$IFEND}
  4110. {$ENDIF}
  4111. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4112. {$IFDEF GLB_LIB_PNG}
  4113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4114. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4115. begin
  4116. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4117. end;
  4118. {$ENDIF}
  4119. {$IF DEFINED(GLB_LAZ_PNG)}
  4120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4121. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4122. var
  4123. png: TPortableNetworkGraphic;
  4124. intf: TLazIntfImage;
  4125. raw: TRawImage;
  4126. begin
  4127. png := TPortableNetworkGraphic.Create;
  4128. intf := TLazIntfImage.Create(0, 0);
  4129. try
  4130. if not AssignToLazIntfImage(intf) then
  4131. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4132. intf.GetRawImage(raw);
  4133. png.LoadFromRawImage(raw, false);
  4134. png.SaveToStream(aStream);
  4135. finally
  4136. png.Free;
  4137. intf.Free;
  4138. end;
  4139. end;
  4140. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4142. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4143. var
  4144. png: png_structp;
  4145. png_info: png_infop;
  4146. png_rows: array of pByte;
  4147. LineSize: Integer;
  4148. ColorType: Integer;
  4149. Row: Integer;
  4150. FormatDesc: TFormatDescriptor;
  4151. begin
  4152. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4153. raise EglBitmapUnsupportedFormat.Create(Format);
  4154. if not init_libPNG then
  4155. raise Exception.Create('unable to initialize libPNG.');
  4156. try
  4157. case Format of
  4158. tfAlpha8ub1, tfLuminance8ub1:
  4159. ColorType := PNG_COLOR_TYPE_GRAY;
  4160. tfLuminance8Alpha8us1:
  4161. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4162. tfBGR8ub3, tfRGB8ub3:
  4163. ColorType := PNG_COLOR_TYPE_RGB;
  4164. tfBGRA8ub4, tfRGBA8ub4:
  4165. ColorType := PNG_COLOR_TYPE_RGBA;
  4166. else
  4167. raise EglBitmapUnsupportedFormat.Create(Format);
  4168. end;
  4169. FormatDesc := TFormatDescriptor.Get(Format);
  4170. LineSize := FormatDesc.GetSize(Width, 1);
  4171. // creating array for scanline
  4172. SetLength(png_rows, Height);
  4173. try
  4174. for Row := 0 to Height - 1 do begin
  4175. png_rows[Row] := Data;
  4176. Inc(png_rows[Row], Row * LineSize)
  4177. end;
  4178. // write struct
  4179. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4180. if png = nil then
  4181. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4182. // create png info
  4183. png_info := png_create_info_struct(png);
  4184. if png_info = nil then begin
  4185. png_destroy_write_struct(@png, nil);
  4186. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4187. end;
  4188. // set read callback
  4189. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4190. // set compression
  4191. png_set_compression_level(png, 6);
  4192. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4193. png_set_bgr(png);
  4194. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4195. png_write_info(png, png_info);
  4196. png_write_image(png, @png_rows[0]);
  4197. png_write_end(png, png_info);
  4198. png_destroy_write_struct(@png, @png_info);
  4199. finally
  4200. SetLength(png_rows, 0);
  4201. end;
  4202. finally
  4203. quit_libPNG;
  4204. end;
  4205. end;
  4206. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4208. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4209. var
  4210. Png: TPNGObject;
  4211. pSource, pDest: pByte;
  4212. X, Y, PixSize: Integer;
  4213. ColorType: Cardinal;
  4214. Alpha: Boolean;
  4215. pTemp: pByte;
  4216. Temp: Byte;
  4217. begin
  4218. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4219. raise EglBitmapUnsupportedFormat.Create(Format);
  4220. case Format of
  4221. tfAlpha8ub1, tfLuminance8ub1: begin
  4222. ColorType := COLOR_GRAYSCALE;
  4223. PixSize := 1;
  4224. Alpha := false;
  4225. end;
  4226. tfLuminance8Alpha8us1: begin
  4227. ColorType := COLOR_GRAYSCALEALPHA;
  4228. PixSize := 1;
  4229. Alpha := true;
  4230. end;
  4231. tfBGR8ub3, tfRGB8ub3: begin
  4232. ColorType := COLOR_RGB;
  4233. PixSize := 3;
  4234. Alpha := false;
  4235. end;
  4236. tfBGRA8ub4, tfRGBA8ub4: begin
  4237. ColorType := COLOR_RGBALPHA;
  4238. PixSize := 3;
  4239. Alpha := true
  4240. end;
  4241. else
  4242. raise EglBitmapUnsupportedFormat.Create(Format);
  4243. end;
  4244. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4245. try
  4246. // Copy ImageData
  4247. pSource := Data;
  4248. for Y := 0 to Height -1 do begin
  4249. pDest := png.ScanLine[Y];
  4250. for X := 0 to Width -1 do begin
  4251. Move(pSource^, pDest^, PixSize);
  4252. Inc(pDest, PixSize);
  4253. Inc(pSource, PixSize);
  4254. if Alpha then begin
  4255. png.AlphaScanline[Y]^[X] := pSource^;
  4256. Inc(pSource);
  4257. end;
  4258. end;
  4259. // convert RGB line to BGR
  4260. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4261. pTemp := png.ScanLine[Y];
  4262. for X := 0 to Width -1 do begin
  4263. Temp := pByteArray(pTemp)^[0];
  4264. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4265. pByteArray(pTemp)^[2] := Temp;
  4266. Inc(pTemp, 3);
  4267. end;
  4268. end;
  4269. end;
  4270. // Save to Stream
  4271. Png.CompressionLevel := 6;
  4272. Png.SaveToStream(aStream);
  4273. finally
  4274. FreeAndNil(Png);
  4275. end;
  4276. end;
  4277. {$IFEND}
  4278. {$ENDIF}
  4279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4280. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4282. {$IFDEF GLB_LIB_JPEG}
  4283. type
  4284. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4285. glBitmap_libJPEG_source_mgr = record
  4286. pub: jpeg_source_mgr;
  4287. SrcStream: TStream;
  4288. SrcBuffer: array [1..4096] of byte;
  4289. end;
  4290. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4291. glBitmap_libJPEG_dest_mgr = record
  4292. pub: jpeg_destination_mgr;
  4293. DestStream: TStream;
  4294. DestBuffer: array [1..4096] of byte;
  4295. end;
  4296. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4297. begin
  4298. //DUMMY
  4299. end;
  4300. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4301. begin
  4302. //DUMMY
  4303. end;
  4304. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4305. begin
  4306. //DUMMY
  4307. end;
  4308. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4309. begin
  4310. //DUMMY
  4311. end;
  4312. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4313. begin
  4314. //DUMMY
  4315. end;
  4316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4317. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4318. var
  4319. src: glBitmap_libJPEG_source_mgr_ptr;
  4320. bytes: integer;
  4321. begin
  4322. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4323. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4324. if (bytes <= 0) then begin
  4325. src^.SrcBuffer[1] := $FF;
  4326. src^.SrcBuffer[2] := JPEG_EOI;
  4327. bytes := 2;
  4328. end;
  4329. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4330. src^.pub.bytes_in_buffer := bytes;
  4331. result := true;
  4332. end;
  4333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4334. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4335. var
  4336. src: glBitmap_libJPEG_source_mgr_ptr;
  4337. begin
  4338. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4339. if num_bytes > 0 then begin
  4340. // wanted byte isn't in buffer so set stream position and read buffer
  4341. if num_bytes > src^.pub.bytes_in_buffer then begin
  4342. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4343. src^.pub.fill_input_buffer(cinfo);
  4344. end else begin
  4345. // wanted byte is in buffer so only skip
  4346. inc(src^.pub.next_input_byte, num_bytes);
  4347. dec(src^.pub.bytes_in_buffer, num_bytes);
  4348. end;
  4349. end;
  4350. end;
  4351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4352. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4353. var
  4354. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4355. begin
  4356. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4357. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4358. // write complete buffer
  4359. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4360. // reset buffer
  4361. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4362. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4363. end;
  4364. result := true;
  4365. end;
  4366. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4367. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4368. var
  4369. Idx: Integer;
  4370. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4371. begin
  4372. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4373. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4374. // check for endblock
  4375. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4376. // write endblock
  4377. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4378. // leave
  4379. break;
  4380. end else
  4381. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4382. end;
  4383. end;
  4384. {$ENDIF}
  4385. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4386. {$IF DEFINED(GLB_LAZ_JPEG)}
  4387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4388. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4389. const
  4390. MAGIC_LEN = 2;
  4391. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4392. var
  4393. intf: TLazIntfImage;
  4394. reader: TFPReaderJPEG;
  4395. StreamPos: Int64;
  4396. magic: String[MAGIC_LEN];
  4397. begin
  4398. result := true;
  4399. StreamPos := aStream.Position;
  4400. SetLength(magic, MAGIC_LEN);
  4401. aStream.Read(magic[1], MAGIC_LEN);
  4402. aStream.Position := StreamPos;
  4403. if (magic <> JPEG_MAGIC) then begin
  4404. result := false;
  4405. exit;
  4406. end;
  4407. reader := TFPReaderJPEG.Create;
  4408. intf := TLazIntfImage.Create(0, 0);
  4409. try try
  4410. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4411. reader.ImageRead(aStream, intf);
  4412. AssignFromLazIntfImage(intf);
  4413. except
  4414. result := false;
  4415. aStream.Position := StreamPos;
  4416. exit;
  4417. end;
  4418. finally
  4419. reader.Free;
  4420. intf.Free;
  4421. end;
  4422. end;
  4423. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4425. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4426. var
  4427. Surface: PSDL_Surface;
  4428. RWops: PSDL_RWops;
  4429. begin
  4430. result := false;
  4431. RWops := glBitmapCreateRWops(aStream);
  4432. try
  4433. if IMG_isJPG(RWops) > 0 then begin
  4434. Surface := IMG_LoadJPG_RW(RWops);
  4435. try
  4436. AssignFromSurface(Surface);
  4437. result := true;
  4438. finally
  4439. SDL_FreeSurface(Surface);
  4440. end;
  4441. end;
  4442. finally
  4443. SDL_FreeRW(RWops);
  4444. end;
  4445. end;
  4446. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4448. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4449. var
  4450. StreamPos: Int64;
  4451. Temp: array[0..1]of Byte;
  4452. jpeg: jpeg_decompress_struct;
  4453. jpeg_err: jpeg_error_mgr;
  4454. IntFormat: TglBitmapFormat;
  4455. pImage: pByte;
  4456. TempHeight, TempWidth: Integer;
  4457. pTemp: pByte;
  4458. Row: Integer;
  4459. FormatDesc: TFormatDescriptor;
  4460. begin
  4461. result := false;
  4462. if not init_libJPEG then
  4463. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4464. try
  4465. // reading first two bytes to test file and set cursor back to begin
  4466. StreamPos := aStream.Position;
  4467. aStream.Read({%H-}Temp[0], 2);
  4468. aStream.Position := StreamPos;
  4469. // if Bitmap then read file.
  4470. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4471. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4472. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4473. // error managment
  4474. jpeg.err := jpeg_std_error(@jpeg_err);
  4475. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4476. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4477. // decompression struct
  4478. jpeg_create_decompress(@jpeg);
  4479. // allocation space for streaming methods
  4480. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4481. // seeting up custom functions
  4482. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4483. pub.init_source := glBitmap_libJPEG_init_source;
  4484. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4485. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4486. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4487. pub.term_source := glBitmap_libJPEG_term_source;
  4488. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4489. pub.next_input_byte := nil; // until buffer loaded
  4490. SrcStream := aStream;
  4491. end;
  4492. // set global decoding state
  4493. jpeg.global_state := DSTATE_START;
  4494. // read header of jpeg
  4495. jpeg_read_header(@jpeg, false);
  4496. // setting output parameter
  4497. case jpeg.jpeg_color_space of
  4498. JCS_GRAYSCALE:
  4499. begin
  4500. jpeg.out_color_space := JCS_GRAYSCALE;
  4501. IntFormat := tfLuminance8ub1;
  4502. end;
  4503. else
  4504. jpeg.out_color_space := JCS_RGB;
  4505. IntFormat := tfRGB8ub3;
  4506. end;
  4507. // reading image
  4508. jpeg_start_decompress(@jpeg);
  4509. TempHeight := jpeg.output_height;
  4510. TempWidth := jpeg.output_width;
  4511. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4512. // creating new image
  4513. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4514. try
  4515. pTemp := pImage;
  4516. for Row := 0 to TempHeight -1 do begin
  4517. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4518. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4519. end;
  4520. // finish decompression
  4521. jpeg_finish_decompress(@jpeg);
  4522. // destroy decompression
  4523. jpeg_destroy_decompress(@jpeg);
  4524. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4525. result := true;
  4526. except
  4527. if Assigned(pImage) then
  4528. FreeMem(pImage);
  4529. raise;
  4530. end;
  4531. end;
  4532. finally
  4533. quit_libJPEG;
  4534. end;
  4535. end;
  4536. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4538. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4539. var
  4540. bmp: TBitmap;
  4541. jpg: TJPEGImage;
  4542. StreamPos: Int64;
  4543. Temp: array[0..1]of Byte;
  4544. begin
  4545. result := false;
  4546. // reading first two bytes to test file and set cursor back to begin
  4547. StreamPos := aStream.Position;
  4548. aStream.Read(Temp[0], 2);
  4549. aStream.Position := StreamPos;
  4550. // if Bitmap then read file.
  4551. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4552. bmp := TBitmap.Create;
  4553. try
  4554. jpg := TJPEGImage.Create;
  4555. try
  4556. jpg.LoadFromStream(aStream);
  4557. bmp.Assign(jpg);
  4558. result := AssignFromBitmap(bmp);
  4559. finally
  4560. jpg.Free;
  4561. end;
  4562. finally
  4563. bmp.Free;
  4564. end;
  4565. end;
  4566. end;
  4567. {$IFEND}
  4568. {$ENDIF}
  4569. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4570. {$IF DEFINED(GLB_LAZ_JPEG)}
  4571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4572. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4573. var
  4574. jpeg: TJPEGImage;
  4575. intf: TLazIntfImage;
  4576. raw: TRawImage;
  4577. begin
  4578. jpeg := TJPEGImage.Create;
  4579. intf := TLazIntfImage.Create(0, 0);
  4580. try
  4581. if not AssignToLazIntfImage(intf) then
  4582. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4583. intf.GetRawImage(raw);
  4584. jpeg.LoadFromRawImage(raw, false);
  4585. jpeg.SaveToStream(aStream);
  4586. finally
  4587. intf.Free;
  4588. jpeg.Free;
  4589. end;
  4590. end;
  4591. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4593. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4594. var
  4595. jpeg: jpeg_compress_struct;
  4596. jpeg_err: jpeg_error_mgr;
  4597. Row: Integer;
  4598. pTemp, pTemp2: pByte;
  4599. procedure CopyRow(pDest, pSource: pByte);
  4600. var
  4601. X: Integer;
  4602. begin
  4603. for X := 0 to Width - 1 do begin
  4604. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4605. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4606. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4607. Inc(pDest, 3);
  4608. Inc(pSource, 3);
  4609. end;
  4610. end;
  4611. begin
  4612. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4613. raise EglBitmapUnsupportedFormat.Create(Format);
  4614. if not init_libJPEG then
  4615. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4616. try
  4617. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4618. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4619. // error managment
  4620. jpeg.err := jpeg_std_error(@jpeg_err);
  4621. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4622. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4623. // compression struct
  4624. jpeg_create_compress(@jpeg);
  4625. // allocation space for streaming methods
  4626. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4627. // seeting up custom functions
  4628. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4629. pub.init_destination := glBitmap_libJPEG_init_destination;
  4630. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4631. pub.term_destination := glBitmap_libJPEG_term_destination;
  4632. pub.next_output_byte := @DestBuffer[1];
  4633. pub.free_in_buffer := Length(DestBuffer);
  4634. DestStream := aStream;
  4635. end;
  4636. // very important state
  4637. jpeg.global_state := CSTATE_START;
  4638. jpeg.image_width := Width;
  4639. jpeg.image_height := Height;
  4640. case Format of
  4641. tfAlpha8ub1, tfLuminance8ub1: begin
  4642. jpeg.input_components := 1;
  4643. jpeg.in_color_space := JCS_GRAYSCALE;
  4644. end;
  4645. tfRGB8ub3, tfBGR8ub3: begin
  4646. jpeg.input_components := 3;
  4647. jpeg.in_color_space := JCS_RGB;
  4648. end;
  4649. end;
  4650. jpeg_set_defaults(@jpeg);
  4651. jpeg_set_quality(@jpeg, 95, true);
  4652. jpeg_start_compress(@jpeg, true);
  4653. pTemp := Data;
  4654. if Format = tfBGR8ub3 then
  4655. GetMem(pTemp2, fRowSize)
  4656. else
  4657. pTemp2 := pTemp;
  4658. try
  4659. for Row := 0 to jpeg.image_height -1 do begin
  4660. // prepare row
  4661. if Format = tfBGR8ub3 then
  4662. CopyRow(pTemp2, pTemp)
  4663. else
  4664. pTemp2 := pTemp;
  4665. // write row
  4666. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4667. inc(pTemp, fRowSize);
  4668. end;
  4669. finally
  4670. // free memory
  4671. if Format = tfBGR8ub3 then
  4672. FreeMem(pTemp2);
  4673. end;
  4674. jpeg_finish_compress(@jpeg);
  4675. jpeg_destroy_compress(@jpeg);
  4676. finally
  4677. quit_libJPEG;
  4678. end;
  4679. end;
  4680. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4682. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4683. var
  4684. Bmp: TBitmap;
  4685. Jpg: TJPEGImage;
  4686. begin
  4687. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4688. raise EglBitmapUnsupportedFormat.Create(Format);
  4689. Bmp := TBitmap.Create;
  4690. try
  4691. Jpg := TJPEGImage.Create;
  4692. try
  4693. AssignToBitmap(Bmp);
  4694. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4695. Jpg.Grayscale := true;
  4696. Jpg.PixelFormat := jf8Bit;
  4697. end;
  4698. Jpg.Assign(Bmp);
  4699. Jpg.SaveToStream(aStream);
  4700. finally
  4701. FreeAndNil(Jpg);
  4702. end;
  4703. finally
  4704. FreeAndNil(Bmp);
  4705. end;
  4706. end;
  4707. {$IFEND}
  4708. {$ENDIF}
  4709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4710. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4712. type
  4713. RawHeader = packed record
  4714. Magic: String[5];
  4715. Version: Byte;
  4716. Width: Integer;
  4717. Height: Integer;
  4718. DataSize: Integer;
  4719. BitsPerPixel: Integer;
  4720. Precision: TglBitmapRec4ub;
  4721. Shift: TglBitmapRec4ub;
  4722. end;
  4723. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4724. var
  4725. header: RawHeader;
  4726. StartPos: Int64;
  4727. fd: TFormatDescriptor;
  4728. buf: PByte;
  4729. begin
  4730. result := false;
  4731. StartPos := aStream.Position;
  4732. aStream.Read(header{%H-}, SizeOf(header));
  4733. if (header.Magic <> 'glBMP') then begin
  4734. aStream.Position := StartPos;
  4735. exit;
  4736. end;
  4737. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4738. if (fd.Format = tfEmpty) then
  4739. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4740. buf := GetMemory(header.DataSize);
  4741. aStream.Read(buf^, header.DataSize);
  4742. SetData(buf, fd.Format, header.Width, header.Height);
  4743. result := true;
  4744. end;
  4745. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4746. var
  4747. header: RawHeader;
  4748. fd: TFormatDescriptor;
  4749. begin
  4750. fd := TFormatDescriptor.Get(Format);
  4751. header.Magic := 'glBMP';
  4752. header.Version := 1;
  4753. header.Width := Width;
  4754. header.Height := Height;
  4755. header.DataSize := fd.GetSize(fDimension);
  4756. header.BitsPerPixel := fd.BitsPerPixel;
  4757. header.Precision := fd.Precision;
  4758. header.Shift := fd.Shift;
  4759. aStream.Write(header, SizeOf(header));
  4760. aStream.Write(Data^, header.DataSize);
  4761. end;
  4762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4763. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. const
  4766. BMP_MAGIC = $4D42;
  4767. BMP_COMP_RGB = 0;
  4768. BMP_COMP_RLE8 = 1;
  4769. BMP_COMP_RLE4 = 2;
  4770. BMP_COMP_BITFIELDS = 3;
  4771. type
  4772. TBMPHeader = packed record
  4773. bfType: Word;
  4774. bfSize: Cardinal;
  4775. bfReserved1: Word;
  4776. bfReserved2: Word;
  4777. bfOffBits: Cardinal;
  4778. end;
  4779. TBMPInfo = packed record
  4780. biSize: Cardinal;
  4781. biWidth: Longint;
  4782. biHeight: Longint;
  4783. biPlanes: Word;
  4784. biBitCount: Word;
  4785. biCompression: Cardinal;
  4786. biSizeImage: Cardinal;
  4787. biXPelsPerMeter: Longint;
  4788. biYPelsPerMeter: Longint;
  4789. biClrUsed: Cardinal;
  4790. biClrImportant: Cardinal;
  4791. end;
  4792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4793. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4794. //////////////////////////////////////////////////////////////////////////////////////////////////
  4795. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4796. var
  4797. tmp, i: Cardinal;
  4798. begin
  4799. result := tfEmpty;
  4800. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4801. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4802. //Read Compression
  4803. case aInfo.biCompression of
  4804. BMP_COMP_RLE4,
  4805. BMP_COMP_RLE8: begin
  4806. raise EglBitmap.Create('RLE compression is not supported');
  4807. end;
  4808. BMP_COMP_BITFIELDS: begin
  4809. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4810. for i := 0 to 2 do begin
  4811. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4812. aMask.arr[i] := tmp;
  4813. end;
  4814. end else
  4815. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4816. end;
  4817. end;
  4818. //get suitable format
  4819. case aInfo.biBitCount of
  4820. 8: result := tfLuminance8ub1;
  4821. 16: result := tfX1RGB5us1;
  4822. 24: result := tfBGR8ub3;
  4823. 32: result := tfXRGB8ui1;
  4824. end;
  4825. end;
  4826. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4827. var
  4828. i, c: Integer;
  4829. fd: TFormatDescriptor;
  4830. ColorTable: TbmpColorTable;
  4831. begin
  4832. result := nil;
  4833. if (aInfo.biBitCount >= 16) then
  4834. exit;
  4835. aFormat := tfLuminance8ub1;
  4836. c := aInfo.biClrUsed;
  4837. if (c = 0) then
  4838. c := 1 shl aInfo.biBitCount;
  4839. SetLength(ColorTable, c);
  4840. for i := 0 to c-1 do begin
  4841. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4842. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4843. aFormat := tfRGB8ub3;
  4844. end;
  4845. fd := TFormatDescriptor.Get(aFormat);
  4846. result := TbmpColorTableFormat.Create;
  4847. result.ColorTable := ColorTable;
  4848. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4849. end;
  4850. //////////////////////////////////////////////////////////////////////////////////////////////////
  4851. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4852. var
  4853. fd: TFormatDescriptor;
  4854. begin
  4855. result := nil;
  4856. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4857. // find suitable format ...
  4858. fd := TFormatDescriptor.GetFromMask(aMask);
  4859. if (fd.Format <> tfEmpty) then begin
  4860. aFormat := fd.Format;
  4861. exit;
  4862. end;
  4863. // or create custom bitfield format
  4864. result := TbmpBitfieldFormat.Create;
  4865. result.SetCustomValues(aInfo.biBitCount, aMask);
  4866. end;
  4867. end;
  4868. var
  4869. //simple types
  4870. StartPos: Int64;
  4871. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4872. PaddingBuff: Cardinal;
  4873. LineBuf, ImageData, TmpData: PByte;
  4874. SourceMD, DestMD: Pointer;
  4875. BmpFormat: TglBitmapFormat;
  4876. //records
  4877. Mask: TglBitmapRec4ul;
  4878. Header: TBMPHeader;
  4879. Info: TBMPInfo;
  4880. //classes
  4881. SpecialFormat: TFormatDescriptor;
  4882. FormatDesc: TFormatDescriptor;
  4883. //////////////////////////////////////////////////////////////////////////////////////////////////
  4884. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4885. var
  4886. i: Integer;
  4887. Pixel: TglBitmapPixelData;
  4888. begin
  4889. aStream.Read(aLineBuf^, rbLineSize);
  4890. SpecialFormat.PreparePixel(Pixel);
  4891. for i := 0 to Info.biWidth-1 do begin
  4892. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4893. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4894. FormatDesc.Map(Pixel, aData, DestMD);
  4895. end;
  4896. end;
  4897. begin
  4898. result := false;
  4899. BmpFormat := tfEmpty;
  4900. SpecialFormat := nil;
  4901. LineBuf := nil;
  4902. SourceMD := nil;
  4903. DestMD := nil;
  4904. // Header
  4905. StartPos := aStream.Position;
  4906. aStream.Read(Header{%H-}, SizeOf(Header));
  4907. if Header.bfType = BMP_MAGIC then begin
  4908. try try
  4909. BmpFormat := ReadInfo(Info, Mask);
  4910. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4911. if not Assigned(SpecialFormat) then
  4912. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4913. aStream.Position := StartPos + Header.bfOffBits;
  4914. if (BmpFormat <> tfEmpty) then begin
  4915. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4916. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4917. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4918. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4919. //get Memory
  4920. DestMD := FormatDesc.CreateMappingData;
  4921. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4922. GetMem(ImageData, ImageSize);
  4923. if Assigned(SpecialFormat) then begin
  4924. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4925. SourceMD := SpecialFormat.CreateMappingData;
  4926. end;
  4927. //read Data
  4928. try try
  4929. FillChar(ImageData^, ImageSize, $FF);
  4930. TmpData := ImageData;
  4931. if (Info.biHeight > 0) then
  4932. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4933. for i := 0 to Abs(Info.biHeight)-1 do begin
  4934. if Assigned(SpecialFormat) then
  4935. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4936. else
  4937. aStream.Read(TmpData^, wbLineSize); //else only read data
  4938. if (Info.biHeight > 0) then
  4939. dec(TmpData, wbLineSize)
  4940. else
  4941. inc(TmpData, wbLineSize);
  4942. aStream.Read(PaddingBuff{%H-}, Padding);
  4943. end;
  4944. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4945. result := true;
  4946. finally
  4947. if Assigned(LineBuf) then
  4948. FreeMem(LineBuf);
  4949. if Assigned(SourceMD) then
  4950. SpecialFormat.FreeMappingData(SourceMD);
  4951. FormatDesc.FreeMappingData(DestMD);
  4952. end;
  4953. except
  4954. if Assigned(ImageData) then
  4955. FreeMem(ImageData);
  4956. raise;
  4957. end;
  4958. end else
  4959. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4960. except
  4961. aStream.Position := StartPos;
  4962. raise;
  4963. end;
  4964. finally
  4965. FreeAndNil(SpecialFormat);
  4966. end;
  4967. end
  4968. else aStream.Position := StartPos;
  4969. end;
  4970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4971. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4972. var
  4973. Header: TBMPHeader;
  4974. Info: TBMPInfo;
  4975. Converter: TFormatDescriptor;
  4976. FormatDesc: TFormatDescriptor;
  4977. SourceFD, DestFD: Pointer;
  4978. pData, srcData, dstData, ConvertBuffer: pByte;
  4979. Pixel: TglBitmapPixelData;
  4980. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  4981. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  4982. PaddingBuff: Cardinal;
  4983. function GetLineWidth : Integer;
  4984. begin
  4985. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  4986. end;
  4987. begin
  4988. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  4989. raise EglBitmapUnsupportedFormat.Create(Format);
  4990. Converter := nil;
  4991. FormatDesc := TFormatDescriptor.Get(Format);
  4992. ImageSize := FormatDesc.GetSize(Dimension);
  4993. FillChar(Header{%H-}, SizeOf(Header), 0);
  4994. Header.bfType := BMP_MAGIC;
  4995. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  4996. Header.bfReserved1 := 0;
  4997. Header.bfReserved2 := 0;
  4998. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  4999. FillChar(Info{%H-}, SizeOf(Info), 0);
  5000. Info.biSize := SizeOf(Info);
  5001. Info.biWidth := Width;
  5002. Info.biHeight := Height;
  5003. Info.biPlanes := 1;
  5004. Info.biCompression := BMP_COMP_RGB;
  5005. Info.biSizeImage := ImageSize;
  5006. try
  5007. case Format of
  5008. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5009. begin
  5010. Info.biBitCount := 8;
  5011. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5012. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5013. Converter := TbmpColorTableFormat.Create;
  5014. with (Converter as TbmpColorTableFormat) do begin
  5015. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5016. CreateColorTable;
  5017. end;
  5018. end;
  5019. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5020. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5021. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5022. begin
  5023. Info.biBitCount := 16;
  5024. Info.biCompression := BMP_COMP_BITFIELDS;
  5025. end;
  5026. tfBGR8ub3, tfRGB8ub3:
  5027. begin
  5028. Info.biBitCount := 24;
  5029. if (Format = tfRGB8ub3) then
  5030. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5031. end;
  5032. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5033. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5034. begin
  5035. Info.biBitCount := 32;
  5036. Info.biCompression := BMP_COMP_BITFIELDS;
  5037. end;
  5038. else
  5039. raise EglBitmapUnsupportedFormat.Create(Format);
  5040. end;
  5041. Info.biXPelsPerMeter := 2835;
  5042. Info.biYPelsPerMeter := 2835;
  5043. // prepare bitmasks
  5044. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5045. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5046. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5047. RedMask := FormatDesc.Mask.r;
  5048. GreenMask := FormatDesc.Mask.g;
  5049. BlueMask := FormatDesc.Mask.b;
  5050. AlphaMask := FormatDesc.Mask.a;
  5051. end;
  5052. // headers
  5053. aStream.Write(Header, SizeOf(Header));
  5054. aStream.Write(Info, SizeOf(Info));
  5055. // colortable
  5056. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5057. with (Converter as TbmpColorTableFormat) do
  5058. aStream.Write(ColorTable[0].b,
  5059. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5060. // bitmasks
  5061. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5062. aStream.Write(RedMask, SizeOf(Cardinal));
  5063. aStream.Write(GreenMask, SizeOf(Cardinal));
  5064. aStream.Write(BlueMask, SizeOf(Cardinal));
  5065. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5066. end;
  5067. // image data
  5068. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5069. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5070. Padding := GetLineWidth - wbLineSize;
  5071. PaddingBuff := 0;
  5072. pData := Data;
  5073. inc(pData, (Height-1) * rbLineSize);
  5074. // prepare row buffer. But only for RGB because RGBA supports color masks
  5075. // so it's possible to change color within the image.
  5076. if Assigned(Converter) then begin
  5077. FormatDesc.PreparePixel(Pixel);
  5078. GetMem(ConvertBuffer, wbLineSize);
  5079. SourceFD := FormatDesc.CreateMappingData;
  5080. DestFD := Converter.CreateMappingData;
  5081. end else
  5082. ConvertBuffer := nil;
  5083. try
  5084. for LineIdx := 0 to Height - 1 do begin
  5085. // preparing row
  5086. if Assigned(Converter) then begin
  5087. srcData := pData;
  5088. dstData := ConvertBuffer;
  5089. for PixelIdx := 0 to Info.biWidth-1 do begin
  5090. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5091. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5092. Converter.Map(Pixel, dstData, DestFD);
  5093. end;
  5094. aStream.Write(ConvertBuffer^, wbLineSize);
  5095. end else begin
  5096. aStream.Write(pData^, rbLineSize);
  5097. end;
  5098. dec(pData, rbLineSize);
  5099. if (Padding > 0) then
  5100. aStream.Write(PaddingBuff, Padding);
  5101. end;
  5102. finally
  5103. // destroy row buffer
  5104. if Assigned(ConvertBuffer) then begin
  5105. FormatDesc.FreeMappingData(SourceFD);
  5106. Converter.FreeMappingData(DestFD);
  5107. FreeMem(ConvertBuffer);
  5108. end;
  5109. end;
  5110. finally
  5111. if Assigned(Converter) then
  5112. Converter.Free;
  5113. end;
  5114. end;
  5115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5116. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5118. type
  5119. TTGAHeader = packed record
  5120. ImageID: Byte;
  5121. ColorMapType: Byte;
  5122. ImageType: Byte;
  5123. //ColorMapSpec: Array[0..4] of Byte;
  5124. ColorMapStart: Word;
  5125. ColorMapLength: Word;
  5126. ColorMapEntrySize: Byte;
  5127. OrigX: Word;
  5128. OrigY: Word;
  5129. Width: Word;
  5130. Height: Word;
  5131. Bpp: Byte;
  5132. ImageDesc: Byte;
  5133. end;
  5134. const
  5135. TGA_UNCOMPRESSED_RGB = 2;
  5136. TGA_UNCOMPRESSED_GRAY = 3;
  5137. TGA_COMPRESSED_RGB = 10;
  5138. TGA_COMPRESSED_GRAY = 11;
  5139. TGA_NONE_COLOR_TABLE = 0;
  5140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5141. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5142. var
  5143. Header: TTGAHeader;
  5144. ImageData: System.PByte;
  5145. StartPosition: Int64;
  5146. PixelSize, LineSize: Integer;
  5147. tgaFormat: TglBitmapFormat;
  5148. FormatDesc: TFormatDescriptor;
  5149. Counter: packed record
  5150. X, Y: packed record
  5151. low, high, dir: Integer;
  5152. end;
  5153. end;
  5154. const
  5155. CACHE_SIZE = $4000;
  5156. ////////////////////////////////////////////////////////////////////////////////////////
  5157. procedure ReadUncompressed;
  5158. var
  5159. i, j: Integer;
  5160. buf, tmp1, tmp2: System.PByte;
  5161. begin
  5162. buf := nil;
  5163. if (Counter.X.dir < 0) then
  5164. GetMem(buf, LineSize);
  5165. try
  5166. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5167. tmp1 := ImageData;
  5168. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5169. if (Counter.X.dir < 0) then begin //flip X
  5170. aStream.Read(buf^, LineSize);
  5171. tmp2 := buf;
  5172. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5173. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5174. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5175. tmp1^ := tmp2^;
  5176. inc(tmp1);
  5177. inc(tmp2);
  5178. end;
  5179. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5180. end;
  5181. end else
  5182. aStream.Read(tmp1^, LineSize);
  5183. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5184. end;
  5185. finally
  5186. if Assigned(buf) then
  5187. FreeMem(buf);
  5188. end;
  5189. end;
  5190. ////////////////////////////////////////////////////////////////////////////////////////
  5191. procedure ReadCompressed;
  5192. /////////////////////////////////////////////////////////////////
  5193. var
  5194. TmpData: System.PByte;
  5195. LinePixelsRead: Integer;
  5196. procedure CheckLine;
  5197. begin
  5198. if (LinePixelsRead >= Header.Width) then begin
  5199. LinePixelsRead := 0;
  5200. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5201. TmpData := ImageData;
  5202. inc(TmpData, Counter.Y.low * LineSize); //set line
  5203. if (Counter.X.dir < 0) then //if x flipped then
  5204. inc(TmpData, LineSize - PixelSize); //set last pixel
  5205. end;
  5206. end;
  5207. /////////////////////////////////////////////////////////////////
  5208. var
  5209. Cache: PByte;
  5210. CacheSize, CachePos: Integer;
  5211. procedure CachedRead(out Buffer; Count: Integer);
  5212. var
  5213. BytesRead: Integer;
  5214. begin
  5215. if (CachePos + Count > CacheSize) then begin
  5216. //if buffer overflow save non read bytes
  5217. BytesRead := 0;
  5218. if (CacheSize - CachePos > 0) then begin
  5219. BytesRead := CacheSize - CachePos;
  5220. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5221. inc(CachePos, BytesRead);
  5222. end;
  5223. //load cache from file
  5224. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5225. aStream.Read(Cache^, CacheSize);
  5226. CachePos := 0;
  5227. //read rest of requested bytes
  5228. if (Count - BytesRead > 0) then begin
  5229. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5230. inc(CachePos, Count - BytesRead);
  5231. end;
  5232. end else begin
  5233. //if no buffer overflow just read the data
  5234. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5235. inc(CachePos, Count);
  5236. end;
  5237. end;
  5238. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5239. begin
  5240. case PixelSize of
  5241. 1: begin
  5242. aBuffer^ := aData^;
  5243. inc(aBuffer, Counter.X.dir);
  5244. end;
  5245. 2: begin
  5246. PWord(aBuffer)^ := PWord(aData)^;
  5247. inc(aBuffer, 2 * Counter.X.dir);
  5248. end;
  5249. 3: begin
  5250. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5251. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5252. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5253. inc(aBuffer, 3 * Counter.X.dir);
  5254. end;
  5255. 4: begin
  5256. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5257. inc(aBuffer, 4 * Counter.X.dir);
  5258. end;
  5259. end;
  5260. end;
  5261. var
  5262. TotalPixelsToRead, TotalPixelsRead: Integer;
  5263. Temp: Byte;
  5264. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5265. PixelRepeat: Boolean;
  5266. PixelsToRead, PixelCount: Integer;
  5267. begin
  5268. CacheSize := 0;
  5269. CachePos := 0;
  5270. TotalPixelsToRead := Header.Width * Header.Height;
  5271. TotalPixelsRead := 0;
  5272. LinePixelsRead := 0;
  5273. GetMem(Cache, CACHE_SIZE);
  5274. try
  5275. TmpData := ImageData;
  5276. inc(TmpData, Counter.Y.low * LineSize); //set line
  5277. if (Counter.X.dir < 0) then //if x flipped then
  5278. inc(TmpData, LineSize - PixelSize); //set last pixel
  5279. repeat
  5280. //read CommandByte
  5281. CachedRead(Temp, 1);
  5282. PixelRepeat := (Temp and $80) > 0;
  5283. PixelsToRead := (Temp and $7F) + 1;
  5284. inc(TotalPixelsRead, PixelsToRead);
  5285. if PixelRepeat then
  5286. CachedRead(buf[0], PixelSize);
  5287. while (PixelsToRead > 0) do begin
  5288. CheckLine;
  5289. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5290. while (PixelCount > 0) do begin
  5291. if not PixelRepeat then
  5292. CachedRead(buf[0], PixelSize);
  5293. PixelToBuffer(@buf[0], TmpData);
  5294. inc(LinePixelsRead);
  5295. dec(PixelsToRead);
  5296. dec(PixelCount);
  5297. end;
  5298. end;
  5299. until (TotalPixelsRead >= TotalPixelsToRead);
  5300. finally
  5301. FreeMem(Cache);
  5302. end;
  5303. end;
  5304. function IsGrayFormat: Boolean;
  5305. begin
  5306. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5307. end;
  5308. begin
  5309. result := false;
  5310. // reading header to test file and set cursor back to begin
  5311. StartPosition := aStream.Position;
  5312. aStream.Read(Header{%H-}, SizeOf(Header));
  5313. // no colormapped files
  5314. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5315. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5316. begin
  5317. try
  5318. if Header.ImageID <> 0 then // skip image ID
  5319. aStream.Position := aStream.Position + Header.ImageID;
  5320. tgaFormat := tfEmpty;
  5321. case Header.Bpp of
  5322. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5323. 0: tgaFormat := tfLuminance8ub1;
  5324. 8: tgaFormat := tfAlpha8ub1;
  5325. end;
  5326. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5327. 0: tgaFormat := tfLuminance16us1;
  5328. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5329. end else case (Header.ImageDesc and $F) of
  5330. 0: tgaFormat := tfX1RGB5us1;
  5331. 1: tgaFormat := tfA1RGB5us1;
  5332. 4: tgaFormat := tfARGB4us1;
  5333. end;
  5334. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5335. 0: tgaFormat := tfBGR8ub3;
  5336. end;
  5337. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5338. 0: tgaFormat := tfDepth32ui1;
  5339. end else case (Header.ImageDesc and $F) of
  5340. 0: tgaFormat := tfX2RGB10ui1;
  5341. 2: tgaFormat := tfA2RGB10ui1;
  5342. 8: tgaFormat := tfARGB8ui1;
  5343. end;
  5344. end;
  5345. if (tgaFormat = tfEmpty) then
  5346. raise EglBitmap.Create('LoadTga - unsupported format');
  5347. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5348. PixelSize := FormatDesc.GetSize(1, 1);
  5349. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5350. GetMem(ImageData, LineSize * Header.Height);
  5351. try
  5352. //column direction
  5353. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5354. Counter.X.low := Header.Height-1;;
  5355. Counter.X.high := 0;
  5356. Counter.X.dir := -1;
  5357. end else begin
  5358. Counter.X.low := 0;
  5359. Counter.X.high := Header.Height-1;
  5360. Counter.X.dir := 1;
  5361. end;
  5362. // Row direction
  5363. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5364. Counter.Y.low := 0;
  5365. Counter.Y.high := Header.Height-1;
  5366. Counter.Y.dir := 1;
  5367. end else begin
  5368. Counter.Y.low := Header.Height-1;;
  5369. Counter.Y.high := 0;
  5370. Counter.Y.dir := -1;
  5371. end;
  5372. // Read Image
  5373. case Header.ImageType of
  5374. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5375. ReadUncompressed;
  5376. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5377. ReadCompressed;
  5378. end;
  5379. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5380. result := true;
  5381. except
  5382. if Assigned(ImageData) then
  5383. FreeMem(ImageData);
  5384. raise;
  5385. end;
  5386. finally
  5387. aStream.Position := StartPosition;
  5388. end;
  5389. end
  5390. else aStream.Position := StartPosition;
  5391. end;
  5392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5393. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5394. var
  5395. Header: TTGAHeader;
  5396. Size: Integer;
  5397. FormatDesc: TFormatDescriptor;
  5398. begin
  5399. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5400. raise EglBitmapUnsupportedFormat.Create(Format);
  5401. //prepare header
  5402. FormatDesc := TFormatDescriptor.Get(Format);
  5403. FillChar(Header{%H-}, SizeOf(Header), 0);
  5404. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5405. Header.Bpp := FormatDesc.BitsPerPixel;
  5406. Header.Width := Width;
  5407. Header.Height := Height;
  5408. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5409. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5410. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5411. else
  5412. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5413. aStream.Write(Header, SizeOf(Header));
  5414. // write Data
  5415. Size := FormatDesc.GetSize(Dimension);
  5416. aStream.Write(Data^, Size);
  5417. end;
  5418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5419. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5421. const
  5422. DDS_MAGIC: Cardinal = $20534444;
  5423. // DDS_header.dwFlags
  5424. DDSD_CAPS = $00000001;
  5425. DDSD_HEIGHT = $00000002;
  5426. DDSD_WIDTH = $00000004;
  5427. DDSD_PIXELFORMAT = $00001000;
  5428. // DDS_header.sPixelFormat.dwFlags
  5429. DDPF_ALPHAPIXELS = $00000001;
  5430. DDPF_ALPHA = $00000002;
  5431. DDPF_FOURCC = $00000004;
  5432. DDPF_RGB = $00000040;
  5433. DDPF_LUMINANCE = $00020000;
  5434. // DDS_header.sCaps.dwCaps1
  5435. DDSCAPS_TEXTURE = $00001000;
  5436. // DDS_header.sCaps.dwCaps2
  5437. DDSCAPS2_CUBEMAP = $00000200;
  5438. D3DFMT_DXT1 = $31545844;
  5439. D3DFMT_DXT3 = $33545844;
  5440. D3DFMT_DXT5 = $35545844;
  5441. type
  5442. TDDSPixelFormat = packed record
  5443. dwSize: Cardinal;
  5444. dwFlags: Cardinal;
  5445. dwFourCC: Cardinal;
  5446. dwRGBBitCount: Cardinal;
  5447. dwRBitMask: Cardinal;
  5448. dwGBitMask: Cardinal;
  5449. dwBBitMask: Cardinal;
  5450. dwABitMask: Cardinal;
  5451. end;
  5452. TDDSCaps = packed record
  5453. dwCaps1: Cardinal;
  5454. dwCaps2: Cardinal;
  5455. dwDDSX: Cardinal;
  5456. dwReserved: Cardinal;
  5457. end;
  5458. TDDSHeader = packed record
  5459. dwSize: Cardinal;
  5460. dwFlags: Cardinal;
  5461. dwHeight: Cardinal;
  5462. dwWidth: Cardinal;
  5463. dwPitchOrLinearSize: Cardinal;
  5464. dwDepth: Cardinal;
  5465. dwMipMapCount: Cardinal;
  5466. dwReserved: array[0..10] of Cardinal;
  5467. PixelFormat: TDDSPixelFormat;
  5468. Caps: TDDSCaps;
  5469. dwReserved2: Cardinal;
  5470. end;
  5471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5472. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5473. var
  5474. Header: TDDSHeader;
  5475. Converter: TbmpBitfieldFormat;
  5476. function GetDDSFormat: TglBitmapFormat;
  5477. var
  5478. fd: TFormatDescriptor;
  5479. i: Integer;
  5480. Mask: TglBitmapRec4ul;
  5481. Range: TglBitmapRec4ui;
  5482. match: Boolean;
  5483. begin
  5484. result := tfEmpty;
  5485. with Header.PixelFormat do begin
  5486. // Compresses
  5487. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5488. case Header.PixelFormat.dwFourCC of
  5489. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5490. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5491. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5492. end;
  5493. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5494. // prepare masks
  5495. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5496. Mask.r := dwRBitMask;
  5497. Mask.g := dwGBitMask;
  5498. Mask.b := dwBBitMask;
  5499. end else begin
  5500. Mask.r := dwRBitMask;
  5501. Mask.g := dwRBitMask;
  5502. Mask.b := dwRBitMask;
  5503. end;
  5504. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5505. Mask.a := dwABitMask
  5506. else
  5507. Mask.a := 0;;
  5508. //find matching format
  5509. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5510. result := fd.Format;
  5511. if (result <> tfEmpty) then
  5512. exit;
  5513. //find format with same Range
  5514. for i := 0 to 3 do
  5515. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5516. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5517. fd := TFormatDescriptor.Get(result);
  5518. match := true;
  5519. for i := 0 to 3 do
  5520. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5521. match := false;
  5522. break;
  5523. end;
  5524. if match then
  5525. break;
  5526. end;
  5527. //no format with same range found -> use default
  5528. if (result = tfEmpty) then begin
  5529. if (dwABitMask > 0) then
  5530. result := tfRGBA8ui1
  5531. else
  5532. result := tfRGB8ub3;
  5533. end;
  5534. Converter := TbmpBitfieldFormat.Create;
  5535. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5536. end;
  5537. end;
  5538. end;
  5539. var
  5540. StreamPos: Int64;
  5541. x, y, LineSize, RowSize, Magic: Cardinal;
  5542. NewImage, TmpData, RowData, SrcData: System.PByte;
  5543. SourceMD, DestMD: Pointer;
  5544. Pixel: TglBitmapPixelData;
  5545. ddsFormat: TglBitmapFormat;
  5546. FormatDesc: TFormatDescriptor;
  5547. begin
  5548. result := false;
  5549. Converter := nil;
  5550. StreamPos := aStream.Position;
  5551. // Magic
  5552. aStream.Read(Magic{%H-}, sizeof(Magic));
  5553. if (Magic <> DDS_MAGIC) then begin
  5554. aStream.Position := StreamPos;
  5555. exit;
  5556. end;
  5557. //Header
  5558. aStream.Read(Header{%H-}, sizeof(Header));
  5559. if (Header.dwSize <> SizeOf(Header)) or
  5560. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5561. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5562. begin
  5563. aStream.Position := StreamPos;
  5564. exit;
  5565. end;
  5566. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5567. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5568. ddsFormat := GetDDSFormat;
  5569. try
  5570. if (ddsFormat = tfEmpty) then
  5571. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5572. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5573. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5574. GetMem(NewImage, Header.dwHeight * LineSize);
  5575. try
  5576. TmpData := NewImage;
  5577. //Converter needed
  5578. if Assigned(Converter) then begin
  5579. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5580. GetMem(RowData, RowSize);
  5581. SourceMD := Converter.CreateMappingData;
  5582. DestMD := FormatDesc.CreateMappingData;
  5583. try
  5584. for y := 0 to Header.dwHeight-1 do begin
  5585. TmpData := NewImage;
  5586. inc(TmpData, y * LineSize);
  5587. SrcData := RowData;
  5588. aStream.Read(SrcData^, RowSize);
  5589. for x := 0 to Header.dwWidth-1 do begin
  5590. Converter.Unmap(SrcData, Pixel, SourceMD);
  5591. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5592. FormatDesc.Map(Pixel, TmpData, DestMD);
  5593. end;
  5594. end;
  5595. finally
  5596. Converter.FreeMappingData(SourceMD);
  5597. FormatDesc.FreeMappingData(DestMD);
  5598. FreeMem(RowData);
  5599. end;
  5600. end else
  5601. // Compressed
  5602. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5603. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5604. for Y := 0 to Header.dwHeight-1 do begin
  5605. aStream.Read(TmpData^, RowSize);
  5606. Inc(TmpData, LineSize);
  5607. end;
  5608. end else
  5609. // Uncompressed
  5610. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5611. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5612. for Y := 0 to Header.dwHeight-1 do begin
  5613. aStream.Read(TmpData^, RowSize);
  5614. Inc(TmpData, LineSize);
  5615. end;
  5616. end else
  5617. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5618. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5619. result := true;
  5620. except
  5621. if Assigned(NewImage) then
  5622. FreeMem(NewImage);
  5623. raise;
  5624. end;
  5625. finally
  5626. FreeAndNil(Converter);
  5627. end;
  5628. end;
  5629. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5630. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5631. var
  5632. Header: TDDSHeader;
  5633. FormatDesc: TFormatDescriptor;
  5634. begin
  5635. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5636. raise EglBitmapUnsupportedFormat.Create(Format);
  5637. FormatDesc := TFormatDescriptor.Get(Format);
  5638. // Generell
  5639. FillChar(Header{%H-}, SizeOf(Header), 0);
  5640. Header.dwSize := SizeOf(Header);
  5641. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5642. Header.dwWidth := Max(1, Width);
  5643. Header.dwHeight := Max(1, Height);
  5644. // Caps
  5645. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5646. // Pixelformat
  5647. Header.PixelFormat.dwSize := sizeof(Header);
  5648. if (FormatDesc.IsCompressed) then begin
  5649. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5650. case Format of
  5651. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5652. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5653. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5654. end;
  5655. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5656. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5657. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5658. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5659. end else if FormatDesc.IsGrayscale then begin
  5660. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5661. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5662. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5663. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5664. end else begin
  5665. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5666. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5667. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5668. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5669. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5670. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5671. end;
  5672. if (FormatDesc.HasAlpha) then
  5673. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5674. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5675. aStream.Write(Header, SizeOf(Header));
  5676. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5677. end;
  5678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5679. function TglBitmapData.FlipHorz: Boolean;
  5680. var
  5681. fd: TglBitmapFormatDescriptor;
  5682. Col, RowSize, PixelSize: Integer;
  5683. pTempDest, pDest, pSource: PByte;
  5684. begin
  5685. result := false;
  5686. fd := FormatDescriptor;
  5687. PixelSize := Ceil(fd.BytesPerPixel);
  5688. RowSize := fd.GetSize(Width, 1);
  5689. if Assigned(Data) and not fd.IsCompressed then begin
  5690. pSource := Data;
  5691. GetMem(pDest, RowSize);
  5692. try
  5693. pTempDest := pDest;
  5694. Inc(pTempDest, RowSize);
  5695. for Col := 0 to Width-1 do begin
  5696. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5697. Move(pSource^, pTempDest^, PixelSize);
  5698. Inc(pSource, PixelSize);
  5699. end;
  5700. SetData(pDest, Format, Width);
  5701. result := true;
  5702. except
  5703. if Assigned(pDest) then
  5704. FreeMem(pDest);
  5705. raise;
  5706. end;
  5707. end;
  5708. end;
  5709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5710. function TglBitmapData.FlipVert: Boolean;
  5711. var
  5712. fd: TglBitmapFormatDescriptor;
  5713. Row, RowSize, PixelSize: Integer;
  5714. TempDestData, DestData, SourceData: PByte;
  5715. begin
  5716. result := false;
  5717. fd := FormatDescriptor;
  5718. PixelSize := Ceil(fd.BytesPerPixel);
  5719. RowSize := fd.GetSize(Width, 1);
  5720. if Assigned(Data) then begin
  5721. SourceData := Data;
  5722. GetMem(DestData, Height * RowSize);
  5723. try
  5724. TempDestData := DestData;
  5725. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5726. for Row := 0 to Height -1 do begin
  5727. Move(SourceData^, TempDestData^, RowSize);
  5728. Dec(TempDestData, RowSize);
  5729. Inc(SourceData, RowSize);
  5730. end;
  5731. SetData(DestData, Format, Width, Height);
  5732. result := true;
  5733. except
  5734. if Assigned(DestData) then
  5735. FreeMem(DestData);
  5736. raise;
  5737. end;
  5738. end;
  5739. end;
  5740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5741. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5742. var
  5743. fs: TFileStream;
  5744. begin
  5745. if not FileExists(aFilename) then
  5746. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5747. fs := TFileStream.Create(aFilename, fmOpenRead);
  5748. try
  5749. fs.Position := 0;
  5750. LoadFromStream(fs);
  5751. fFilename := aFilename;
  5752. finally
  5753. fs.Free;
  5754. end;
  5755. end;
  5756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5757. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5758. begin
  5759. {$IFDEF GLB_SUPPORT_PNG_READ}
  5760. if not LoadPNG(aStream) then
  5761. {$ENDIF}
  5762. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5763. if not LoadJPEG(aStream) then
  5764. {$ENDIF}
  5765. if not LoadDDS(aStream) then
  5766. if not LoadTGA(aStream) then
  5767. if not LoadBMP(aStream) then
  5768. if not LoadRAW(aStream) then
  5769. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5770. end;
  5771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5772. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5773. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5774. var
  5775. tmpData: PByte;
  5776. size: Integer;
  5777. begin
  5778. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5779. GetMem(tmpData, size);
  5780. try
  5781. FillChar(tmpData^, size, #$FF);
  5782. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5783. except
  5784. if Assigned(tmpData) then
  5785. FreeMem(tmpData);
  5786. raise;
  5787. end;
  5788. Convert(Self, aFunc, false, aFormat, aArgs);
  5789. end;
  5790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5791. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5792. var
  5793. rs: TResourceStream;
  5794. begin
  5795. PrepareResType(aResource, aResType);
  5796. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5797. try
  5798. LoadFromStream(rs);
  5799. finally
  5800. rs.Free;
  5801. end;
  5802. end;
  5803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5804. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5805. var
  5806. rs: TResourceStream;
  5807. begin
  5808. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5809. try
  5810. LoadFromStream(rs);
  5811. finally
  5812. rs.Free;
  5813. end;
  5814. end;
  5815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5816. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5817. var
  5818. fs: TFileStream;
  5819. begin
  5820. fs := TFileStream.Create(aFileName, fmCreate);
  5821. try
  5822. fs.Position := 0;
  5823. SaveToStream(fs, aFileType);
  5824. finally
  5825. fs.Free;
  5826. end;
  5827. end;
  5828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5829. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5830. begin
  5831. case aFileType of
  5832. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5833. ftPNG: SavePNG(aStream);
  5834. {$ENDIF}
  5835. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5836. ftJPEG: SaveJPEG(aStream);
  5837. {$ENDIF}
  5838. ftDDS: SaveDDS(aStream);
  5839. ftTGA: SaveTGA(aStream);
  5840. ftBMP: SaveBMP(aStream);
  5841. ftRAW: SaveRAW(aStream);
  5842. end;
  5843. end;
  5844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5845. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5846. begin
  5847. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5848. end;
  5849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5850. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5851. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5852. var
  5853. DestData, TmpData, SourceData: pByte;
  5854. TempHeight, TempWidth: Integer;
  5855. SourceFD, DestFD: TFormatDescriptor;
  5856. SourceMD, DestMD: Pointer;
  5857. FuncRec: TglBitmapFunctionRec;
  5858. begin
  5859. Assert(Assigned(Data));
  5860. Assert(Assigned(aSource));
  5861. Assert(Assigned(aSource.Data));
  5862. result := false;
  5863. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5864. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5865. DestFD := TFormatDescriptor.Get(aFormat);
  5866. if (SourceFD.IsCompressed) then
  5867. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5868. if (DestFD.IsCompressed) then
  5869. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5870. // inkompatible Formats so CreateTemp
  5871. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5872. aCreateTemp := true;
  5873. // Values
  5874. TempHeight := Max(1, aSource.Height);
  5875. TempWidth := Max(1, aSource.Width);
  5876. FuncRec.Sender := Self;
  5877. FuncRec.Args := aArgs;
  5878. TmpData := nil;
  5879. if aCreateTemp then begin
  5880. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5881. DestData := TmpData;
  5882. end else
  5883. DestData := Data;
  5884. try
  5885. SourceFD.PreparePixel(FuncRec.Source);
  5886. DestFD.PreparePixel (FuncRec.Dest);
  5887. SourceMD := SourceFD.CreateMappingData;
  5888. DestMD := DestFD.CreateMappingData;
  5889. FuncRec.Size := aSource.Dimension;
  5890. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5891. try
  5892. SourceData := aSource.Data;
  5893. FuncRec.Position.Y := 0;
  5894. while FuncRec.Position.Y < TempHeight do begin
  5895. FuncRec.Position.X := 0;
  5896. while FuncRec.Position.X < TempWidth do begin
  5897. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5898. aFunc(FuncRec);
  5899. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5900. inc(FuncRec.Position.X);
  5901. end;
  5902. inc(FuncRec.Position.Y);
  5903. end;
  5904. // Updating Image or InternalFormat
  5905. if aCreateTemp then
  5906. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5907. else if (aFormat <> fFormat) then
  5908. Format := aFormat;
  5909. result := true;
  5910. finally
  5911. SourceFD.FreeMappingData(SourceMD);
  5912. DestFD.FreeMappingData(DestMD);
  5913. end;
  5914. except
  5915. if aCreateTemp and Assigned(TmpData) then
  5916. FreeMem(TmpData);
  5917. raise;
  5918. end;
  5919. end;
  5920. end;
  5921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5922. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5923. var
  5924. SourceFD, DestFD: TFormatDescriptor;
  5925. SourcePD, DestPD: TglBitmapPixelData;
  5926. ShiftData: TShiftData;
  5927. function DataIsIdentical: Boolean;
  5928. begin
  5929. result := SourceFD.MaskMatch(DestFD.Mask);
  5930. end;
  5931. function CanCopyDirect: Boolean;
  5932. begin
  5933. result :=
  5934. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5935. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5936. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5937. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5938. end;
  5939. function CanShift: Boolean;
  5940. begin
  5941. result :=
  5942. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5943. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5944. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5945. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5946. end;
  5947. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5948. begin
  5949. result := 0;
  5950. while (aSource > aDest) and (aSource > 0) do begin
  5951. inc(result);
  5952. aSource := aSource shr 1;
  5953. end;
  5954. end;
  5955. begin
  5956. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5957. SourceFD := TFormatDescriptor.Get(Format);
  5958. DestFD := TFormatDescriptor.Get(aFormat);
  5959. if DataIsIdentical then begin
  5960. result := true;
  5961. Format := aFormat;
  5962. exit;
  5963. end;
  5964. SourceFD.PreparePixel(SourcePD);
  5965. DestFD.PreparePixel (DestPD);
  5966. if CanCopyDirect then
  5967. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5968. else if CanShift then begin
  5969. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5970. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5971. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5972. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5973. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5974. end else
  5975. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5976. end else
  5977. result := true;
  5978. end;
  5979. {$IFDEF GLB_SDL}
  5980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5981. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  5982. var
  5983. Row, RowSize: Integer;
  5984. SourceData, TmpData: PByte;
  5985. TempDepth: Integer;
  5986. FormatDesc: TFormatDescriptor;
  5987. function GetRowPointer(Row: Integer): pByte;
  5988. begin
  5989. result := aSurface.pixels;
  5990. Inc(result, Row * RowSize);
  5991. end;
  5992. begin
  5993. result := false;
  5994. FormatDesc := TFormatDescriptor.Get(Format);
  5995. if FormatDesc.IsCompressed then
  5996. raise EglBitmapUnsupportedFormat.Create(Format);
  5997. if Assigned(Data) then begin
  5998. case Trunc(FormatDesc.PixelSize) of
  5999. 1: TempDepth := 8;
  6000. 2: TempDepth := 16;
  6001. 3: TempDepth := 24;
  6002. 4: TempDepth := 32;
  6003. else
  6004. raise EglBitmapUnsupportedFormat.Create(Format);
  6005. end;
  6006. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6007. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6008. SourceData := Data;
  6009. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6010. for Row := 0 to FileHeight-1 do begin
  6011. TmpData := GetRowPointer(Row);
  6012. if Assigned(TmpData) then begin
  6013. Move(SourceData^, TmpData^, RowSize);
  6014. inc(SourceData, RowSize);
  6015. end;
  6016. end;
  6017. result := true;
  6018. end;
  6019. end;
  6020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6021. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6022. var
  6023. pSource, pData, pTempData: PByte;
  6024. Row, RowSize, TempWidth, TempHeight: Integer;
  6025. IntFormat: TglBitmapFormat;
  6026. fd: TFormatDescriptor;
  6027. Mask: TglBitmapMask;
  6028. function GetRowPointer(Row: Integer): pByte;
  6029. begin
  6030. result := aSurface^.pixels;
  6031. Inc(result, Row * RowSize);
  6032. end;
  6033. begin
  6034. result := false;
  6035. if (Assigned(aSurface)) then begin
  6036. with aSurface^.format^ do begin
  6037. Mask.r := RMask;
  6038. Mask.g := GMask;
  6039. Mask.b := BMask;
  6040. Mask.a := AMask;
  6041. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6042. if (IntFormat = tfEmpty) then
  6043. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6044. end;
  6045. fd := TFormatDescriptor.Get(IntFormat);
  6046. TempWidth := aSurface^.w;
  6047. TempHeight := aSurface^.h;
  6048. RowSize := fd.GetSize(TempWidth, 1);
  6049. GetMem(pData, TempHeight * RowSize);
  6050. try
  6051. pTempData := pData;
  6052. for Row := 0 to TempHeight -1 do begin
  6053. pSource := GetRowPointer(Row);
  6054. if (Assigned(pSource)) then begin
  6055. Move(pSource^, pTempData^, RowSize);
  6056. Inc(pTempData, RowSize);
  6057. end;
  6058. end;
  6059. SetData(pData, IntFormat, TempWidth, TempHeight);
  6060. result := true;
  6061. except
  6062. if Assigned(pData) then
  6063. FreeMem(pData);
  6064. raise;
  6065. end;
  6066. end;
  6067. end;
  6068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6069. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6070. var
  6071. Row, Col, AlphaInterleave: Integer;
  6072. pSource, pDest: PByte;
  6073. function GetRowPointer(Row: Integer): pByte;
  6074. begin
  6075. result := aSurface.pixels;
  6076. Inc(result, Row * Width);
  6077. end;
  6078. begin
  6079. result := false;
  6080. if Assigned(Data) then begin
  6081. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6082. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6083. AlphaInterleave := 0;
  6084. case Format of
  6085. tfLuminance8Alpha8ub2:
  6086. AlphaInterleave := 1;
  6087. tfBGRA8ub4, tfRGBA8ub4:
  6088. AlphaInterleave := 3;
  6089. end;
  6090. pSource := Data;
  6091. for Row := 0 to Height -1 do begin
  6092. pDest := GetRowPointer(Row);
  6093. if Assigned(pDest) then begin
  6094. for Col := 0 to Width -1 do begin
  6095. Inc(pSource, AlphaInterleave);
  6096. pDest^ := pSource^;
  6097. Inc(pDest);
  6098. Inc(pSource);
  6099. end;
  6100. end;
  6101. end;
  6102. result := true;
  6103. end;
  6104. end;
  6105. end;
  6106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6107. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6108. var
  6109. bmp: TglBitmap2D;
  6110. begin
  6111. bmp := TglBitmap2D.Create;
  6112. try
  6113. bmp.AssignFromSurface(aSurface);
  6114. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6115. finally
  6116. bmp.Free;
  6117. end;
  6118. end;
  6119. {$ENDIF}
  6120. {$IFDEF GLB_DELPHI}
  6121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6122. function CreateGrayPalette: HPALETTE;
  6123. var
  6124. Idx: Integer;
  6125. Pal: PLogPalette;
  6126. begin
  6127. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6128. Pal.palVersion := $300;
  6129. Pal.palNumEntries := 256;
  6130. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6131. Pal.palPalEntry[Idx].peRed := Idx;
  6132. Pal.palPalEntry[Idx].peGreen := Idx;
  6133. Pal.palPalEntry[Idx].peBlue := Idx;
  6134. Pal.palPalEntry[Idx].peFlags := 0;
  6135. end;
  6136. Result := CreatePalette(Pal^);
  6137. FreeMem(Pal);
  6138. end;
  6139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6140. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6141. var
  6142. Row, RowSize: Integer;
  6143. pSource, pData: PByte;
  6144. begin
  6145. result := false;
  6146. if Assigned(Data) then begin
  6147. if Assigned(aBitmap) then begin
  6148. aBitmap.Width := Width;
  6149. aBitmap.Height := Height;
  6150. case Format of
  6151. tfAlpha8ub1, tfLuminance8ub1: begin
  6152. aBitmap.PixelFormat := pf8bit;
  6153. aBitmap.Palette := CreateGrayPalette;
  6154. end;
  6155. tfRGB5A1us1:
  6156. aBitmap.PixelFormat := pf15bit;
  6157. tfR5G6B5us1:
  6158. aBitmap.PixelFormat := pf16bit;
  6159. tfRGB8ub3, tfBGR8ub3:
  6160. aBitmap.PixelFormat := pf24bit;
  6161. tfRGBA8ub4, tfBGRA8ub4:
  6162. aBitmap.PixelFormat := pf32bit;
  6163. else
  6164. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6165. end;
  6166. RowSize := FormatDescriptor.GetSize(Width, 1);
  6167. pSource := Data;
  6168. for Row := 0 to Height-1 do begin
  6169. pData := aBitmap.Scanline[Row];
  6170. Move(pSource^, pData^, RowSize);
  6171. Inc(pSource, RowSize);
  6172. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6173. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6174. end;
  6175. result := true;
  6176. end;
  6177. end;
  6178. end;
  6179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6180. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6181. var
  6182. pSource, pData, pTempData: PByte;
  6183. Row, RowSize, TempWidth, TempHeight: Integer;
  6184. IntFormat: TglBitmapFormat;
  6185. begin
  6186. result := false;
  6187. if (Assigned(aBitmap)) then begin
  6188. case aBitmap.PixelFormat of
  6189. pf8bit:
  6190. IntFormat := tfLuminance8ub1;
  6191. pf15bit:
  6192. IntFormat := tfRGB5A1us1;
  6193. pf16bit:
  6194. IntFormat := tfR5G6B5us1;
  6195. pf24bit:
  6196. IntFormat := tfBGR8ub3;
  6197. pf32bit:
  6198. IntFormat := tfBGRA8ub4;
  6199. else
  6200. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6201. end;
  6202. TempWidth := aBitmap.Width;
  6203. TempHeight := aBitmap.Height;
  6204. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6205. GetMem(pData, TempHeight * RowSize);
  6206. try
  6207. pTempData := pData;
  6208. for Row := 0 to TempHeight -1 do begin
  6209. pSource := aBitmap.Scanline[Row];
  6210. if (Assigned(pSource)) then begin
  6211. Move(pSource^, pTempData^, RowSize);
  6212. Inc(pTempData, RowSize);
  6213. end;
  6214. end;
  6215. SetData(pData, IntFormat, TempWidth, TempHeight);
  6216. result := true;
  6217. except
  6218. if Assigned(pData) then
  6219. FreeMem(pData);
  6220. raise;
  6221. end;
  6222. end;
  6223. end;
  6224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6225. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6226. var
  6227. Row, Col, AlphaInterleave: Integer;
  6228. pSource, pDest: PByte;
  6229. begin
  6230. result := false;
  6231. if Assigned(Data) then begin
  6232. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6233. if Assigned(aBitmap) then begin
  6234. aBitmap.PixelFormat := pf8bit;
  6235. aBitmap.Palette := CreateGrayPalette;
  6236. aBitmap.Width := Width;
  6237. aBitmap.Height := Height;
  6238. case Format of
  6239. tfLuminance8Alpha8ub2:
  6240. AlphaInterleave := 1;
  6241. tfRGBA8ub4, tfBGRA8ub4:
  6242. AlphaInterleave := 3;
  6243. else
  6244. AlphaInterleave := 0;
  6245. end;
  6246. // Copy Data
  6247. pSource := Data;
  6248. for Row := 0 to Height -1 do begin
  6249. pDest := aBitmap.Scanline[Row];
  6250. if Assigned(pDest) then begin
  6251. for Col := 0 to Width -1 do begin
  6252. Inc(pSource, AlphaInterleave);
  6253. pDest^ := pSource^;
  6254. Inc(pDest);
  6255. Inc(pSource);
  6256. end;
  6257. end;
  6258. end;
  6259. result := true;
  6260. end;
  6261. end;
  6262. end;
  6263. end;
  6264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6265. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6266. var
  6267. data: TglBitmapData;
  6268. begin
  6269. data := TglBitmapData.Create;
  6270. try
  6271. data.AssignFromBitmap(aBitmap);
  6272. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6273. finally
  6274. data.Free;
  6275. end;
  6276. end;
  6277. {$ENDIF}
  6278. {$IFDEF GLB_LAZARUS}
  6279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6280. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6281. var
  6282. rid: TRawImageDescription;
  6283. FormatDesc: TFormatDescriptor;
  6284. begin
  6285. if not Assigned(Data) then
  6286. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6287. result := false;
  6288. if not Assigned(aImage) or (Format = tfEmpty) then
  6289. exit;
  6290. FormatDesc := TFormatDescriptor.Get(Format);
  6291. if FormatDesc.IsCompressed then
  6292. exit;
  6293. FillChar(rid{%H-}, SizeOf(rid), 0);
  6294. if FormatDesc.IsGrayscale then
  6295. rid.Format := ricfGray
  6296. else
  6297. rid.Format := ricfRGBA;
  6298. rid.Width := Width;
  6299. rid.Height := Height;
  6300. rid.Depth := FormatDesc.BitsPerPixel;
  6301. rid.BitOrder := riboBitsInOrder;
  6302. rid.ByteOrder := riboLSBFirst;
  6303. rid.LineOrder := riloTopToBottom;
  6304. rid.LineEnd := rileTight;
  6305. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6306. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6307. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6308. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6309. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6310. rid.RedShift := FormatDesc.Shift.r;
  6311. rid.GreenShift := FormatDesc.Shift.g;
  6312. rid.BlueShift := FormatDesc.Shift.b;
  6313. rid.AlphaShift := FormatDesc.Shift.a;
  6314. rid.MaskBitsPerPixel := 0;
  6315. rid.PaletteColorCount := 0;
  6316. aImage.DataDescription := rid;
  6317. aImage.CreateData;
  6318. if not Assigned(aImage.PixelData) then
  6319. raise EglBitmap.Create('error while creating LazIntfImage');
  6320. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6321. result := true;
  6322. end;
  6323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6324. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6325. var
  6326. f: TglBitmapFormat;
  6327. FormatDesc: TFormatDescriptor;
  6328. ImageData: PByte;
  6329. ImageSize: Integer;
  6330. CanCopy: Boolean;
  6331. Mask: TglBitmapRec4ul;
  6332. procedure CopyConvert;
  6333. var
  6334. bfFormat: TbmpBitfieldFormat;
  6335. pSourceLine, pDestLine: PByte;
  6336. pSourceMD, pDestMD: Pointer;
  6337. Shift, Prec: TglBitmapRec4ub;
  6338. x, y: Integer;
  6339. pixel: TglBitmapPixelData;
  6340. begin
  6341. bfFormat := TbmpBitfieldFormat.Create;
  6342. with aImage.DataDescription do begin
  6343. Prec.r := RedPrec;
  6344. Prec.g := GreenPrec;
  6345. Prec.b := BluePrec;
  6346. Prec.a := AlphaPrec;
  6347. Shift.r := RedShift;
  6348. Shift.g := GreenShift;
  6349. Shift.b := BlueShift;
  6350. Shift.a := AlphaShift;
  6351. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6352. end;
  6353. pSourceMD := bfFormat.CreateMappingData;
  6354. pDestMD := FormatDesc.CreateMappingData;
  6355. try
  6356. for y := 0 to aImage.Height-1 do begin
  6357. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6358. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6359. for x := 0 to aImage.Width-1 do begin
  6360. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6361. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6362. end;
  6363. end;
  6364. finally
  6365. FormatDesc.FreeMappingData(pDestMD);
  6366. bfFormat.FreeMappingData(pSourceMD);
  6367. bfFormat.Free;
  6368. end;
  6369. end;
  6370. begin
  6371. result := false;
  6372. if not Assigned(aImage) then
  6373. exit;
  6374. with aImage.DataDescription do begin
  6375. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6376. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6377. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6378. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6379. end;
  6380. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6381. f := FormatDesc.Format;
  6382. if (f = tfEmpty) then
  6383. exit;
  6384. CanCopy :=
  6385. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6386. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6387. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6388. ImageData := GetMem(ImageSize);
  6389. try
  6390. if CanCopy then
  6391. Move(aImage.PixelData^, ImageData^, ImageSize)
  6392. else
  6393. CopyConvert;
  6394. SetData(ImageData, f, aImage.Width, aImage.Height);
  6395. except
  6396. if Assigned(ImageData) then
  6397. FreeMem(ImageData);
  6398. raise;
  6399. end;
  6400. result := true;
  6401. end;
  6402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6403. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6404. var
  6405. rid: TRawImageDescription;
  6406. FormatDesc: TFormatDescriptor;
  6407. Pixel: TglBitmapPixelData;
  6408. x, y: Integer;
  6409. srcMD: Pointer;
  6410. src, dst: PByte;
  6411. begin
  6412. result := false;
  6413. if not Assigned(aImage) or (Format = tfEmpty) then
  6414. exit;
  6415. FormatDesc := TFormatDescriptor.Get(Format);
  6416. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6417. exit;
  6418. FillChar(rid{%H-}, SizeOf(rid), 0);
  6419. rid.Format := ricfGray;
  6420. rid.Width := Width;
  6421. rid.Height := Height;
  6422. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6423. rid.BitOrder := riboBitsInOrder;
  6424. rid.ByteOrder := riboLSBFirst;
  6425. rid.LineOrder := riloTopToBottom;
  6426. rid.LineEnd := rileTight;
  6427. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6428. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6429. rid.GreenPrec := 0;
  6430. rid.BluePrec := 0;
  6431. rid.AlphaPrec := 0;
  6432. rid.RedShift := 0;
  6433. rid.GreenShift := 0;
  6434. rid.BlueShift := 0;
  6435. rid.AlphaShift := 0;
  6436. rid.MaskBitsPerPixel := 0;
  6437. rid.PaletteColorCount := 0;
  6438. aImage.DataDescription := rid;
  6439. aImage.CreateData;
  6440. srcMD := FormatDesc.CreateMappingData;
  6441. try
  6442. FormatDesc.PreparePixel(Pixel);
  6443. src := Data;
  6444. dst := aImage.PixelData;
  6445. for y := 0 to Height-1 do
  6446. for x := 0 to Width-1 do begin
  6447. FormatDesc.Unmap(src, Pixel, srcMD);
  6448. case rid.BitsPerPixel of
  6449. 8: begin
  6450. dst^ := Pixel.Data.a;
  6451. inc(dst);
  6452. end;
  6453. 16: begin
  6454. PWord(dst)^ := Pixel.Data.a;
  6455. inc(dst, 2);
  6456. end;
  6457. 24: begin
  6458. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6459. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6460. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6461. inc(dst, 3);
  6462. end;
  6463. 32: begin
  6464. PCardinal(dst)^ := Pixel.Data.a;
  6465. inc(dst, 4);
  6466. end;
  6467. else
  6468. raise EglBitmapUnsupportedFormat.Create(Format);
  6469. end;
  6470. end;
  6471. finally
  6472. FormatDesc.FreeMappingData(srcMD);
  6473. end;
  6474. result := true;
  6475. end;
  6476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6477. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6478. var
  6479. data: TglBitmapData;
  6480. begin
  6481. data := TglBitmapData.Create;
  6482. try
  6483. data.AssignFromLazIntfImage(aImage);
  6484. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6485. finally
  6486. data.Free;
  6487. end;
  6488. end;
  6489. {$ENDIF}
  6490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6491. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6492. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6493. var
  6494. rs: TResourceStream;
  6495. begin
  6496. PrepareResType(aResource, aResType);
  6497. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6498. try
  6499. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6500. finally
  6501. rs.Free;
  6502. end;
  6503. end;
  6504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6505. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6506. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6507. var
  6508. rs: TResourceStream;
  6509. begin
  6510. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6511. try
  6512. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6513. finally
  6514. rs.Free;
  6515. end;
  6516. end;
  6517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6518. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6519. begin
  6520. if TFormatDescriptor.Get(Format).IsCompressed then
  6521. raise EglBitmapUnsupportedFormat.Create(Format);
  6522. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6523. end;
  6524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6525. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6526. var
  6527. FS: TFileStream;
  6528. begin
  6529. FS := TFileStream.Create(aFileName, fmOpenRead);
  6530. try
  6531. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6532. finally
  6533. FS.Free;
  6534. end;
  6535. end;
  6536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6537. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6538. var
  6539. data: TglBitmapData;
  6540. begin
  6541. data := TglBitmapData.Create(aStream);
  6542. try
  6543. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6544. finally
  6545. data.Free;
  6546. end;
  6547. end;
  6548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6549. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6550. var
  6551. DestData, DestData2, SourceData: pByte;
  6552. TempHeight, TempWidth: Integer;
  6553. SourceFD, DestFD: TFormatDescriptor;
  6554. SourceMD, DestMD, DestMD2: Pointer;
  6555. FuncRec: TglBitmapFunctionRec;
  6556. begin
  6557. result := false;
  6558. Assert(Assigned(Data));
  6559. Assert(Assigned(aDataObj));
  6560. Assert(Assigned(aDataObj.Data));
  6561. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6562. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6563. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6564. DestFD := TFormatDescriptor.Get(Format);
  6565. if not Assigned(aFunc) then begin
  6566. aFunc := glBitmapAlphaFunc;
  6567. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6568. end else
  6569. FuncRec.Args := aArgs;
  6570. // Values
  6571. TempWidth := aDataObj.Width;
  6572. TempHeight := aDataObj.Height;
  6573. if (TempWidth <= 0) or (TempHeight <= 0) then
  6574. exit;
  6575. FuncRec.Sender := Self;
  6576. FuncRec.Size := Dimension;
  6577. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6578. DestData := Data;
  6579. DestData2 := Data;
  6580. SourceData := aDataObj.Data;
  6581. // Mapping
  6582. SourceFD.PreparePixel(FuncRec.Source);
  6583. DestFD.PreparePixel (FuncRec.Dest);
  6584. SourceMD := SourceFD.CreateMappingData;
  6585. DestMD := DestFD.CreateMappingData;
  6586. DestMD2 := DestFD.CreateMappingData;
  6587. try
  6588. FuncRec.Position.Y := 0;
  6589. while FuncRec.Position.Y < TempHeight do begin
  6590. FuncRec.Position.X := 0;
  6591. while FuncRec.Position.X < TempWidth do begin
  6592. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6593. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6594. aFunc(FuncRec);
  6595. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6596. inc(FuncRec.Position.X);
  6597. end;
  6598. inc(FuncRec.Position.Y);
  6599. end;
  6600. finally
  6601. SourceFD.FreeMappingData(SourceMD);
  6602. DestFD.FreeMappingData(DestMD);
  6603. DestFD.FreeMappingData(DestMD2);
  6604. end;
  6605. end;
  6606. end;
  6607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6608. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6609. begin
  6610. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6611. end;
  6612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6613. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6614. var
  6615. PixelData: TglBitmapPixelData;
  6616. begin
  6617. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6618. result := AddAlphaFromColorKeyFloat(
  6619. aRed / PixelData.Range.r,
  6620. aGreen / PixelData.Range.g,
  6621. aBlue / PixelData.Range.b,
  6622. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6623. end;
  6624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6625. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6626. var
  6627. values: array[0..2] of Single;
  6628. tmp: Cardinal;
  6629. i: Integer;
  6630. PixelData: TglBitmapPixelData;
  6631. begin
  6632. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6633. with PixelData do begin
  6634. values[0] := aRed;
  6635. values[1] := aGreen;
  6636. values[2] := aBlue;
  6637. for i := 0 to 2 do begin
  6638. tmp := Trunc(Range.arr[i] * aDeviation);
  6639. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6640. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6641. end;
  6642. Data.a := 0;
  6643. Range.a := 0;
  6644. end;
  6645. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6646. end;
  6647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6648. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6649. begin
  6650. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6651. end;
  6652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6653. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6654. var
  6655. PixelData: TglBitmapPixelData;
  6656. begin
  6657. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6658. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6659. end;
  6660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6661. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6662. var
  6663. PixelData: TglBitmapPixelData;
  6664. begin
  6665. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6666. with PixelData do
  6667. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6668. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6669. end;
  6670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6671. function TglBitmapData.RemoveAlpha: Boolean;
  6672. var
  6673. FormatDesc: TFormatDescriptor;
  6674. begin
  6675. result := false;
  6676. FormatDesc := TFormatDescriptor.Get(Format);
  6677. if Assigned(Data) then begin
  6678. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6679. raise EglBitmapUnsupportedFormat.Create(Format);
  6680. result := ConvertTo(FormatDesc.WithoutAlpha);
  6681. end;
  6682. end;
  6683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6684. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6685. const aAlpha: Byte);
  6686. begin
  6687. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6688. end;
  6689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6690. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6691. var
  6692. PixelData: TglBitmapPixelData;
  6693. begin
  6694. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6695. FillWithColorFloat(
  6696. aRed / PixelData.Range.r,
  6697. aGreen / PixelData.Range.g,
  6698. aBlue / PixelData.Range.b,
  6699. aAlpha / PixelData.Range.a);
  6700. end;
  6701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6702. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6703. var
  6704. PixelData: TglBitmapPixelData;
  6705. begin
  6706. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6707. with PixelData do begin
  6708. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6709. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6710. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6711. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6712. end;
  6713. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6714. end;
  6715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6716. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6717. begin
  6718. if (Data <> aData) then begin
  6719. if (Assigned(Data)) then
  6720. FreeMem(Data);
  6721. fData := aData;
  6722. end;
  6723. if Assigned(fData) then begin
  6724. FillChar(fDimension, SizeOf(fDimension), 0);
  6725. if aWidth <> -1 then begin
  6726. fDimension.Fields := fDimension.Fields + [ffX];
  6727. fDimension.X := aWidth;
  6728. end;
  6729. if aHeight <> -1 then begin
  6730. fDimension.Fields := fDimension.Fields + [ffY];
  6731. fDimension.Y := aHeight;
  6732. end;
  6733. fFormat := aFormat;
  6734. end else
  6735. fFormat := tfEmpty;
  6736. UpdateScanlines;
  6737. end;
  6738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6739. function TglBitmapData.Clone: TglBitmapData;
  6740. var
  6741. Temp: TglBitmapData;
  6742. TempPtr: PByte;
  6743. Size: Integer;
  6744. begin
  6745. result := nil;
  6746. Temp := (ClassType.Create as TglBitmapData);
  6747. try
  6748. // copy texture data if assigned
  6749. if Assigned(Data) then begin
  6750. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6751. GetMem(TempPtr, Size);
  6752. try
  6753. Move(Data^, TempPtr^, Size);
  6754. Temp.SetData(TempPtr, Format, Width, Height);
  6755. except
  6756. if Assigned(TempPtr) then
  6757. FreeMem(TempPtr);
  6758. raise;
  6759. end;
  6760. end else begin
  6761. TempPtr := nil;
  6762. Temp.SetData(TempPtr, Format, Width, Height);
  6763. end;
  6764. // copy properties
  6765. Temp.fFormat := Format;
  6766. result := Temp;
  6767. except
  6768. FreeAndNil(Temp);
  6769. raise;
  6770. end;
  6771. end;
  6772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6773. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6774. var
  6775. mask: PtrInt;
  6776. begin
  6777. mask :=
  6778. (Byte(aRed) and 1) or
  6779. ((Byte(aGreen) and 1) shl 1) or
  6780. ((Byte(aBlue) and 1) shl 2) or
  6781. ((Byte(aAlpha) and 1) shl 3);
  6782. if (mask > 0) then
  6783. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6784. end;
  6785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6786. type
  6787. TMatrixItem = record
  6788. X, Y: Integer;
  6789. W: Single;
  6790. end;
  6791. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6792. TglBitmapToNormalMapRec = Record
  6793. Scale: Single;
  6794. Heights: array of Single;
  6795. MatrixU : array of TMatrixItem;
  6796. MatrixV : array of TMatrixItem;
  6797. end;
  6798. const
  6799. ONE_OVER_255 = 1 / 255;
  6800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6801. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6802. var
  6803. Val: Single;
  6804. begin
  6805. with FuncRec do begin
  6806. Val :=
  6807. Source.Data.r * LUMINANCE_WEIGHT_R +
  6808. Source.Data.g * LUMINANCE_WEIGHT_G +
  6809. Source.Data.b * LUMINANCE_WEIGHT_B;
  6810. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6811. end;
  6812. end;
  6813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6814. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6815. begin
  6816. with FuncRec do
  6817. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6818. end;
  6819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6820. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6821. type
  6822. TVec = Array[0..2] of Single;
  6823. var
  6824. Idx: Integer;
  6825. du, dv: Double;
  6826. Len: Single;
  6827. Vec: TVec;
  6828. function GetHeight(X, Y: Integer): Single;
  6829. begin
  6830. with FuncRec do begin
  6831. X := Max(0, Min(Size.X -1, X));
  6832. Y := Max(0, Min(Size.Y -1, Y));
  6833. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6834. end;
  6835. end;
  6836. begin
  6837. with FuncRec do begin
  6838. with PglBitmapToNormalMapRec(Args)^ do begin
  6839. du := 0;
  6840. for Idx := Low(MatrixU) to High(MatrixU) do
  6841. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6842. dv := 0;
  6843. for Idx := Low(MatrixU) to High(MatrixU) do
  6844. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6845. Vec[0] := -du * Scale;
  6846. Vec[1] := -dv * Scale;
  6847. Vec[2] := 1;
  6848. end;
  6849. // Normalize
  6850. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6851. if Len <> 0 then begin
  6852. Vec[0] := Vec[0] * Len;
  6853. Vec[1] := Vec[1] * Len;
  6854. Vec[2] := Vec[2] * Len;
  6855. end;
  6856. // Farbe zuweisem
  6857. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6858. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6859. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6860. end;
  6861. end;
  6862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6863. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6864. var
  6865. Rec: TglBitmapToNormalMapRec;
  6866. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6867. begin
  6868. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6869. Matrix[Index].X := X;
  6870. Matrix[Index].Y := Y;
  6871. Matrix[Index].W := W;
  6872. end;
  6873. end;
  6874. begin
  6875. if TFormatDescriptor.Get(Format).IsCompressed then
  6876. raise EglBitmapUnsupportedFormat.Create(Format);
  6877. if aScale > 100 then
  6878. Rec.Scale := 100
  6879. else if aScale < -100 then
  6880. Rec.Scale := -100
  6881. else
  6882. Rec.Scale := aScale;
  6883. SetLength(Rec.Heights, Width * Height);
  6884. try
  6885. case aFunc of
  6886. nm4Samples: begin
  6887. SetLength(Rec.MatrixU, 2);
  6888. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6889. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6890. SetLength(Rec.MatrixV, 2);
  6891. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6892. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6893. end;
  6894. nmSobel: begin
  6895. SetLength(Rec.MatrixU, 6);
  6896. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6897. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6898. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6899. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6900. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6901. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6902. SetLength(Rec.MatrixV, 6);
  6903. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6904. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6905. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6906. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6907. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6908. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6909. end;
  6910. nm3x3: begin
  6911. SetLength(Rec.MatrixU, 6);
  6912. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6913. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6914. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6915. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6916. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6917. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6918. SetLength(Rec.MatrixV, 6);
  6919. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6920. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6921. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6922. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6923. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6924. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6925. end;
  6926. nm5x5: begin
  6927. SetLength(Rec.MatrixU, 20);
  6928. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6929. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6930. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6931. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6932. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6933. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6934. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6935. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6936. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6937. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6938. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6939. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6940. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6941. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6942. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6943. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6944. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6945. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6946. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6947. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6948. SetLength(Rec.MatrixV, 20);
  6949. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6950. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6951. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6952. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6953. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6954. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6955. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6956. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6957. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6958. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6959. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6960. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6961. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6962. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6963. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6964. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6965. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6966. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6967. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6968. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6969. end;
  6970. end;
  6971. // Daten Sammeln
  6972. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6973. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6974. else
  6975. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6976. Convert(glBitmapToNormalMapFunc, false, @Rec);
  6977. finally
  6978. SetLength(Rec.Heights, 0);
  6979. end;
  6980. end;
  6981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6982. constructor TglBitmapData.Create;
  6983. begin
  6984. inherited Create;
  6985. fFormat := glBitmapDefaultFormat;
  6986. end;
  6987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6988. constructor TglBitmapData.Create(const aFileName: String);
  6989. begin
  6990. Create;
  6991. LoadFromFile(aFileName);
  6992. end;
  6993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6994. constructor TglBitmapData.Create(const aStream: TStream);
  6995. begin
  6996. Create;
  6997. LoadFromStream(aStream);
  6998. end;
  6999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7000. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  7001. var
  7002. ImageSize: Integer;
  7003. begin
  7004. Create;
  7005. if not Assigned(aData) then begin
  7006. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7007. GetMem(aData, ImageSize);
  7008. try
  7009. FillChar(aData^, ImageSize, #$FF);
  7010. SetData(aData, aFormat, aSize.X, aSize.Y);
  7011. except
  7012. if Assigned(aData) then
  7013. FreeMem(aData);
  7014. raise;
  7015. end;
  7016. end else begin
  7017. SetData(aData, aFormat, aSize.X, aSize.Y);
  7018. end;
  7019. end;
  7020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7021. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7022. begin
  7023. Create;
  7024. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7025. end;
  7026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7027. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7028. begin
  7029. Create;
  7030. LoadFromResource(aInstance, aResource, aResType);
  7031. end;
  7032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7033. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7034. begin
  7035. Create;
  7036. LoadFromResourceID(aInstance, aResourceID, aResType);
  7037. end;
  7038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7039. destructor TglBitmapData.Destroy;
  7040. begin
  7041. SetData(nil, tfEmpty);
  7042. inherited Destroy;
  7043. end;
  7044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7045. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7047. function TglBitmap.GetWidth: Integer;
  7048. begin
  7049. if (ffX in fDimension.Fields) then
  7050. result := fDimension.X
  7051. else
  7052. result := -1;
  7053. end;
  7054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7055. function TglBitmap.GetHeight: Integer;
  7056. begin
  7057. if (ffY in fDimension.Fields) then
  7058. result := fDimension.Y
  7059. else
  7060. result := -1;
  7061. end;
  7062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7063. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7064. begin
  7065. if fCustomData = aValue then
  7066. exit;
  7067. fCustomData := aValue;
  7068. end;
  7069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7070. procedure TglBitmap.SetCustomName(const aValue: String);
  7071. begin
  7072. if fCustomName = aValue then
  7073. exit;
  7074. fCustomName := aValue;
  7075. end;
  7076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7077. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7078. begin
  7079. if fCustomNameW = aValue then
  7080. exit;
  7081. fCustomNameW := aValue;
  7082. end;
  7083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7084. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7085. begin
  7086. if fDeleteTextureOnFree = aValue then
  7087. exit;
  7088. fDeleteTextureOnFree := aValue;
  7089. end;
  7090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7091. procedure TglBitmap.SetID(const aValue: Cardinal);
  7092. begin
  7093. if fID = aValue then
  7094. exit;
  7095. fID := aValue;
  7096. end;
  7097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7098. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7099. begin
  7100. if fMipMap = aValue then
  7101. exit;
  7102. fMipMap := aValue;
  7103. end;
  7104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7105. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7106. begin
  7107. if fTarget = aValue then
  7108. exit;
  7109. fTarget := aValue;
  7110. end;
  7111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7112. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7113. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7114. var
  7115. MaxAnisotropic: Integer;
  7116. {$IFEND}
  7117. begin
  7118. fAnisotropic := aValue;
  7119. if (ID > 0) then begin
  7120. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7121. if GL_EXT_texture_filter_anisotropic then begin
  7122. if fAnisotropic > 0 then begin
  7123. Bind(false);
  7124. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7125. if aValue > MaxAnisotropic then
  7126. fAnisotropic := MaxAnisotropic;
  7127. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7128. end;
  7129. end else begin
  7130. fAnisotropic := 0;
  7131. end;
  7132. {$ELSE}
  7133. fAnisotropic := 0;
  7134. {$IFEND}
  7135. end;
  7136. end;
  7137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7138. procedure TglBitmap.CreateID;
  7139. begin
  7140. if (ID <> 0) then
  7141. glDeleteTextures(1, @fID);
  7142. glGenTextures(1, @fID);
  7143. Bind(false);
  7144. end;
  7145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7146. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  7147. begin
  7148. // Set Up Parameters
  7149. SetWrap(fWrapS, fWrapT, fWrapR);
  7150. SetFilter(fFilterMin, fFilterMag);
  7151. SetAnisotropic(fAnisotropic);
  7152. {$IFNDEF OPENGL_ES}
  7153. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7154. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7155. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7156. {$ENDIF}
  7157. {$IFNDEF OPENGL_ES}
  7158. // Mip Maps Generation Mode
  7159. aBuildWithGlu := false;
  7160. if (MipMap = mmMipmap) then begin
  7161. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  7162. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  7163. else
  7164. aBuildWithGlu := true;
  7165. end else if (MipMap = mmMipmapGlu) then
  7166. aBuildWithGlu := true;
  7167. {$ELSE}
  7168. if (MipMap = mmMipmap) then
  7169. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  7170. {$ENDIF}
  7171. end;
  7172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7173. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7175. procedure TglBitmap.AfterConstruction;
  7176. begin
  7177. inherited AfterConstruction;
  7178. fID := 0;
  7179. fTarget := 0;
  7180. {$IFNDEF OPENGL_ES}
  7181. fIsResident := false;
  7182. {$ENDIF}
  7183. fMipMap := glBitmapDefaultMipmap;
  7184. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7185. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7186. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7187. {$IFNDEF OPENGL_ES}
  7188. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7189. {$ENDIF}
  7190. end;
  7191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7192. procedure TglBitmap.BeforeDestruction;
  7193. begin
  7194. if (fID > 0) and fDeleteTextureOnFree then
  7195. glDeleteTextures(1, @fID);
  7196. inherited BeforeDestruction;
  7197. end;
  7198. {$IFNDEF OPENGL_ES}
  7199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7200. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7201. begin
  7202. fBorderColor[0] := aRed;
  7203. fBorderColor[1] := aGreen;
  7204. fBorderColor[2] := aBlue;
  7205. fBorderColor[3] := aAlpha;
  7206. if (ID > 0) then begin
  7207. Bind(false);
  7208. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7209. end;
  7210. end;
  7211. {$ENDIF}
  7212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7213. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7214. begin
  7215. //check MIN filter
  7216. case aMin of
  7217. GL_NEAREST:
  7218. fFilterMin := GL_NEAREST;
  7219. GL_LINEAR:
  7220. fFilterMin := GL_LINEAR;
  7221. GL_NEAREST_MIPMAP_NEAREST:
  7222. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7223. GL_LINEAR_MIPMAP_NEAREST:
  7224. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7225. GL_NEAREST_MIPMAP_LINEAR:
  7226. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7227. GL_LINEAR_MIPMAP_LINEAR:
  7228. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7229. else
  7230. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7231. end;
  7232. //check MAG filter
  7233. case aMag of
  7234. GL_NEAREST:
  7235. fFilterMag := GL_NEAREST;
  7236. GL_LINEAR:
  7237. fFilterMag := GL_LINEAR;
  7238. else
  7239. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7240. end;
  7241. //apply filter
  7242. if (ID > 0) then begin
  7243. Bind(false);
  7244. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7245. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7246. case fFilterMin of
  7247. GL_NEAREST, GL_LINEAR:
  7248. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7249. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7250. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7251. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7252. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7253. end;
  7254. end else
  7255. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7256. end;
  7257. end;
  7258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7259. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7260. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7261. begin
  7262. case aValue of
  7263. {$IFNDEF OPENGL_ES}
  7264. GL_CLAMP:
  7265. aTarget := GL_CLAMP;
  7266. {$ENDIF}
  7267. GL_REPEAT:
  7268. aTarget := GL_REPEAT;
  7269. GL_CLAMP_TO_EDGE: begin
  7270. {$IFNDEF OPENGL_ES}
  7271. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7272. aTarget := GL_CLAMP
  7273. else
  7274. {$ENDIF}
  7275. aTarget := GL_CLAMP_TO_EDGE;
  7276. end;
  7277. {$IFNDEF OPENGL_ES}
  7278. GL_CLAMP_TO_BORDER: begin
  7279. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7280. aTarget := GL_CLAMP_TO_BORDER
  7281. else
  7282. aTarget := GL_CLAMP;
  7283. end;
  7284. {$ENDIF}
  7285. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7286. GL_MIRRORED_REPEAT: begin
  7287. {$IFNDEF OPENGL_ES}
  7288. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7289. {$ELSE}
  7290. if GL_VERSION_2_0 then
  7291. {$ENDIF}
  7292. aTarget := GL_MIRRORED_REPEAT
  7293. else
  7294. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7295. end;
  7296. {$IFEND}
  7297. else
  7298. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7299. end;
  7300. end;
  7301. begin
  7302. CheckAndSetWrap(S, fWrapS);
  7303. CheckAndSetWrap(T, fWrapT);
  7304. CheckAndSetWrap(R, fWrapR);
  7305. if (ID > 0) then begin
  7306. Bind(false);
  7307. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7308. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7309. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7310. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7311. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7312. {$IFEND}
  7313. end;
  7314. end;
  7315. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7317. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7318. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7319. begin
  7320. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7321. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7322. fSwizzle[aIndex] := aValue
  7323. else
  7324. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7325. end;
  7326. begin
  7327. {$IFNDEF OPENGL_ES}
  7328. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7329. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7330. {$ELSE}
  7331. if not GL_VERSION_3_0 then
  7332. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7333. {$ENDIF}
  7334. CheckAndSetValue(r, 0);
  7335. CheckAndSetValue(g, 1);
  7336. CheckAndSetValue(b, 2);
  7337. CheckAndSetValue(a, 3);
  7338. if (ID > 0) then begin
  7339. Bind(false);
  7340. {$IFNDEF OPENGL_ES}
  7341. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7342. {$ELSE}
  7343. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7344. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7345. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7346. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7347. {$ENDIF}
  7348. end;
  7349. end;
  7350. {$IFEND}
  7351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7352. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  7353. begin
  7354. if aEnableTextureUnit then
  7355. glEnable(Target);
  7356. if (ID > 0) then
  7357. glBindTexture(Target, ID);
  7358. end;
  7359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7360. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  7361. begin
  7362. if aDisableTextureUnit then
  7363. glDisable(Target);
  7364. glBindTexture(Target, 0);
  7365. end;
  7366. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7367. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7368. var
  7369. w, h: Integer;
  7370. begin
  7371. w := aDataObj.Width;
  7372. h := aDataObj.Height;
  7373. fDimension.Fields := [];
  7374. if (w > 0) then
  7375. fDimension.Fields := fDimension.Fields + [ffX];
  7376. if (h > 0) then
  7377. fDimension.Fields := fDimension.Fields + [ffY];
  7378. fDimension.X := w;
  7379. fDimension.Y := h;
  7380. end;
  7381. {$IFNDEF OPENGL_ES}
  7382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7383. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7384. var
  7385. Temp: PByte;
  7386. TempWidth, TempHeight: Integer;
  7387. TempIntFormat: GLint;
  7388. IntFormat: TglBitmapFormat;
  7389. FormatDesc: TFormatDescriptor;
  7390. begin
  7391. result := false;
  7392. Bind;
  7393. // Request Data
  7394. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7395. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7396. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7397. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7398. IntFormat := FormatDesc.Format;
  7399. // Getting data from OpenGL
  7400. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7401. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7402. try
  7403. if FormatDesc.IsCompressed then begin
  7404. if not Assigned(glGetCompressedTexImage) then
  7405. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7406. glGetCompressedTexImage(Target, 0, Temp)
  7407. end else
  7408. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7409. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7410. result := true;
  7411. except
  7412. if Assigned(Temp) then
  7413. FreeMem(Temp);
  7414. raise;
  7415. end;
  7416. end;
  7417. {$ENDIF}
  7418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7419. constructor TglBitmap.Create;
  7420. begin
  7421. if (ClassType = TglBitmap) then
  7422. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7423. inherited Create;
  7424. end;
  7425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7426. constructor TglBitmap.Create(const aData: TglBitmapData);
  7427. begin
  7428. Create;
  7429. UploadData(aData);
  7430. end;
  7431. {$IFNDEF OPENGL_ES}
  7432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7433. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7435. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  7436. var
  7437. fd: TglBitmapFormatDescriptor;
  7438. begin
  7439. // Upload data
  7440. fd := aDataObj.FormatDescriptor;
  7441. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7442. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7443. if fd.IsCompressed then begin
  7444. if not Assigned(glCompressedTexImage1D) then
  7445. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7446. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
  7447. end else if aBuildWithGlu then
  7448. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7449. else
  7450. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7451. end;
  7452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7453. procedure TglBitmap1D.AfterConstruction;
  7454. begin
  7455. inherited;
  7456. Target := GL_TEXTURE_1D;
  7457. end;
  7458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7459. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7460. var
  7461. BuildWithGlu, TexRec: Boolean;
  7462. TexSize: Integer;
  7463. begin
  7464. if not Assigned(aDataObj) then
  7465. exit;
  7466. // Check Texture Size
  7467. if (aCheckSize) then begin
  7468. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7469. if (aDataObj.Width > TexSize) then
  7470. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7471. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7472. (Target = GL_TEXTURE_RECTANGLE);
  7473. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7474. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7475. end;
  7476. if (fID = 0) then
  7477. CreateID;
  7478. SetupParameters(BuildWithGlu);
  7479. UploadDataIntern(aDataObj, BuildWithGlu);
  7480. glAreTexturesResident(1, @fID, @fIsResident);
  7481. inherited UploadData(aDataObj, aCheckSize);
  7482. end;
  7483. {$ENDIF}
  7484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7485. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7487. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7488. var
  7489. fd: TglBitmapFormatDescriptor;
  7490. begin
  7491. fd := aDataObj.FormatDescriptor;
  7492. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7493. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7494. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7495. if fd.IsCompressed then begin
  7496. if not Assigned(glCompressedTexImage2D) then
  7497. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7498. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
  7499. {$IFNDEF OPENGL_ES}
  7500. end else if aBuildWithGlu then begin
  7501. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7502. {$ENDIF}
  7503. end else begin
  7504. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7505. end;
  7506. end;
  7507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7508. procedure TglBitmap2D.AfterConstruction;
  7509. begin
  7510. inherited;
  7511. Target := GL_TEXTURE_2D;
  7512. end;
  7513. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7514. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7515. var
  7516. {$IFNDEF OPENGL_ES}
  7517. BuildWithGlu, TexRec: Boolean;
  7518. {$ENDIF}
  7519. PotTex: Boolean;
  7520. TexSize: Integer;
  7521. begin
  7522. if not Assigned(aDataObj) then
  7523. exit;
  7524. // Check Texture Size
  7525. if (aCheckSize) then begin
  7526. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7527. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7528. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7529. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7530. {$IF NOT DEFINED(OPENGL_ES)}
  7531. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7532. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7533. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7534. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7535. if not PotTex and not GL_OES_texture_npot then
  7536. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7537. {$ELSE}
  7538. if not PotTex then
  7539. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7540. {$IFEND}
  7541. end;
  7542. if (fID = 0) then
  7543. CreateID;
  7544. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7545. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7546. {$IFNDEF OPENGL_ES}
  7547. glAreTexturesResident(1, @fID, @fIsResident);
  7548. {$ENDIF}
  7549. inherited UploadData(aDataObj, aCheckSize);
  7550. end;
  7551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7552. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7553. var
  7554. Temp: pByte;
  7555. Size, w, h: Integer;
  7556. FormatDesc: TFormatDescriptor;
  7557. begin
  7558. FormatDesc := TFormatDescriptor.Get(aFormat);
  7559. if FormatDesc.IsCompressed then
  7560. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7561. w := aRight - aLeft;
  7562. h := aBottom - aTop;
  7563. Size := FormatDesc.GetSize(w, h);
  7564. GetMem(Temp, Size);
  7565. try
  7566. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7567. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7568. aDataObj.SetData(Temp, aFormat, w, h);
  7569. aDataObj.FlipVert;
  7570. except
  7571. if Assigned(Temp) then
  7572. FreeMem(Temp);
  7573. raise;
  7574. end;
  7575. end;
  7576. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7578. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7580. procedure TglBitmapCubeMap.AfterConstruction;
  7581. begin
  7582. inherited;
  7583. {$IFNDEF OPENGL_ES}
  7584. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7585. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7586. {$ELSE}
  7587. if not (GL_VERSION_2_0) then
  7588. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7589. {$ENDIF}
  7590. SetWrap;
  7591. Target := GL_TEXTURE_CUBE_MAP;
  7592. {$IFNDEF OPENGL_ES}
  7593. fGenMode := GL_REFLECTION_MAP;
  7594. {$ENDIF}
  7595. end;
  7596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7597. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7598. begin
  7599. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7600. end;
  7601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7602. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7603. var
  7604. {$IFNDEF OPENGL_ES}
  7605. BuildWithGlu: Boolean;
  7606. {$ENDIF}
  7607. TexSize: Integer;
  7608. begin
  7609. if (aCheckSize) then begin
  7610. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7611. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7612. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7613. {$IF NOT DEFINED(OPENGL_ES)}
  7614. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7615. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7616. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7617. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7618. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7619. {$ELSE}
  7620. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7621. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7622. {$IFEND}
  7623. end;
  7624. if (fID = 0) then
  7625. CreateID;
  7626. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7627. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7628. inherited UploadData(aDataObj, aCheckSize);
  7629. end;
  7630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7631. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7632. begin
  7633. inherited Bind (aEnableTextureUnit);
  7634. {$IFNDEF OPENGL_ES}
  7635. if aEnableTexCoordsGen then begin
  7636. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7637. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7638. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7639. glEnable(GL_TEXTURE_GEN_S);
  7640. glEnable(GL_TEXTURE_GEN_T);
  7641. glEnable(GL_TEXTURE_GEN_R);
  7642. end;
  7643. {$ENDIF}
  7644. end;
  7645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7646. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7647. begin
  7648. inherited Unbind(aDisableTextureUnit);
  7649. {$IFNDEF OPENGL_ES}
  7650. if aDisableTexCoordsGen then begin
  7651. glDisable(GL_TEXTURE_GEN_S);
  7652. glDisable(GL_TEXTURE_GEN_T);
  7653. glDisable(GL_TEXTURE_GEN_R);
  7654. end;
  7655. {$ENDIF}
  7656. end;
  7657. {$IFEND}
  7658. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7660. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7662. type
  7663. TVec = Array[0..2] of Single;
  7664. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7665. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7666. TglBitmapNormalMapRec = record
  7667. HalfSize : Integer;
  7668. Func: TglBitmapNormalMapGetVectorFunc;
  7669. end;
  7670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7671. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7672. begin
  7673. aVec[0] := aHalfSize;
  7674. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7675. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7676. end;
  7677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7678. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7679. begin
  7680. aVec[0] := - aHalfSize;
  7681. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7682. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7683. end;
  7684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7685. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7686. begin
  7687. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7688. aVec[1] := aHalfSize;
  7689. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7690. end;
  7691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7692. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7693. begin
  7694. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7695. aVec[1] := - aHalfSize;
  7696. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7697. end;
  7698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7699. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7700. begin
  7701. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7702. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7703. aVec[2] := aHalfSize;
  7704. end;
  7705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7706. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7707. begin
  7708. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7709. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7710. aVec[2] := - aHalfSize;
  7711. end;
  7712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7713. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7714. var
  7715. i: Integer;
  7716. Vec: TVec;
  7717. Len: Single;
  7718. begin
  7719. with FuncRec do begin
  7720. with PglBitmapNormalMapRec(Args)^ do begin
  7721. Func(Vec, Position, HalfSize);
  7722. // Normalize
  7723. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7724. if Len <> 0 then begin
  7725. Vec[0] := Vec[0] * Len;
  7726. Vec[1] := Vec[1] * Len;
  7727. Vec[2] := Vec[2] * Len;
  7728. end;
  7729. // Scale Vector and AddVectro
  7730. Vec[0] := Vec[0] * 0.5 + 0.5;
  7731. Vec[1] := Vec[1] * 0.5 + 0.5;
  7732. Vec[2] := Vec[2] * 0.5 + 0.5;
  7733. end;
  7734. // Set Color
  7735. for i := 0 to 2 do
  7736. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7737. end;
  7738. end;
  7739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7740. procedure TglBitmapNormalMap.AfterConstruction;
  7741. begin
  7742. inherited;
  7743. {$IFNDEF OPENGL_ES}
  7744. fGenMode := GL_NORMAL_MAP;
  7745. {$ENDIF}
  7746. end;
  7747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7748. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7749. var
  7750. Rec: TglBitmapNormalMapRec;
  7751. SizeRec: TglBitmapSize;
  7752. DataObj: TglBitmapData;
  7753. begin
  7754. Rec.HalfSize := aSize div 2;
  7755. SizeRec.Fields := [ffX, ffY];
  7756. SizeRec.X := aSize;
  7757. SizeRec.Y := aSize;
  7758. DataObj := TglBitmapData.Create;
  7759. try
  7760. // Positive X
  7761. Rec.Func := glBitmapNormalMapPosX;
  7762. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7763. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7764. // Negative X
  7765. Rec.Func := glBitmapNormalMapNegX;
  7766. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7767. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7768. // Positive Y
  7769. Rec.Func := glBitmapNormalMapPosY;
  7770. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7771. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7772. // Negative Y
  7773. Rec.Func := glBitmapNormalMapNegY;
  7774. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7775. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7776. // Positive Z
  7777. Rec.Func := glBitmapNormalMapPosZ;
  7778. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7779. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7780. // Negative Z
  7781. Rec.Func := glBitmapNormalMapNegZ;
  7782. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7783. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7784. finally
  7785. FreeAndNil(DataObj);
  7786. end;
  7787. end;
  7788. {$IFEND}
  7789. initialization
  7790. glBitmapSetDefaultFormat (tfEmpty);
  7791. glBitmapSetDefaultMipmap (mmMipmap);
  7792. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7793. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7794. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7795. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7796. {$IFEND}
  7797. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7798. glBitmapSetDefaultDeleteTextureOnFree (true);
  7799. TFormatDescriptor.Init;
  7800. finalization
  7801. TFormatDescriptor.Finalize;
  7802. end.