DSPack.pas 216 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948
  1. (*********************************************************************
  2. * DSPack 2.3.3 *
  3. * *
  4. * home page : http://www.progdigy.com *
  5. * email : hgourvest@progdigy.com *
  6. * Thanks to Michael Andersen. (DSVideoWindowEx) *
  7. * *
  8. * date : 2003-09-08 *
  9. * *
  10. * The contents of this file are used with permission, subject to *
  11. * the Mozilla Public License Version 1.1 (the "License"); you may *
  12. * not use this file except in compliance with the License. You may *
  13. * obtain a copy of the License at *
  14. * http://www.mozilla.org/MPL/MPL-1.1.html *
  15. * *
  16. * Software distributed under the License is distributed on an *
  17. * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or *
  18. * implied. See the License for the specific language governing *
  19. * rights and limitations under the License. *
  20. * *
  21. * Contributor(s) *
  22. * Peter J. Haas <DSPack@pjh2.de> *
  23. * Andriy Nevhasymyy <a.n@email.com> *
  24. * Milenko Mitrovic <dcoder@dsp-worx.de> *
  25. * Michael Andersen <michael@mechdata.dk> *
  26. * Martin Offenwanger <coder@dsplayer.de> *
  27. * *
  28. *********************************************************************)
  29. {
  30. @abstract(DSPack Components.)
  31. @author(Henri Gourvest: hgourvest@progdigy.com)
  32. @created(Mar 14, 2002)
  33. @lastmod(Oct 24, 2003)
  34. }
  35. {$I jedi.inc}
  36. {$IFDEF COMPILER6_UP}
  37. {$WARN SYMBOL_DEPRECATED OFF}
  38. {$ENDIF}
  39. {$IFDEF COMPILER7_UP}
  40. {$WARN SYMBOL_DEPRECATED OFF}
  41. {$WARN UNSAFE_CODE OFF}
  42. {$WARN UNSAFE_TYPE OFF}
  43. {$WARN UNSAFE_CAST OFF}
  44. {$ENDIF}
  45. {$ALIGN ON}
  46. {$MINENUMSIZE 4}
  47. unit DSPack;
  48. interface
  49. uses
  50. Windows, Classes, SysUtils, Messages, Graphics, Forms, Controls, ActiveX, DirectShow9,
  51. DirectDraw, DSUtil, ComCtrls, MMSystem, Math, Consts, ExtCtrls,
  52. MultiMon, Dialogs, Registry, SyncObjs, Direct3D9, WMF9;
  53. const
  54. { Filter Graph message identifier. }
  55. WM_GRAPHNOTIFY = WM_APP + 1;
  56. { Sample Grabber message identifier. }
  57. WM_CAPTURE_BITMAP = WM_APP + 2;
  58. type
  59. { Video mode to use with @link(TVideoWindow). }
  60. TVideoMode = (
  61. vmNormal,
  62. vmVMR
  63. );
  64. { Graph Mode to use with @link(TFilterGraph).}
  65. TGraphMode = (
  66. gmNormal,
  67. gmCapture,
  68. gmDVD
  69. );
  70. { Render device returned by then OnGraphVMRRenderDevice event. }
  71. {$IFDEF VER140}
  72. TVMRRenderDevice = (
  73. rdOverlay = 1,
  74. rdVidMem = 2,
  75. rdSysMem = 4
  76. );
  77. {$ELSE}
  78. TVMRRenderDevice = Integer;
  79. const
  80. rdOverlay = 1;
  81. rdVidMem = 2;
  82. rdSysMem = 4;
  83. type
  84. {$ENDIF}
  85. {@exclude}
  86. TGraphState = (
  87. gsUninitialized,
  88. gsStopped,
  89. gsPaused,
  90. gsPlaying
  91. );
  92. { Specifies the seeking capabilities of a media stream. }
  93. TSeekingCap = (
  94. CanSeekAbsolute, // The stream can seek to an absolute position.
  95. CanSeekForwards, // The stream can seek forward.
  96. CanSeekBackwards, // The stream can seek backward.
  97. CanGetCurrentPos, // The stream can report its current position.
  98. CanGetStopPos, // The stream can report its stop position.
  99. CanGetDuration, // The stream can report its duration.
  100. CanPlayBackwards, // The stream can play backward.
  101. CanDoSegments, // The stream can do seamless looping (see IMediaSeeking.SetPositions).
  102. Source // Reserved.
  103. );
  104. { Specifies the seeking capabilities of a media stream. }
  105. TSeekingCaps = set of TSeekingCap;
  106. { Video Mixer Render Preferences: <br>
  107. <b>vpForceOffscreen:</b> Indicates that the VMR should use only offscreen surfaces for rendering.<br>
  108. <b>vpForceOverlays:</b> Indicates that the VMR should fail if no overlay surfaces are available.<br>
  109. <b>vpForceMixer:</b> Indicates that the VMR must use Mixer when the number of streams is 1.<br>
  110. <b>vpDoNotRenderColorKeyAndBorder:</b> Indicates that the application is responsible for painting the color keys.<br>
  111. <b>vpRestrictToInitialMonitor:</b> Indicates that the VMR should output only to the initial monitor.<br>
  112. <b>vpPreferAGPMemWhenMixing:</b> Indicates that the VMR should attempt to use AGP memory when allocating texture surfaces.}
  113. TVMRPreference = (
  114. vpForceOffscreen,
  115. vpForceOverlays,
  116. vpForceMixer,
  117. vpDoNotRenderColorKeyAndBorder,
  118. vpRestrictToInitialMonitor,
  119. vpPreferAGPMemWhenMixing
  120. );
  121. { Pointer to @link(TVMRPreferences).}
  122. PVMRPreferences = ^TVMRPreferences;
  123. { Set of @link(TVMRPreference).}
  124. TVMRPreferences = set of TVMRPreference;
  125. TOnDSEvent = procedure(sender: TComponent; Event, Param1, Param2: Integer) of object;
  126. {@exclude}
  127. TOnGraphBufferingData = procedure(sender: TObject; Buffering: boolean) of object ; {@exclude}
  128. TOnGraphComplete = procedure(sender: TObject; Result: HRESULT; Renderer: IBaseFilter) of object ; {@exclude}
  129. TOnGraphDeviceLost = procedure(sender: TObject; Device: IUnknown; Removed: Boolean) of object ; {@exclude}
  130. TOnGraphEndOfSegment = procedure(sender: TObject; StreamTime: TReferenceTime; NumSegment: Cardinal) of object ; {@exclude}
  131. TOnDSResult = procedure(sender: TObject; Result: HRESULT) of object ; {@exclude}
  132. TOnGraphFullscreenLost = procedure(sender: TObject; Renderer: IBaseFilter) of object ; {@exclude}
  133. TOnGraphOleEvent = procedure(sender: TObject; String1, String2: WideString) of object ; {@exclude}
  134. TOnGraphOpeningFile = procedure(sender: TObject; opening: boolean) of object ; {@exclude}
  135. TOnGraphSNDDevError = procedure(sender: TObject; OccurWhen: TSndDevErr; ErrorCode: LongWord) of object ; {@exclude}
  136. TOnGraphStreamControl = procedure(sender: TObject; PinSender: IPin; Cookie: LongWord) of object ; {@exclude}
  137. TOnGraphStreamError = procedure(sender: TObject; Operation: HRESULT; Value: LongWord) of object ; {@exclude}
  138. TOnGraphVideoSizeChanged = procedure(sender: TObject; Width, height: word) of object ; {@exclude}
  139. TOnGraphTimeCodeAvailable = procedure(sender: TObject; From: IBaseFilter; DeviceID: LongWord) of object ; {@exclude}
  140. TOnGraphEXTDeviceModeChange = procedure(sender: TObject; NewMode, DeviceID: LongWord) of object ; {@exclude}
  141. TOnGraphVMRRenderDevice = procedure(sender: TObject; RenderDevice: TVMRRenderDevice) of object;
  142. {@exclude}
  143. TOnDVDAudioStreamChange = procedure(sender: TObject; stream, lcid: Integer; Lang: string) of object; {@exclude}
  144. TOnDVDCurrentTime = procedure(sender: TObject; Hours, minutes,seconds,frames,frate : Integer) of object; {@exclude}
  145. TOnDVDTitleChange = procedure(sender: TObject; title: Integer) of object; {@exclude}
  146. TOnDVDChapterStart = procedure(sender: TObject; chapter: Integer) of object; {@exclude}
  147. TOnDVDValidUOPSChange = procedure(sender: TObject; UOPS: Integer) of object; {@exclude}
  148. TOnDVDChange = procedure(sender: TObject; total,current: Integer) of object; {@exclude}
  149. TOnDVDStillOn = procedure(sender: TObject; NoButtonAvailable: boolean; seconds: Integer) of object; {@exclude}
  150. TOnDVDSubpictureStreamChange = procedure(sender: TObject; SubNum, lcid: Integer; Lang: string) of object; {@exclude}
  151. TOnDVDPlaybackRateChange = procedure(sender: TObject; rate: single) of object; {@exclude}
  152. TOnDVDParentalLevelChange = procedure(sender: TObject; level: Integer) of object; {@exclude}
  153. TOnDVDAnglesAvailable = procedure(sender: TObject; available: boolean) of object; {@exclude}
  154. TOnDVDButtonAutoActivated = procedure(sender: TObject; Button: Cardinal) of object; {@exclude}
  155. TOnDVDCMD = procedure(sender: TObject; CmdID: Cardinal) of object; {@exclude}
  156. TOnDVDCurrentHMSFTime = procedure(sender: TObject; HMSFTimeCode: TDVDHMSFTimeCode; TimeCode: TDVDTimeCode) of object; {@exclude}
  157. TOnDVDKaraokeMode = procedure(sender: TObject; Played: boolean) of object;
  158. {@exclude}
  159. TOnBuffer = procedure(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: longint) of object ;
  160. TOnSelectedFilter = function (Moniker: IMoniker; FilterName: WideString; ClassID: TGuid): Boolean of Object;
  161. TOnCreatedFilter = function (Filter: IBaseFilter; ClassID: TGuid): Boolean of Object;
  162. TOnUnableToRender = function (Pin: IPin): Boolean of Object;
  163. // *****************************************************************************
  164. // IFilter
  165. // *****************************************************************************
  166. {@exclude}
  167. TFilterOperation = (
  168. foAdding, // Before the filter is added to graph.
  169. foAdded, // After the filter is added to graph.
  170. foRemoving, // Before the filter is removed from graph.
  171. foRemoved, // After the filter is removed from graph.
  172. foRefresh // Designer notification to Refresh the filter .
  173. );
  174. {@exclude}
  175. IFilter = interface
  176. ['{887F94DA-29E9-44C6-B48E-1FBF0FB59878}']
  177. { Return the IBaseFilter Interface (All DirectShow filters expose this interface). }
  178. function GetFilter: IBaseFilter;
  179. { Return the filter name (generally the component name). }
  180. function GetName: string;
  181. { Called by the @link(TFilterGraph) component, this method receive notifications
  182. on what the TFilterGraph is doing. if Operation = foGraphEvent then Param is the
  183. event code received by the FilterGraph.}
  184. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  185. end;
  186. {@exclude}
  187. TControlEvent = (
  188. cePlay,
  189. cePause,
  190. ceStop,
  191. ceFileRendering,
  192. ceFileRendered,
  193. ceDVDRendering,
  194. ceDVDRendered,
  195. ceActive
  196. );
  197. {@exclude}
  198. IEvent = interface
  199. ['{6C0DCD7B-1A98-44EF-A6D5-E23CBC24E620}']
  200. { FilterGraph events. }
  201. procedure GraphEvent(Event, Param1, Param2: integer);
  202. { Control Events. }
  203. procedure ControlEvent(Event: TControlEvent; Param: integer = 0);
  204. end;
  205. // *****************************************************************************
  206. // TFilterGraph
  207. // *****************************************************************************
  208. { This component is the central component in DirectShow, the Filter Graph
  209. handle synchronization, event notification, and other aspects of the
  210. controlling the filter graph. }
  211. TFilterGraph = class(TComponent, IAMGraphBuilderCallback, IAMFilterGraphCallback,
  212. IServiceProvider)
  213. private
  214. FActive : boolean;
  215. FAutoCreate : boolean;
  216. FHandle : THandle; // to capture events
  217. FMode : TGraphMode;
  218. FVolume : integer;
  219. FBalance : integer;
  220. FRate : Double;
  221. FLinearVolume : Boolean;
  222. FFilters: TInterfaceList;
  223. FGraphEvents: TInterfaceList;
  224. // builders
  225. FFilterGraph : IGraphBuilder;
  226. FCaptureGraph : ICaptureGraphBuilder2;
  227. FDVDGraph : IDvdGraphBuilder;
  228. // events interface
  229. FMediaEventEx : IMediaEventEx;
  230. // Graphedit
  231. FGraphEdit : boolean;
  232. FGraphEditID : Integer;
  233. // Log File
  234. FLogFileName: String;
  235. FLogFile: TFileStream;
  236. FOnActivate: TNotifyEvent;
  237. // All Events Code
  238. FOnDSEvent : TOnDSEvent;
  239. // Generic Graph Events
  240. FOnGraphBufferingData : TOnGraphBufferingData;
  241. FOnGraphClockChanged : TNotifyEvent;
  242. FOnGraphComplete : TOnGraphComplete;
  243. FOnGraphDeviceLost : TOnGraphDeviceLost;
  244. FOnGraphEndOfSegment : TOnGraphEndOfSegment;
  245. FOnGraphErrorStillPlaying : TOnDSResult;
  246. FOnGraphErrorAbort : TOnDSResult;
  247. FOnGraphFullscreenLost : TOnGraphFullscreenLost;
  248. FOnGraphChanged : TNotifyEvent;
  249. FOnGraphOleEvent : TOnGraphOleEvent;
  250. FOnGraphOpeningFile : TOnGraphOpeningFile;
  251. FOnGraphPaletteChanged : TNotifyEvent;
  252. FOnGraphPaused : TOnDSResult;
  253. FOnGraphQualityChange : TNotifyEvent;
  254. FOnGraphSNDDevInError : TOnGraphSNDDevError;
  255. FOnGraphSNDDevOutError : TOnGraphSNDDevError;
  256. FOnGraphStepComplete : TNotifyEvent;
  257. FOnGraphStreamControlStarted : TOnGraphStreamControl;
  258. FOnGraphStreamControlStopped : TOnGraphStreamControl;
  259. FOnGraphStreamErrorStillPlaying : TOnGraphStreamError;
  260. FOnGraphStreamErrorStopped : TOnGraphStreamError;
  261. FOnGraphUserAbort : TNotifyEvent;
  262. FOnGraphVideoSizeChanged : TOnGraphVideoSizeChanged;
  263. FOnGraphTimeCodeAvailable : TOnGraphTimeCodeAvailable;
  264. FOnGraphEXTDeviceModeChange : TOnGraphEXTDeviceModeChange;
  265. FOnGraphClockUnset : TNotifyEvent;
  266. FOnGraphVMRRenderDevice : TOnGraphVMRRenderDevice;
  267. FOnDVDAudioStreamChange : TOnDVDAudioStreamChange;
  268. FOnDVDCurrentTime : TOnDVDCurrentTime;
  269. FOnDVDTitleChange : TOnDVDTitleChange;
  270. FOnDVDChapterStart : TOnDVDChapterStart;
  271. FOnDVDAngleChange : TOnDVDChange;
  272. FOnDVDValidUOPSChange : TOnDVDValidUOPSChange;
  273. FOnDVDButtonChange : TOnDVDChange;
  274. FOnDVDChapterAutoStop : TNotifyEvent;
  275. FOnDVDStillOn : TOnDVDStillOn;
  276. FOnDVDStillOff : TNotifyEvent;
  277. FOnDVDSubpictureStreamChange : TOnDVDSubpictureStreamChange;
  278. FOnDVDNoFP_PGC : TNotifyEvent;
  279. FOnDVDPlaybackRateChange : TOnDVDPlaybackRateChange;
  280. FOnDVDParentalLevelChange : TOnDVDParentalLevelChange;
  281. FOnDVDPlaybackStopped : TNotifyEvent;
  282. FOnDVDAnglesAvailable : TOnDVDAnglesAvailable;
  283. FOnDVDPlayPeriodAutoStop : TNotifyEvent;
  284. FOnDVDButtonAutoActivated : TOnDVDButtonAutoActivated;
  285. FOnDVDCMDStart : TOnDVDCMD;
  286. FOnDVDCMDEnd : TOnDVDCMD;
  287. FOnDVDDiscEjected : TNotifyEvent;
  288. FOnDVDDiscInserted : TNotifyEvent;
  289. FOnDVDCurrentHMSFTime : TOnDVDCurrentHMSFTime;
  290. FOnDVDKaraokeMode : TOnDVDKaraokeMode;
  291. // DVD Warning
  292. FOnDVDWarningInvalidDVD1_0Disc : TNotifyEvent;//=1,
  293. FOnDVDWarningFormatNotSupported : TNotifyEvent;//=2,
  294. FOnDVDWarningIllegalNavCommand : TNotifyEvent;//=3
  295. FOnDVDWarningOpen : TNotifyEvent;//=4
  296. FOnDVDWarningSeek : TNotifyEvent;//=5
  297. FOnDVDWarningRead : TNotifyEvent;//=6
  298. // DVDDomain
  299. FOnDVDDomainFirstPlay : TNotifyEvent;
  300. FOnDVDDomainVideoManagerMenu : TNotifyEvent;
  301. FOnDVDDomainVideoTitleSetMenu : TNotifyEvent;
  302. FOnDVDDomainTitle : TNotifyEvent;
  303. FOnDVDDomainStop : TNotifyEvent;
  304. // DVDError
  305. FOnDVDErrorUnexpected : TNotifyEvent;
  306. FOnDVDErrorCopyProtectFail : TNotifyEvent;
  307. FOnDVDErrorInvalidDVD1_0Disc : TNotifyEvent;
  308. FOnDVDErrorInvalidDiscRegion : TNotifyEvent;
  309. FOnDVDErrorLowParentalLevel : TNotifyEvent;
  310. FOnDVDErrorMacrovisionFail : TNotifyEvent;
  311. FOnDVDErrorIncompatibleSystemAndDecoderRegions : TNotifyEvent;
  312. FOnDVDErrorIncompatibleDiscAndDecoderRegions : TNotifyEvent;
  313. FOnSelectedFilter: TOnSelectedFilter;
  314. FOnCreatedFilter: TOnCreatedFilter;
  315. FOnUnableToRender: TOnUnableToRender;
  316. procedure HandleEvents;
  317. procedure WndProc(var Msg: TMessage);
  318. procedure SetActive(Activate: boolean);
  319. procedure SetGraphMode(Mode: TGraphMode);
  320. procedure SetGraphEdit(enable: boolean);
  321. procedure ClearOwnFilters;
  322. procedure AddOwnFilters;
  323. procedure GraphEvents(Event, Param1, Param2: integer);
  324. procedure ControlEvents(Event: TControlEvent; Param: integer = 0);
  325. procedure SetLogFile(FileName: String);
  326. function GetState: TGraphState;
  327. procedure SetState(Value: TGraphState);
  328. procedure SetVolume(Volume: Integer);
  329. procedure SetBalance(Balance: integer);
  330. function GetSeekCaps: TSeekingCaps;
  331. procedure SetRate(Rate: double);
  332. function GetDuration: integer;
  333. procedure SetLinearVolume(aEnabled: Boolean);
  334. procedure UpdateGraph;
  335. // IAMGraphBuilderCallback
  336. function SelectedFilter(pMon: IMoniker): HResult; stdcall;
  337. function CreatedFilter(pFil: IBaseFilter): HResult; stdcall;
  338. // IAMFilterGraphCallback
  339. function UnableToRender(ph1, ph2: integer; pPin: IPin): HResult; // thiscall
  340. protected
  341. {@exclude}
  342. procedure DoEvent(Event, Param1, Param2: Integer); virtual;
  343. {@exclude}
  344. procedure InsertFilter(AFilter: IFilter);
  345. {@exclude}
  346. procedure RemoveFilter(AFilter: IFilter);
  347. {@exclude}
  348. procedure InsertEventNotifier(AEvent: IEvent);
  349. {@exclude}
  350. procedure RemoveEventNotifier(AEvent: IEvent);
  351. {@exclude}
  352. function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
  353. public
  354. { Retrieve the total duration of a stream. }
  355. property Duration: Integer read GetDuration;
  356. { Retrieve/Set the rate. }
  357. property Rate: Double read fRate write SetRate;
  358. { Retrieve the seeking capabilities. }
  359. property SeekCapabilities: TSeekingCaps read GetSeekCaps;
  360. { The volume balance. }
  361. property Balance: integer read fBalance write SetBalance;
  362. { The volume. }
  363. property Volume: integer read fVolume write SetVolume;
  364. { Current state of the filter graph. }
  365. property State: TGraphState read GetState write SetState;
  366. { TFilterGraph constructor. }
  367. constructor Create(AOwner: TComponent); override;
  368. { TFilterGraph destructor. }
  369. destructor Destroy; override;
  370. { @exclude}
  371. procedure Loaded; override;
  372. { Retrieve an Interface from the current Graph.<br>
  373. <b>ex: </b> (FilterGraph <b>as</b> IGraphBuilder).RenderFile('C:\speedis.avi', <b>nil</b>);<br>
  374. <b>Remark: </b> The interfaces you can Query depend of the @link(Mode) you
  375. have defined.<br>
  376. <b>gmNormal: </b>IAMGraphStreams, IAMStats, IBasicAudio, IBasicVideo,
  377. IBasicVideo2, IFilterChain, IFilterGraph, IFilterGraph2,
  378. IFilterMapper2, IGraphBuilder, IGraphConfig, IGraphVersion,
  379. IMediaControl, IMediaEvent, IMediaEventEx, IMediaEventSink,
  380. IMediaFilter, IMediaPosition, IMediaSeeking, IQueueCommand,
  381. IRegisterServiceProvider, IResourceManager, IServiceProvider,
  382. IVideoFrameStep, IVideoWindow. <br>
  383. <b>gmCapture: </b> all gmNormal interfaces and ICaptureGraphBuilder2.<br>
  384. <b>gmDVD: </b> all gmNormal interfaces and IDvdGraphBuilder, IDvdControl2,
  385. IDvdInfo2, IAMLine21Decoder.}
  386. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  387. { The Run method runs all the filters in the filter graph. While the graph
  388. is running, data moves through the graph and is rendered. }
  389. function Play: boolean;
  390. { The Pause method pauses all the filters in the filter graph. }
  391. function Pause: boolean;
  392. { The Stop method stops all the filters in the graph. }
  393. function Stop: boolean;
  394. { This method disconnect all pins.}
  395. procedure DisconnectFilters;
  396. { Disconnect and remove all filters from the filter graph excepting the custom components. }
  397. procedure ClearGraph;
  398. { Render a single file. }
  399. function RenderFile(FileName: WideString): HRESULT;
  400. function RenderFileEx(FileName: WideString): HRESULT;
  401. { Render a DVD Video Volume or a File Name if specified. }
  402. function RenderDVD(out status: TAMDVDRenderStatus;
  403. FileName: WideString = ''; Mode: Integer = AM_DVD_HWDEC_PREFER): HRESULT;
  404. { Save the current state and position of a DVD movie to a file.<br>
  405. See also: @link(DVDRestoreBookmark).}
  406. procedure DVDSaveBookmark(BookMarkFile: WideString);
  407. { Restore the State and position of a DVD movie saved by @link(DVDSaveBookmark).}
  408. procedure DVDRestoreBookmark(BookMarkFile: WideString);
  409. published
  410. { Specify a File Name to save the Filter Graph Log. }
  411. property LogFile: String read FLogFileName write SetLogFile;
  412. { Activate the Filter Graph.}
  413. property Active: boolean read FActive write SetActive default False;
  414. { Auto-Activate the Filter Graph when component is created.}
  415. property AutoCreate: boolean read FAutoCreate write FAutoCreate default False;
  416. { There is 3 modes: gmNormal, gmCapture and gmDVD. <br>
  417. See also: @link(GraphInterFace).}
  418. property Mode: TGraphMode read FMode write SetGraphMode default gmNormal;
  419. { if true you can use GraphEdit application to connect with the Filter Graph.}
  420. property GraphEdit: boolean read FGraphEdit write SetGraphEdit;
  421. { if true, Volume and Balance is set by using a linear algorythm instead of
  422. logatithmic. }
  423. property LinearVolume: Boolean read FLinearVolume write SetLinearVolume;
  424. // -------------------------------------------------------------------------
  425. // Events
  426. // -------------------------------------------------------------------------
  427. property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
  428. { Generic Filter Graph event.<br>
  429. <b>Event:</b> message sent.<br>
  430. <b>Param1:</b> first message parameter.<br>
  431. <b>Param2:</b> second message parameter.}
  432. property OnDSEvent: TOnDSEvent read FOnDSEvent write FOnDSEvent;
  433. { The graph is buffering data, or has stopped buffering data.
  434. A filter can send this event if it needs to buffer data from an external
  435. source. (for example, it might be loading data from a network.)
  436. The application can use this event to adjust its user interface.<br>
  437. <b>buffering:</b> TRUE if the graph is starting to buffer, or FALSE if
  438. the graph has stopped buffering. }
  439. property OnGraphBufferingData: TOnGraphBufferingData read FOnGraphBufferingData write FOnGraphBufferingData;
  440. { The reference clock has changed. The filter graph manager sends this event
  441. when its IMediaFilter.SetSyncSource method is called.}
  442. property OnGraphClockChanged: TNotifyEvent read FOnGraphClockChanged write FOnGraphClockChanged;
  443. { All data from a particular stream has been rendered.
  444. By default, the filter graph manager does not forward this event to the
  445. application. However, after all the streams in the graph report EC_COMPLETE,
  446. the filter graph manager posts a separate EC_COMPLETE event to the application.<br>
  447. <b>Result:</b> HRESULT value; can be S_OK.<br>
  448. <b>Renderer:</b> nil, or a reference to the renderer's IBaseFilter interface.}
  449. property OnGraphComplete: TOnGraphComplete read FOnGraphComplete write FOnGraphComplete;
  450. { A Plug and Play device was removed or became available again. When the
  451. device becomes available again, the previous state of the device filter is
  452. no longer valid. The application must rebuild the graph in order to use the device.<br>
  453. <b>Device:</b> IUnknown interface of the filter that represents the device.<br>
  454. <b>Removed:</b> True if the device was removed, or False if the device is available again.}
  455. property OnGraphDeviceLost: TOnGraphDeviceLost read FOnGraphDeviceLost write FOnGraphDeviceLost;
  456. { The end of a segment was reached.
  457. This event code supports seamless looping. When a call to the IMediaSeeking.SetPositions
  458. method includes the AM_SEEKING_Segment flag, the source filter sends this
  459. event code instead of calling IPin.EndOfStream.<br>
  460. <b>StreamTime:</b> TREFERENCE_TIME value that specifies the accumulated stream time since the start of the segment.<br>
  461. <b>NumSegment:</b> Cardinal value indicating the segment number (zero-based).}
  462. property OnGraphEndOfSegment: TOnGraphEndOfSegment read FOnGraphEndOfSegment write FOnGraphEndOfSegment;
  463. { An asynchronous command to run the graph has failed.
  464. if the filter graph manager issues an asynchronous run command that fails,
  465. it sends this event to the application. The graph remains in a running state.
  466. The state of the underlying filters is indeterminate. Some filters might be
  467. running, others might not.<br>
  468. <b>Result:</b> value of the operation that failed.}
  469. property OnGraphErrorStillPlaying: TOnDSResult read FOnGraphErrorStillPlaying write FOnGraphErrorStillPlaying;
  470. { An operation was aborted because of an error.<br>
  471. <b>Result:</b> value of the operation that failed.}
  472. property OnGraphErrorAbort: TOnDSResult read FOnGraphErrorAbort write FOnGraphErrorAbort;
  473. { The video renderer is switching out of full-screen mode.
  474. When the Full Screen Renderer loses activation, it sends this event. When
  475. another video renderer switches out of full-screen mode, the filter graph
  476. manager sends this event, in response to an EC_ACTIVATE event from the renderer.<br>
  477. <b>Renderer:</b> the video renderer's IBaseFilter interface, or nil.}
  478. property OnGraphFullscreenLost: TOnGraphFullscreenLost read FOnGraphFullscreenLost write FOnGraphFullscreenLost;
  479. { The filter graph has changed.
  480. This event code is intended for debugging. It is not sent for all graph changes.}
  481. property OnGraphChanged: TNotifyEvent read FOnGraphChanged write FOnGraphChanged;
  482. { A filter is passing a text string to the application.
  483. By convention, the first parameter contains type information (for example, Text)
  484. and the second parameter contains the text string.<br>
  485. <b>String1, String2:</b> Wide Strings}
  486. property OnGraphOleEvent: TOnGraphOleEvent read FOnGraphOleEvent write FOnGraphOleEvent;
  487. { The graph is opening a file, or has finished opening a file.
  488. A filter can send this event if it spends significant time opening a file.
  489. (for example, the file might be located on a network.) The application can use
  490. this event to adjust its user interface.<br>
  491. <b>opening:</b> TRUE if the graph is starting to open a file, or FALSE
  492. if the graph is no longer opening the file.}
  493. property OnGraphOpeningFile: TOnGraphOpeningFile read FOnGraphOpeningFile write FOnGraphOpeningFile;
  494. { The video palette has changed.
  495. Video renderers send this event if they detect a palette change in the stream.}
  496. property OnGraphPaletteChanged: TNotifyEvent read FOnGraphPaletteChanged write FOnGraphPaletteChanged;
  497. { A pause request has completed.
  498. The filter graph manager sends this event when it completes an asynchronous pause command.<br>
  499. <b>Result:</b> value that indicates the result of the transition. if the
  500. value is S_OK, the filter graph is now in a paused state.}
  501. property OnGraphPaused: TOnDSResult read FOnGraphPaused write FOnGraphPaused;
  502. { The graph is dropping samples, for quality control.
  503. A filter sends this event if it drops samples in response to a quality control
  504. message. It sends the event only when it adjusts the quality level, not for each
  505. sample that it drops. }
  506. property OnGraphQualityChange: TNotifyEvent read FOnGraphQualityChange write FOnGraphQualityChange;
  507. { An audio device error occurred on an input pin.<br>
  508. <b>OccurWhen:</b> value from the TSNDDEV_ERR enumerated type, indicating how the device was being accessed when the failure occurred.<br>
  509. <b>ErrorCode:</b> value indicating the error returned from the sound device call.}
  510. property OnGraphSNDDevInError: TOnGraphSNDDevError read FOnGraphSNDDevInError write FOnGraphSNDDevInError;
  511. { An audio device error occurred on an output pin.<br>
  512. <b>OccurWhen:</b> value from the TSNDDEV_ERR enumerated type, indicating how the device was being accessed when the failure occurred.<br>
  513. <b>ErrorCode:</b> value indicating the error returned from the sound device call.}
  514. property OnGraphSNDDevOutError: TOnGraphSNDDevError read FOnGraphSNDDevOutError write FOnGraphSNDDevOutError;
  515. { A filter has completed frame stepping.
  516. The filter graph manager pauses the graph and passes the event to the application.}
  517. property OnGraphStepComplete: TNotifyEvent read FOnGraphStepComplete write FOnGraphStepComplete;
  518. { A stream-control start command has taken effect.
  519. Filters send this event in response to the IAMStreamControl.StartAt method.
  520. This method specifies a reference time for a pin to begin streaming.
  521. When streaming does begin, the filter sends this event.<br>
  522. <b>PinSender</b> parameter specifies the pin that executes the start command.
  523. Depending on the implementation, it might not be the pin that
  524. received the StartAt call.<br>
  525. <b>Cookie</b> parameter is specified by the application in the StartAt method.
  526. This parameter enables the application to track multiple calls to the method.}
  527. property OnGraphStreamControlStarted: TOnGraphStreamControl read FOnGraphStreamControlStarted write FOnGraphStreamControlStarted;
  528. { A stream-control start command has taken effect.
  529. Filters send this event in response to the IAMStreamControl.StopAt method.
  530. This method specifies a reference time for a pin to stop streaming.
  531. When streaming does halt, the filter sends this event.<br>
  532. <b>PinSender</b> parameter specifies the pin that executes the stop command.
  533. Depending on the implementation, it might not be the pin
  534. that received the StopAt call.<br>
  535. <b>Cookie</b> parameter is specified by the application in the StopAt method.
  536. This parameter enables the application to track multiple calls to the method.}
  537. property OnGraphStreamControlStopped: TOnGraphStreamControl read FOnGraphStreamControlStopped write FOnGraphStreamControlStopped;
  538. { An error occurred in a stream, but the stream is still playing.<br>
  539. <b>Operation:</b> HRESULT of the operation that failed.<br>
  540. <b>Value:</b> LongWord value, generally zero. }
  541. property OnGraphStreamErrorStillPlaying : TOnGraphStreamError read FOnGraphStreamErrorStillPlaying write FOnGraphStreamErrorStillPlaying;
  542. { A stream has stopped because of an error.<br>
  543. <b>Operation:</b> HRESULT of the operation that failed.<br>
  544. <b>Value:</b> LongWord value, generally zero. }
  545. property OnGraphStreamErrorStopped: TOnGraphStreamError read FOnGraphStreamErrorStopped write FOnGraphStreamErrorStopped;
  546. { The user has terminated playback.<br>
  547. This event code signals that the user has terminated normal graph playback.
  548. for example, video renderers send this event if the user closes the video window.<br>
  549. After sending this event, the filter should reject all samples and not send
  550. any EC_REPAINT events, until the filter stops and is reset.}
  551. property OnGraphUserAbort: TNotifyEvent read FOnGraphUserAbort write FOnGraphUserAbort;
  552. { The native video size has changed.<br>
  553. <b>width:</b> new width, in pixels.<br>
  554. <b>height:</b> new height, in pixels. }
  555. property OnGraphVideoSizeChanged: TOnGraphVideoSizeChanged read FOnGraphVideoSizeChanged write FOnGraphVideoSizeChanged;
  556. { Sent by filter supporting timecode.<br>
  557. <b>From:</b> sending object.<br>
  558. <b>DeviceID:</b> device ID of the sending object}
  559. property OnGraphTimeCodeAvailable: TOnGraphTimeCodeAvailable read FOnGraphTimeCodeAvailable write FOnGraphTimeCodeAvailable;
  560. { Sent by filter supporting IAMExtDevice.<br>
  561. <b>NewMode:</b> the new mode<br>
  562. <b>DeviceID:</b> the device ID of the sending object}
  563. property OnGraphEXTDeviceModeChange: TOnGraphEXTDeviceModeChange read FOnGraphEXTDeviceModeChange write FOnGraphEXTDeviceModeChange;
  564. { The clock provider was disconnected.<br>
  565. KSProxy signals this event when the pin of a clock-providing filter is disconnected.}
  566. property OnGraphClockUnset: TNotifyEvent read FOnGraphClockUnset write FOnGraphClockUnset;
  567. { Identifies the type of rendering mechanism the VMR is using to display video.}
  568. property OnGraphVMRRenderDevice: TOnGraphVMRRenderDevice read FOnGraphVMRRenderDevice write FOnGraphVMRRenderDevice;
  569. { Signals that the current audio stream number changed for the main title.<br>
  570. The current audio stream can change automatically with a navigation command
  571. authored on the disc as well as through application control by using the IDvdControl2 interface.<br>
  572. <b>stream:</b> value indicating the new user audio stream number. Audio stream numbers
  573. range from 0 to 7. Stream $FFFFFFFF indicates that no stream is selected.<br>
  574. <b>lcid:</b> Language identifier.<br>
  575. <b>Lang:</b> Language string. }
  576. property OnDVDAudioStreamChange: TOnDVDAudioStreamChange read FOnDVDAudioStreamChange write FOnDVDAudioStreamChange;
  577. { Deprecated, use @link(OnDVDCurrentHMSFTime) instead.<br>
  578. Signals the beginning of every video object unit (VOBU), a video segment
  579. which is 0.4 to 1.0 seconds in length.<br> }
  580. property OnDVDCurrentTime: TOnDVDCurrentTime read FOnDVDCurrentTime write FOnDVDCurrentTime;
  581. { Indicates when the current title number changes.<br>
  582. Title numbers range from 1 to 99. This number indicates the TTN, which is
  583. the title number with respect to the whole disc, not the VTS_TTN which is
  584. the title number with respect to just a current VTS.<br>
  585. <b>Title:</b> value indicating the new title number.}
  586. property OnDVDTitleChange: TOnDVDTitleChange read FOnDVDTitleChange write FOnDVDTitleChange;
  587. { Signals that the DVD player started playback of a new program in the
  588. DVD_DOMAIN_Title domain.<br>
  589. Only simple linear movies signal this event.<br>
  590. <b>chapter:</b> value indicating the new chapter (program) number.}
  591. property OnDVDChapterStart: TOnDVDChapterStart read FOnDVDChapterStart write FOnDVDChapterStart;
  592. { Signals that either the number of available angles changed or that the
  593. current angle number changed.<br>
  594. Angle numbers range from 1 to 9. The current angle number can change
  595. automatically with a navigation command authored on the disc as well as
  596. through application control by using the IDvdControl2 interface.<br>
  597. <b>total:</b> value indicating the number of available angles. When the
  598. number of available angles is 1, the current video is not multiangle.<br>
  599. <b>current:</b> value indicating the current angle number.}
  600. property OnDVDAngleChange: TOnDVDChange read FOnDVDAngleChange write FOnDVDAngleChange;
  601. { Signals that the available set of IDvdControl2 interface methods has changed.<br>
  602. <b>UOPS:</b> value representing a ULONG whose bits indicate which IDvdControl2
  603. commands the DVD disc explicitly disabled. }
  604. property OnDVDValidUOPSChange: TOnDVDValidUOPSChange read FOnDVDValidUOPSChange write FOnDVDValidUOPSChange;
  605. { Signals that either the number of available buttons changed or that the
  606. currently selected button number changed.<br>
  607. This event can signal any of the available button numbers. These numbers
  608. do not always correspond to button numbers used for
  609. IDvdControl2.SelectAndActivateButton because that method can activate only
  610. a subset of buttons.<br>
  611. <b>total:</b> value indicating the number of available buttons.<br>
  612. <b>current:</b> value indicating the currently selected button number.
  613. Selected button number zero implies that no button is selected.}
  614. property OnDVDButtonChange: TOnDVDChange read FOnDVDButtonChange write FOnDVDButtonChange;
  615. { Indicates that playback stopped as the result of a call to the
  616. IDvdControl2.PlayChaptersAutoStop method.}
  617. property OnDVDChapterAutoStop: TNotifyEvent read FOnDVDChapterAutoStop write FOnDVDChapterAutoStop;
  618. { Signals the beginning of any still (PGC, Cell, or VOBU).
  619. All combinations of buttons and still are possible (buttons on with still
  620. on, buttons on with still off, button off with still on, button off with still off).<br>
  621. <b>NoButtonAvailable</b>: Boolean value indicating whether buttons are
  622. available. False indicates buttons are available so the IDvdControl2.StillOff
  623. method won't work. True indicates no buttons are available, so IDvdControl2.StillOff will work.<br>
  624. <b>seconds</b>: value indicating the number of seconds the still will last.
  625. $FFFFFFFF indicates an infinite still, meaning wait until the user presses
  626. a button or until the application calls IDvdControl2.StillOff.}
  627. property OnDVDStillOn: TOnDVDStillOn read FOnDVDStillOn write FOnDVDStillOn;
  628. { Signals the end of any still (PGC, Cell, or VOBU).<br>
  629. This event indicates that any currently active still has been released.}
  630. property OnDVDStillOff: TNotifyEvent read FOnDVDStillOff write FOnDVDStillOff;
  631. { Signals that the current subpicture stream number changed for the main title.<br>
  632. The subpicture can change automatically with a navigation command authored
  633. on disc as well as through application control using IDvdControl2.<br>
  634. <b>SubNum:</b> value indicating the new user subpicture stream number.
  635. Subpicture stream numbers range from 0 to 31. Stream $FFFFFFFF indicates
  636. that no stream is selected.<br>
  637. <b>lcid:</b> Language identifier.<br>
  638. <b>Lang:</b> Language string.}
  639. property OnDVDSubpictureStreamChange: TOnDVDSubpictureStreamChange read FOnDVDSubpictureStreamChange write FOnDVDSubpictureStreamChange;
  640. { Signals that the DVD disc does not have a FP_PGC (First Play Program Chain)
  641. and that the DVD Navigator will not automatically load any PGC and start playback.}
  642. property OnDVDNoFP_PGC: TNotifyEvent read FOnDVDNoFP_PGC write FOnDVDNoFP_PGC;
  643. { Signals that a rate change in the playback has been initiated.
  644. <b>rate:</b> indicate the new playback rate. rate < 0 indicates reverse playback
  645. mode. rate > 0 indicates forward playback mode.}
  646. property OnDVDPlaybackRateChange: TOnDVDPlaybackRateChange read FOnDVDPlaybackRateChange write FOnDVDPlaybackRateChange;
  647. { Signals that the parental level of the authored content is about to change.<br>
  648. The DVD Navigator source filter does not currently support "on the fly"
  649. parental level changes in response to SetTmpPML commands on a DVD disc.<br>
  650. <b>level:</b> value representing the new parental level set in the player.}
  651. property OnDVDParentalLevelChange: TOnDVDParentalLevelChange read FOnDVDParentalLevelChange write FOnDVDParentalLevelChange;
  652. { Indicates that playback has been stopped. The DVD Navigator has completed
  653. playback of the title or chapter and did not find any other branching
  654. instruction for subsequent playback. }
  655. property OnDVDPlaybackStopped: TNotifyEvent read FOnDVDPlaybackStopped write FOnDVDPlaybackStopped;
  656. { Indicates whether an angle block is being played and angle changes can be performed.<br>
  657. Angle changes are not restricted to angle blocks and the manifestation of
  658. the angle change can be seen only in an angle block.<br>
  659. <b>available:</b> Boolean value that indicates if an angle block is being
  660. played back. False indicates that playback is not in an angle block and
  661. angles are not available, True indicates that an angle block is being played
  662. back and angle changes can be performed.}
  663. property OnDVDAnglesAvailable: TOnDVDAnglesAvailable read FOnDVDAnglesAvailable write FOnDVDAnglesAvailable;
  664. { Indicates that the Navigator has finished playing the segment specified
  665. in a call to PlayPeriodInTitleAutoStop.}
  666. property OnDVDPlayPeriodAutoStop: TNotifyEvent read FOnDVDPlayPeriodAutoStop write FOnDVDPlayPeriodAutoStop;
  667. { Signals that a menu button has been automatically activated per instructions
  668. on the disc. This occurs when a menu times out and the disc has specified a
  669. button to be automatically activated.<br>
  670. <b>Button</b>: value indicating the button that was activated.}
  671. property OnDVDButtonAutoActivated: TOnDVDButtonAutoActivated read FOnDVDButtonAutoActivated write FOnDVDButtonAutoActivated;
  672. { Signals that a particular command has begun.<br>
  673. <b>CmdID:</b> The Command ID and the HRESULT return value.}
  674. property OnDVDCMDStart: TOnDVDCMD read FOnDVDCMDStart Write FOnDVDCMDStart;
  675. { Signals that a particular command has completed.<br>
  676. <b>CmdID</b> The Command ID and the completion result.}
  677. property OnDVDCMDEnd: TOnDVDCMD read FOnDVDCMDEnd Write FOnDVDCMDEnd;
  678. { Signals that a disc was ejected.<br>
  679. Playback automatically stops when a disc is ejected. The application does
  680. not have to take any special action in response to this event.}
  681. property OnDVDDiscEjected: TNotifyEvent read FOnDVDDiscEjected Write FOnDVDDiscEjected;
  682. { Signals that a disc was inserted into the drive.<br>
  683. Playback automatically begins when a disc is inserted. The application does
  684. not have to take any special action in response to this event.}
  685. property OnDVDDiscInserted: TNotifyEvent read FOnDVDDiscInserted write FOnDVDDiscInserted;
  686. { Signals the current time, in DVD_HMSF_TIMECODE format, relative to the start
  687. of the title. This event is triggered at the beginning of every VOBU, which
  688. occurs every 0.4 to 1.0 seconds.<br>
  689. The TDVD_HMSF_TIMECODE format is intended to replace the old BCD format that
  690. is returned in OnDVDCurrentTime events. The HMSF timecodes are easier to
  691. work with. To have the Navigator send EC_DVD_CURRENT_HMSF_TIME events instead
  692. of EC_DVD_CURRENT_TIME events, an application must call
  693. IDvdControl2.SetOption(DVD_HMSF_TimeCodeEvents, TRUE). When this flag is set,
  694. the Navigator will also expect all time parameters in the IDvdControl2 and
  695. IDvdInfo2 methods to be passed as TDVD_HMSF_TIMECODEs.<br>
  696. <b>HMSFTimeCode:</b> HMS Time code structure.<br>
  697. <b>TimeCode:</b> old time format, do not use. }
  698. property OnDVDCurrentHMSFTime: TOnDVDCurrentHMSFTime read FOnDVDCurrentHMSFTime write FOnDVDCurrentHMSFTime;
  699. { Indicates that the Navigator has either begun playing or finished playing karaoke data.<br>
  700. The DVD player signals this event whenever it changes domains.<br>
  701. <b>Played:</b> TRUE means that a karaoke track is being played and FALSE means
  702. that no karaoke data is being played. }
  703. property OnDVDKaraokeMode: TOnDVDKaraokeMode read FOnDVDKaraokeMode write FOnDVDKaraokeMode;
  704. { Performing default initialization of a DVD disc.}
  705. property OnDVDDomainFirstPlay: TNotifyEvent read FOnDVDDomainFirstPlay write FOnDVDDomainFirstPlay;
  706. { Displaying menus for whole disc. }
  707. property OnDVDDomainVideoManagerMenu: TNotifyEvent read FOnDVDDomainVideoManagerMenu write FOnDVDDomainVideoManagerMenu;
  708. { Displaying menus for current title set. }
  709. property OnDVDDomainVideoTitleSetMenu: TNotifyEvent read FOnDVDDomainVideoTitleSetMenu write FOnDVDDomainVideoTitleSetMenu;
  710. { Displaying the current title. }
  711. property OnDVDDomainTitle: TNotifyEvent read FOnDVDDomainTitle write FOnDVDDomainTitle;
  712. { The DVD Navigator is in the DVD Stop domain.}
  713. property OnDVDDomainStop: TNotifyEvent read FOnDVDDomainStop write FOnDVDDomainStop;
  714. { Something unexpected happened; perhaps content is authored incorrectly.
  715. Playback is stopped.}
  716. property OnDVDErrorUnexpected: TNotifyEvent read FOnDVDErrorUnexpected write FOnDVDErrorUnexpected;
  717. { Key exchange for DVD copy protection failed. Playback is stopped. }
  718. property OnDVDErrorCopyProtectFail: TNotifyEvent read FOnDVDErrorCopyProtectFail write FOnDVDErrorCopyProtectFail;
  719. { DVD-Video disc is authored incorrectly for specification version 1.x.
  720. Playback is stopped.}
  721. property OnDVDErrorInvalidDVD1_0Disc: TNotifyEvent read FOnDVDErrorInvalidDVD1_0Disc write FOnDVDErrorInvalidDVD1_0Disc;
  722. { DVD-Video disc cannot be played because the disc is not authored to play in
  723. the system region. }
  724. property OnDVDErrorInvalidDiscRegion: TNotifyEvent read FOnDVDErrorInvalidDiscRegion write FOnDVDErrorInvalidDiscRegion;
  725. { Player parental level is lower than the lowest parental level available in
  726. the DVD content. Playback is stopped. }
  727. property OnDVDErrorLowParentalLevel: TNotifyEvent read FOnDVDErrorLowParentalLevel write FOnDVDErrorLowParentalLevel;
  728. { Macrovision® distribution failed. Playback stopped. }
  729. property OnDVDErrorMacrovisionFail: TNotifyEvent read FOnDVDErrorMacrovisionFail write FOnDVDErrorMacrovisionFail;
  730. { No discs can be played because the system region does not match the decoder region. }
  731. property OnDVDErrorIncompatibleSystemAndDecoderRegions: TNotifyEvent read FOnDVDErrorIncompatibleSystemAndDecoderRegions write FOnDVDErrorIncompatibleSystemAndDecoderRegions;
  732. { The disc cannot be played because the disc is not authored to be played in
  733. the decoder's region. }
  734. property OnDVDErrorIncompatibleDiscAndDecoderRegions: TNotifyEvent read FOnDVDErrorIncompatibleDiscAndDecoderRegions write FOnDVDErrorIncompatibleDiscAndDecoderRegions;
  735. { DVD-Video disc is authored incorrectly. Playback can continue, but unexpected
  736. behavior might occur. }
  737. property OnDVDWarningInvalidDVD1_0Disc: TNotifyEvent read FOnDVDWarningInvalidDVD1_0Disc write FOnDVDWarningInvalidDVD1_0Disc;
  738. { A decoder would not support the current format. Playback of a stream
  739. (audio, video or subpicture) might not function. }
  740. property OnDVDWarningFormatNotSupported : TNotifyEvent read FOnDVDWarningFormatNotSupported write FOnDVDWarningFormatNotSupported;
  741. { The internal DVD navigation command processor attempted to process an illegal command.}
  742. property OnDVDWarningIllegalNavCommand : TNotifyEvent read FOnDVDWarningIllegalNavCommand write FOnDVDWarningIllegalNavCommand;
  743. { File Open failed. }
  744. property OnDVDWarningOpen: TNotifyEvent read FOnDVDWarningOpen write FOnDVDWarningOpen;
  745. { File Seek failed. }
  746. property OnDVDWarningSeek: TNotifyEvent read FOnDVDWarningSeek write FOnDVDWarningSeek;
  747. { File Read failed. }
  748. property OnDVDWarningRead: TNotifyEvent read FOnDVDWarningRead write FOnDVDWarningRead;
  749. { Notifys when a Moniker has been found for a MediaType of a Pin in the Graph.
  750. Return True to allow this Filter to be added, otherwise return False.
  751. Note: The Guid might not be the real Filter Class ID, but a Group ID.
  752. eg: Renderer Filters. }
  753. property OnSelectedFilter: TOnSelectedFilter read FOnSelectedFilter write FOnSelectedFilter;
  754. { Notifys when a Filter has been created and is about to enter the Graph.
  755. Return True to allow this Filter to be added, otherwise return False. }
  756. property OnCreatedFilter: TOnCreatedFilter read FOnCreatedFilter write FOnCreatedFilter;
  757. { Notifys about a Pin that couldn't be Rendered. Return True to try it again,
  758. otherwise return False. }
  759. property OnUnableToRender: TOnUnableToRender read FOnUnableToRender write FOnUnableToRender;
  760. end;
  761. // *****************************************************************************
  762. // TVMROptions
  763. // *****************************************************************************
  764. {@exclude}
  765. TVideoWindow = class;
  766. { See VRMOptions.<br>}
  767. TVMRVideoMode = (
  768. vmrWindowed,
  769. vmrWindowless,
  770. vmrRenderless
  771. );
  772. { Video Mixer Renderer property editor. }
  773. TVMROptions = class(TPersistent)
  774. private
  775. FOwner: TVideoWindow;
  776. FStreams: cardinal;
  777. FPreferences: TVMRPreferences;
  778. FMode: TVMRVideoMode;
  779. FKeepAspectRatio: boolean;
  780. procedure SetStreams(Streams: cardinal);
  781. procedure SetPreferences(Preferences: TVMRPreferences);
  782. procedure SetMode(AMode: TVMRVideoMode);
  783. procedure SetKeepAspectRatio(Keep: boolean);
  784. public
  785. { Constructor method. }
  786. constructor Create(AOwner: TVideoWindow);
  787. published
  788. { Windowed or WindowLess}
  789. property Mode: TVMRVideoMode read FMode write SetMode;
  790. { Sets the number of streams to be mixed. }
  791. property Streams: Cardinal read FStreams write SetStreams default 4;
  792. { Sets various application preferences related to video rendering. }
  793. property Preferences: TVMRPreferences read FPreferences write SetPreferences default [vpForceMixer];
  794. { Keep Aspect Ration on the video window. }
  795. property KeepAspectRatio: boolean read FKeepAspectRatio write SetKeepAspectRatio default True;
  796. end;
  797. // *****************************************************************************
  798. // TVideoWindow
  799. // *****************************************************************************
  800. TAbstractAllocator = class(TInterfacedObject)
  801. constructor Create(out hr: HResult; wnd: THandle; d3d: IDirect3D9 = nil; d3dd: IDirect3DDevice9 = nil); virtual; abstract;
  802. end;
  803. TAbstractAllocatorClass = class of TAbstractAllocator;
  804. { Manage a Video Renderer or a Video Mixer Renderer (VMR) Filter to display
  805. a video in your application. }
  806. TVideoWindow = class(TCustomControl, IFilter, IEvent)
  807. private
  808. FMode : TVideoMode;
  809. FVMROptions : TVMROptions;
  810. FBaseFilter : IBaseFilter;
  811. FVideoWindow : IVideoWindow; // VMR Windowed & Normal
  812. FWindowLess : IVMRWindowlessControl9; // VMR Windowsless
  813. FFullScreen : boolean;
  814. FFilterGraph : TFilterGraph;
  815. FWindowStyle : LongWord;
  816. FWindowStyleEx : LongWord;
  817. FTopMost : boolean;
  818. FIsFullScreen : boolean;
  819. FOnPaint : TNotifyEvent;
  820. FKeepAspectRatio: boolean;
  821. FAllocatorClass: TAbstractAllocatorClass;
  822. FCurrentAllocator: TAbstractAllocator;
  823. FRenderLessUserID: Cardinal;
  824. procedure SetVideoMode(AMode: TVideoMode);
  825. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  826. procedure SetFullScreen(Value: boolean);
  827. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  828. procedure GraphEvent(Event, Param1, Param2: integer);
  829. function GetName: string;
  830. function GetVideoHandle: THandle;
  831. procedure ControlEvent(Event: TControlEvent; Param: integer = 0);
  832. procedure SetTopMost(TopMost: boolean);
  833. function GetVisible: boolean;
  834. procedure SetVisible(Vis: boolean);
  835. protected
  836. FIsVideoWindowOwner: Boolean;
  837. {@exclude}
  838. procedure Loaded; override;
  839. {@exclude}
  840. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  841. {@exclude}
  842. procedure Resize; override;
  843. {@exclude}
  844. procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); override;
  845. {@exclude}
  846. function GetFilter: IBaseFilter;
  847. {@exclude}
  848. procedure WndProc(var Message: TMessage); override;
  849. {@exclude}
  850. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  851. {@exclude}
  852. procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  853. {@exclude}
  854. procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  855. {@exclude}
  856. procedure Paint; override;
  857. public
  858. {@exclude}
  859. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  860. { Constructor. }
  861. constructor Create(AOwner: TComponent);override;
  862. { Destructor. }
  863. destructor Destroy; override;
  864. { Check if the Video Mixer Renderer is available (Windows XP). }
  865. class function CheckVMR: boolean;
  866. { Retrieve the current bitmap, only in WindowLess VMR Mode. }
  867. function VMRGetBitmap(Stream: TStream): boolean;
  868. function CheckInputPinsConnected: boolean;
  869. procedure SetAllocator(Allocator: TAbstractAllocatorClass; UserID: Cardinal);
  870. property IsVideoWindowOwner: Boolean read FIsVideoWindowOwner write FIsVideoWindowOwner;
  871. published
  872. { VMR/WindowsLess Mode only.}
  873. property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  874. { The video Window stay on Top in FullScreen Mode. }
  875. property FullScreenTopMost: boolean read FTopMost write SetTopMost default false;
  876. { Video Mode, you can use Normal mode or VMR mode (VMR is only available on WindowsXP). }
  877. property Mode: TVideoMode read FMode write SetVideoMode default vmNormal;
  878. { The @link(TFilterGraph) component }
  879. property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph;
  880. { Return the Handle where the video is displayed. }
  881. property VideoHandle: THandle read GetVideoHandle;
  882. { Video Mixer Renderer property editor. }
  883. property VMROptions: TVMROptions read FVMROptions write FVMROptions;
  884. { Set the full screen mode. }
  885. property FullScreen: boolean read FFullScreen write SetFullScreen default false;
  886. { Common properties & Events }
  887. {@exclude}
  888. property Color; {@exclude}
  889. property Visible: boolean read GetVisible write SetVisible default True; {@exclude}
  890. property ShowHint; {@exclude}
  891. property Anchors; {@exclude}
  892. property Canvas; {@exclude}
  893. property PopupMenu; {@exclude}
  894. property Align; {@exclude}
  895. property TabStop default True; {@exclude}
  896. property OnEnter; {@exclude}
  897. property OnExit; {@exclude}
  898. property OnKeyDown; {@exclude}
  899. property OnKeyPress; {@exclude}
  900. property OnKeyUp; {@exclude}
  901. property OnCanResize; {@exclude}
  902. property OnClick; {@exclude}
  903. property OnConstrainedResize; {@exclude}
  904. property OnDblClick; {@exclude}
  905. property OnMouseDown; {@exclude}
  906. property OnMouseMove; {@exclude}
  907. property OnMouseUp; {@exclude}
  908. property OnMouseWheel; {@exclude}
  909. property OnMouseWheelDown; {@exclude}
  910. property OnMouseWheelUp; {@exclude}
  911. property OnResize;
  912. end;
  913. //******************************************************************************
  914. //
  915. // TFilterSampleGrabber declaration
  916. // description: Sample Grabber Wrapper Filter
  917. //
  918. //******************************************************************************
  919. {@exclude}
  920. TSampleGrabber = class;
  921. { This class is designed make a snapshoot of Video or Audio Datas.
  922. WARNING: There is know problems with some DIVX movies, so use RGB32 Media Type
  923. instead of RBG24.}
  924. TSampleGrabber = class(TComponent, IFilter, ISampleGrabberCB)
  925. private
  926. FOnBuffer: TOnBuffer;
  927. FBaseFilter: IBaseFilter;
  928. FFilterGraph : TFilterGraph;
  929. FMediaType: TMediaType;
  930. // [pjh, 2003-07-14] delete BMPInfo field
  931. // BMPInfo : PBitmapInfo;
  932. FCriticalSection: TCriticalSection;
  933. function GetFilter: IBaseFilter;
  934. function GetName: string;
  935. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  936. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  937. function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall;
  938. function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: longint): HResult; stdcall;
  939. protected
  940. {@exclude}
  941. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  942. public
  943. { ISampleGrabber Interface to control the SampleGrabber Filter.
  944. The FilterGraph must be active.}
  945. SampleGrabber: ISampleGrabber;
  946. { The Input Pin.
  947. The FilterGraph must be active.}
  948. InPutPin : IPin;
  949. { The Output Pin.
  950. The FilterGraph must be active.}
  951. OutPutPin : IPin;
  952. { Constructor method. }
  953. constructor Create(AOwner: TComponent); override;
  954. { Destructor method. }
  955. destructor Destroy; override;
  956. { Configure the filter to cature the specified MediaType.
  957. This method disconnect the Input pin if connected.
  958. The FilterGraph must be active. }
  959. procedure UpdateMediaType;
  960. {@exclude}
  961. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  962. { Configure the MediaType according to the Source MediaType to be compatible with the BMP format.
  963. if Source = nil then this method use the default value to set the resolution: 1..32.
  964. The MediaType is auto configured to RGB24.}
  965. procedure SetBMPCompatible(Source: PAMMediaType; SetDefault: cardinal);
  966. { This method read the buffer received in the OnBuffer event and paint the bitmap.}
  967. function GetBitmap(Bitmap: TBitmap; Buffer: Pointer; BufferLen: Integer): boolean; overload;
  968. { This method read the current buffer from the Sample Grabber Filter and paint the bitmap.}
  969. function GetBitmap(Bitmap: TBitmap): boolean; overload;
  970. { This method check if the Sample Grabber Filter is correctly registered on the system. }
  971. class function CheckFilter: boolean;
  972. published
  973. { Receive the Buffer from the Sample Grabber Filter. }
  974. property OnBuffer: TOnBuffer read FOnBuffer write FOnBuffer;
  975. { The filter must connected to a TFilterGraph component.}
  976. property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph;
  977. { The media type to capture. You can capture audio or video data. }
  978. property MediaType: TMediaType read FMediaType write FMediaType;
  979. end;
  980. // *****************************************************************************
  981. // TFilter
  982. // *****************************************************************************
  983. { This component is an easy way to add a specific filter to a filter graph.
  984. You can retrieve an interface using the <b>as</b> operator whith D6 :)}
  985. TFilter = class(TComponent, IFilter)
  986. private
  987. FFilterGraph : TFilterGraph;
  988. FBaseFilter: TBaseFilter;
  989. FFilter: IBaseFilter;
  990. function GetFilter: IBaseFilter;
  991. function GetName: string;
  992. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  993. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  994. protected
  995. {@exclude}
  996. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  997. public
  998. { Constructor method. }
  999. constructor Create(AOwner: TComponent); override;
  1000. { Destructor method. }
  1001. destructor Destroy; override;
  1002. { Retrieve a filter interface. }
  1003. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  1004. published
  1005. { This is the Filter Editor .}
  1006. property BaseFilter: TBaseFilter read FBaseFilter write FBaseFilter;
  1007. { The filter must be connected to a TFilterGraph component.}
  1008. property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph;
  1009. end;
  1010. // *****************************************************************************
  1011. // TASFWriter
  1012. // *****************************************************************************
  1013. { This component is designed to create a ASF file or to stream over a network.}
  1014. TASFWriter = class(TComponent, IFilter)
  1015. private
  1016. FFilterGraph : TFilterGraph;
  1017. FFilter : IBaseFilter;
  1018. FPort : Cardinal;
  1019. FMaxUsers : Cardinal;
  1020. FProfile : TWMPofiles8;
  1021. FFileName : WideString;
  1022. FAutoIndex : boolean;
  1023. FMultiPass : boolean;
  1024. FDontCompress: boolean;
  1025. function GetProfile: TWMPofiles8;
  1026. procedure SetProfile(profile: TWMPofiles8);
  1027. function GetFileName: String;
  1028. procedure SetFileName(FileName: String);
  1029. function GetFilter: IBaseFilter;
  1030. function GetName: string;
  1031. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  1032. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  1033. protected
  1034. {@exclude}
  1035. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1036. public
  1037. { Sink configuration. }
  1038. WriterAdvanced2 : IWMWriterAdvanced2;
  1039. { NetWork streaming configuration. }
  1040. WriterNetworkSink : IWMWriterNetworkSink;
  1041. { The Audio Input Pin. }
  1042. AudioInput : IPin;
  1043. { The Video Input Pin. }
  1044. VideoInput : IPin;
  1045. { Audio Input configuration. }
  1046. AudioStreamConfig : IAMStreamConfig;
  1047. { VideoInput configuration}
  1048. VideoStreamConfig : IAMStreamConfig;
  1049. { Destructor method. }
  1050. constructor Create(AOwner: TComponent); override;
  1051. destructor Destroy; override;
  1052. {@exclude}
  1053. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  1054. published
  1055. { The filter must be connected to a TFilterGraph component.}
  1056. property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph;
  1057. { Windows media profile to use. }
  1058. property Profile: TWMPofiles8 read GetProfile write SetProfile;
  1059. { Destination file name to write the compressed file. }
  1060. property FileName: String read GetFileName write SetFileName;
  1061. { Port number to stream.}
  1062. property Port: DWORD read FPort write FPort;
  1063. { The max number of connections. }
  1064. property MaxUsers: DWORD read FMaxUsers write FMaxUsers;
  1065. property AutoIndex : boolean read FAutoIndex write FAutoIndex default True;
  1066. property MultiPass : boolean read FMultiPass write FMultiPass default False;
  1067. property DontCompress: boolean read FDontCompress write FDontCompress default False;
  1068. end;
  1069. // *****************************************************************************
  1070. // TDSTrackBar
  1071. // *****************************************************************************
  1072. {@exclude}
  1073. TTimerEvent = procedure(sender: TObject; CurrentPos, StopPos: Cardinal) of object ;
  1074. { This control implement a seek bar for a media-player application.
  1075. The seek bar is implemented as a TTrackbar control. }
  1076. TDSTrackBar = class(TTrackBar, IEvent)
  1077. private
  1078. FFilterGraph: TFilterGraph;
  1079. FMediaSeeking: IMediaSeeking;
  1080. FWindowHandle: HWND;
  1081. FInterval: Cardinal;
  1082. FOnTimer: TTimerEvent;
  1083. FEnabled: Boolean;
  1084. FMouseDown: boolean;
  1085. procedure UpdateTimer;
  1086. procedure SetTimerEnabled(Value: Boolean);
  1087. procedure SetInterval(Value: Cardinal);
  1088. procedure SetOnTimer(Value: TTimerEvent);
  1089. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  1090. procedure GraphEvent(Event, Param1, Param2: integer);
  1091. procedure ControlEvent(Event: TControlEvent; Param: integer = 0);
  1092. procedure TimerWndProc(var Msg: TMessage);
  1093. property TimerEnabled: Boolean read FEnabled write SetTimerEnabled;
  1094. protected
  1095. {@exclude}
  1096. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1097. {@exclude}
  1098. procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  1099. X, Y: Integer); override;
  1100. {@exclude}
  1101. procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  1102. X, Y: Integer); override;
  1103. {@exclude}
  1104. procedure Timer; dynamic;
  1105. public
  1106. { constructor method. }
  1107. constructor Create(AOwner: TComponent); override;
  1108. { destructor method. }
  1109. destructor Destroy; override;
  1110. published
  1111. { Select the filtergraph to seek. }
  1112. property FilterGraph: TFilterGraph read FFilterGraph Write SetFilterGraph;
  1113. { Select the time interval in miliseconds. default = 1000 mls. }
  1114. property TimerInterval: Cardinal read FInterval write SetInterval default 1000;
  1115. { OnTimer event, you can retrieve the current and stop positions here. }
  1116. property OnTimer: TTimerEvent read FOnTimer write SetOnTimer;
  1117. end;
  1118. { @exclude }
  1119. TDSVideoWindowEx2 = class;
  1120. // *****************************************************************************
  1121. // TColorControl
  1122. // *****************************************************************************
  1123. { Set and Get ColorControls from DSVideoWindowEx's OverlayMixer.
  1124. This is Hardware based so your graphic card has to support it.
  1125. Check DSVideoWindowEx's Capabilities if your card support a given
  1126. colorcontrol.}
  1127. TColorControl = class(TPersistent)
  1128. private
  1129. FBrightness : Integer;
  1130. FContrast : Integer;
  1131. FHue : Integer;
  1132. FSaturation : Integer;
  1133. FSharpness : Integer;
  1134. FGamma : Integer;
  1135. FUtilColor : Boolean;
  1136. FDefault : TDDColorControl;
  1137. protected
  1138. { Protected declarations }
  1139. { @exclude }
  1140. FOwner : TDSVideoWindowEx2;
  1141. { @exclude }
  1142. Procedure SetBrightness(Value : Integer);
  1143. { @exclude }
  1144. Procedure SetContrast(Value : Integer);
  1145. { @exclude }
  1146. procedure SetHue(Value : Integer);
  1147. { @exclude }
  1148. procedure SetSaturation(Value : Integer);
  1149. { @exclude }
  1150. procedure SetSharpness(Value : Integer);
  1151. { @exclude }
  1152. procedure SetGamma(Value : Integer);
  1153. { @exclude }
  1154. procedure SetUtilColor(Value : Boolean);
  1155. { @exclude }
  1156. function GetBrightness : Integer;
  1157. { @exclude }
  1158. function GetContrast : Integer;
  1159. { @exclude }
  1160. function GetHue : Integer;
  1161. { @exclude }
  1162. function GetSaturation : Integer;
  1163. { @exclude }
  1164. function GetSharpness : Integer;
  1165. { @exclude }
  1166. function GetGamma : Integer;
  1167. { @exclude }
  1168. function GetUtilColor : Boolean;
  1169. { @exclude }
  1170. Procedure ReadDefault;
  1171. { @exclude }
  1172. procedure UpdateColorControls;
  1173. { @exclude }
  1174. procedure GetColorControls;
  1175. public
  1176. { Public declarations }
  1177. { @exclude }
  1178. constructor Create(AOwner: TDSVideoWindowEx2); virtual;
  1179. { Restore the colorcontrols to there (Default) values.
  1180. Default is the value the colorcontrol hat, just after we initilized the overlay Mixer. }
  1181. procedure RestoreDefault;
  1182. published
  1183. { The Brightness property defines the luminance intensity, in IRE units, multiplied by 100.
  1184. The possible range is from 0 to 10,000 with a default of 750.}
  1185. property Brightness : Integer read GetBrightness write SetBrightness;
  1186. { The Contrast property defines the relative difference between higher and lower luminance values, in IRE units, multiplied by 100.
  1187. The possible range is from 0 to 20,000 with a default value of 10,000. }
  1188. property Contrast : Integer read GetContrast write SetContrast;
  1189. { The Hue property defines the phase relationship, in degrees, of the chrominance components.
  1190. The possible range is from -180 to 180, with a default of 0.}
  1191. property Hue : Integer read GetHue write SetHue;
  1192. { The Saturation property defines the color intensity, in IRE units, multiplied by 100.
  1193. The possible range is 0 to 20,000, with a default value of 10,000.}
  1194. property Saturation : Integer read GetSaturation write SetSaturation;
  1195. { The Sharpness property defines the sharpness, in arbitrary units, of an image.
  1196. The possible range is 0 to 10, with a default value of 5.}
  1197. property Sharpness : Integer read GetSharpness write SetSharpness;
  1198. { The Gamma property defines the amount, in gamma units, of gamma correction applied to the luminance values.
  1199. The possible range is from 1 to 500, with a default of 1.}
  1200. property Gamma : Integer read GetGamma write SetGamma;
  1201. { The ColorEnable property defines whether color is utilized or not.
  1202. Color is used if this property is 1. Color is not used if this property is 0. The default value is 1.}
  1203. property ColorEnable : Boolean read GetUtilColor write SetUtilColor;
  1204. end;
  1205. // *****************************************************************************
  1206. // TDSVideoWindowEx2Caps
  1207. // *****************************************************************************
  1208. { Check capability of DSVideoWindowEx. }
  1209. TDSVideoWindowEx2Caps = class(TPersistent)
  1210. protected
  1211. { Protected declarations }
  1212. Owner : TDSVideoWindowEx2;
  1213. function GetCanOverlay : Boolean;
  1214. function GetCanControlBrigtness : Boolean;
  1215. function GetCanControlContrast : Boolean;
  1216. function GetCanControlHue : Boolean;
  1217. function GetCanControlSaturation : Boolean;
  1218. function GetCanControlSharpness : Boolean;
  1219. function GetCanControlGamma : Boolean;
  1220. function GetCanControlUtilizedColor : Boolean;
  1221. public
  1222. { Public declarations }
  1223. { @exclude }
  1224. constructor Create(AOwner: TDSVideoWindowEx2); virtual;
  1225. published
  1226. { if CanOverlayGraphics return true, you draw on DSVideoWindowEx's canvas and the
  1227. graphic will bee ontop of the Video.}
  1228. property CanOverlayGraphic : Boolean read GetCanOverlay;
  1229. { Repport if you can control Brightness on the video overlay }
  1230. property CanControlBrigtness : Boolean read GetCanControlBrigtness;
  1231. { Repport if you can control Contrast on the video overlay }
  1232. property CanControlContrast : Boolean read GetCanControlContrast;
  1233. { Repport if you can control Hue on the video overlay }
  1234. property CanControlHue : Boolean read GetCanControlHue;
  1235. { Repport if you can control Saturation on the video overlay }
  1236. property CanControlSaturation : Boolean read GetCanControlSaturation;
  1237. { Repport if you can control Sharpness on the video overlay }
  1238. property CanControlSharpness : Boolean read GetCanControlSharpness;
  1239. { Repport if you can control Gamma on the video overlay }
  1240. property CanControlGamma : Boolean read GetCanControlGamma;
  1241. { Repport if you can control ColorEnabled on the video overlay }
  1242. property CanControlColorEnabled : Boolean read GetCanControlUtilizedColor;
  1243. end;
  1244. // *****************************************************************************
  1245. // TOverlayCallback
  1246. // *****************************************************************************
  1247. { @exclude }
  1248. TOverlayCallback = class(TInterfacedObject, IDDrawExclModeVideoCallBack)
  1249. AOwner : TObject;
  1250. constructor Create(Owner : TObject); virtual;
  1251. function OnUpdateOverlay(bBefore: BOOL; dwFlags: DWORD; bOldVisible: BOOL;
  1252. var prcOldSrc, prcOldDest: TRECT; bNewVisible: BOOL; var prcNewSrc, prcNewDest: TRECT): HRESULT; stdcall;
  1253. function OnUpdateColorKey(var pKey: TCOLORKEY; dwColor: DWORD): HRESULT; stdcall;
  1254. function OnUpdateSize(dwWidth, dwHeight, dwARWidth, dwARHeight: DWORD): HRESULT; stdcall;
  1255. end;
  1256. // *****************************************************************************
  1257. // TDSVideoWindowEx2
  1258. // *****************************************************************************
  1259. { @exclude }
  1260. TRatioModes = (rmStretched, rmLetterBox, rmCrop);
  1261. { @exclude }
  1262. TOverlayVisibleEvent = procedure (Sender: TObject; Visible : Boolean) of object;
  1263. { @exclude }
  1264. TCursorVisibleEvent = procedure (Sender: TObject; Visible : Boolean) of object;
  1265. { A alternative to the regular Video Renderer (TVideoWindow), that give a easy way to overlay graphics
  1266. onto your video in your application. }
  1267. TDSVideoWindowEx2 = class(TCustomControl, IFilter, IEvent)
  1268. private
  1269. FVideoWindow : IVideoWindow;
  1270. FFilterGraph : TFilterGraph;
  1271. FBaseFilter : IBaseFilter;
  1272. FOverlayMixer : IBaseFilter;
  1273. FVideoRenderer : IBaseFilter;
  1274. FDDXM : IDDrawExclModeVideo;
  1275. FFullScreen : Boolean;
  1276. FTopMost : Boolean;
  1277. FColorKey : TColor;
  1278. FWindowStyle : LongWord;
  1279. FWindowStyleEx : LongWord;
  1280. FVideoRect : TRect;
  1281. FOnPaint : TNotifyEvent;
  1282. FOnColorKey : TNotifyEvent;
  1283. FOnCursorVisible : TCursorVisibleEvent;
  1284. FOnOverlay : TOverlayVisibleEvent;
  1285. FColorControl : TColorControl;
  1286. FCaps : TDSVideoWindowEx2Caps;
  1287. FZoom : Integer;
  1288. FAspectMode : TRatioModes;
  1289. FNoScreenSaver : Boolean;
  1290. FIdleCursor : Integer;
  1291. FMonitor : TMonitor;
  1292. FFullscreenControl : TForm;
  1293. GraphWasUpdatet : Boolean;
  1294. FOldParent : TWinControl;
  1295. OverlayCallback : TOverlayCallback;
  1296. GraphBuildOK : Boolean;
  1297. FVideoWindowHandle : HWND;
  1298. LMousePos : TPoint;
  1299. LCursorMov : DWord;
  1300. RememberCursor : TCursor;
  1301. IsHidden : Bool;
  1302. FOverlayVisible : Boolean;
  1303. OldDesktopColor : Longint;
  1304. OldDesktopPic : String;
  1305. FDesktopPlay : Boolean;
  1306. procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  1307. procedure GraphEvent(Event, Param1, Param2: integer);
  1308. function GetName: string;
  1309. procedure ControlEvent(Event: TControlEvent; Param: integer = 0);
  1310. procedure SetFilterGraph(AFilterGraph: TFilterGraph);
  1311. procedure SetTopMost(TopMost: boolean);
  1312. procedure SetZoom(Value : Integer);
  1313. function UpdateGraph : HResult;
  1314. function GetVideoInfo : HResult;
  1315. procedure SetAspectMode(Value : TRatioModes);
  1316. procedure FullScreenCloseQuery(Sender: TObject; var CanClose: Boolean);
  1317. procedure SetVideoZOrder;
  1318. protected
  1319. FIsVideoWindowOwner: Boolean;
  1320. {@exclude}
  1321. function GetFilter: IBaseFilter;
  1322. {@exclude}
  1323. procedure resize; override;
  1324. {@exclude}
  1325. procedure Loaded; override;
  1326. {@exclude}
  1327. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1328. {@exclude}
  1329. procedure WndProc(var Message: TMessage); override;
  1330. {@exclude}
  1331. procedure Paint; override;
  1332. {@exclude}
  1333. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  1334. {@exclude}
  1335. procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  1336. {@exclude}
  1337. procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  1338. {@exclude}
  1339. procedure MyIdleHandler(Sender: TObject; var Done: Boolean);
  1340. {@exclude}
  1341. procedure RefreshVideoWindow;
  1342. public
  1343. { constructor method. }
  1344. constructor Create(AOwner: TComponent); override;
  1345. { destructor method. }
  1346. destructor Destroy; override;
  1347. {@exclude}
  1348. function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  1349. { Clear the graphic ontop of DSVideoWindowEx. }
  1350. procedure ClearBack;
  1351. { Use your Desktop as the Video renderer.
  1352. The video will display as a "wallpaper" on your Desktop }
  1353. procedure StartDesktopPlayback; overload;
  1354. { Use your Desktop as the Video renderer.
  1355. The video will display as a "wallpaper" on your Desktop on the
  1356. specifyed monitor}
  1357. procedure StartDesktopPlayBack(OnMonitor : TMonitor); overload;
  1358. { Return to normal window playback from Fullscreen or Desktop mode. }
  1359. procedure NormalPlayback;
  1360. { Start playback in fullscreen }
  1361. procedure StartFullScreen; overload;
  1362. { Start playback in fullscreen on specifyed Monitor}
  1363. procedure StartFullScreen(OnMonitor : TMonitor); overload;
  1364. { repporting if you are currently playing in fullscreen. }
  1365. property FullScreen: boolean read FFullScreen;
  1366. { repporting if you are currently playing on the Desktop. }
  1367. property DesktopPlayback : Boolean Read FDesktopPlay;
  1368. { @inherited }
  1369. property Canvas;
  1370. { The Colorkey is the color that the Overlay Mixer Filter used by DSVideoWindowEx sees
  1371. as transparent, when you draw ontop of the movie always set the canvas’s brush
  1372. color to this color or set the style to bsclear.
  1373. Note: The colors returned through this method vary depending on the current display mode.
  1374. if the colors are 8-bit palettized, they will be bright system colors (such as magenta).
  1375. if the display is in a true-color mode, they will be shades of black. }
  1376. property ColorKey : TColor read FColorKey;
  1377. { @link(TDSVideoWindowEx2Caps) }
  1378. property Capabilities : TDSVideoWindowEx2Caps read FCaps;
  1379. { Check this property to see if the overlay is visible when you draw on DSVideoWindowEx's
  1380. canvas, if it is visible you should set your brush color to the same as the VideoColor and
  1381. if not set your brush to the same color as DSVideoWindowEx color. }
  1382. property OverlayVisible : Boolean read FOverlayVisible;
  1383. property IsVideoWindowOwner: Boolean read FIsVideoWindowOwner write FIsVideoWindowOwner;
  1384. published
  1385. { The AspectRatio property sets the aspect ratio correction mode for window resizing.
  1386. rmSTRETCHED : No aspect ratio correction.
  1387. rmLETTERBOX : Put the video in letterbox format. Paint background color in the
  1388. excess region so the video is not distorted.
  1389. rmCROP : Crop the video to the correct aspect ratio. }
  1390. property AspectRatio : TRatioModes read FAspectMode write SetAspectMode;
  1391. { Set the amounts of milliseconds befor the cursor is hidden, if it is not moved.
  1392. Setting the value to 0 will disable this feature. }
  1393. property AutoHideCursor : Integer read FIdleCursor write FIdleCursor;
  1394. { Specify a Zoom factor from 0 to 99 procent. }
  1395. property DigitalZoom : Integer read FZoom write SetZoom;
  1396. { The @link(TFilterGraph) component }
  1397. property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph;
  1398. { Select if the VideoWindow it topmost or not. }
  1399. property FullScreenTopMost: boolean read FTopMost write SetTopMost default false;
  1400. { Event to tell the main application that the Colorkey has changed.
  1401. Note: if you have controls placed ontop of your VideoWindow that need to act as
  1402. transparent, set there color to the same as the Colorkey.}
  1403. property OnColorKeyChanged: TNotifyEvent read FOnColorKey write FOnColorKey;
  1404. { @link(TColorControl) }
  1405. property ColorControl : TColorControl read FColorControl write FColorControl;
  1406. { Setting this to true will prevent the screen to go into screensaver or powerdown. }
  1407. property NoScreenSaver : Boolean read FNoScreenSaver write FNoScreenSaver;
  1408. { This event accure when the Visible state of the overlay changes
  1409. Note: Most used to hide the video in the player window when going to
  1410. DesktopPlayback. }
  1411. property OnOverlayVisible : TOverlayVisibleEvent read FOnOverlay write FOnOverlay;
  1412. property OnPaint : TNotifyevent read FOnPaint Write FOnPaint;
  1413. { This event accure when the cursor change from showing to hiding or from hiding to showing. }
  1414. property OnCursorShowHide : TCursorVisibleEvent read FOnCursorVisible write FOnCursorVisible;
  1415. property Color; {@exclude}
  1416. property Visible; {@exclude}
  1417. property ShowHint; {@exclude}
  1418. property Anchors; {@exclude}
  1419. property PopupMenu; {@exclude}
  1420. property Align; {@exclude}
  1421. property TabStop default True; {@exclude}
  1422. property OnEnter; {@exclude}
  1423. property OnExit; {@exclude}
  1424. property OnKeyDown; {@exclude}
  1425. property OnKeyPress; {@exclude}
  1426. property OnKeyUp; {@exclude}
  1427. property OnCanResize; {@exclude}
  1428. property OnClick; {@exclude}
  1429. property OnConstrainedResize; {@exclude}
  1430. property OnDblClick; {@exclude}
  1431. property OnMouseDown; {@exclude}
  1432. property OnMouseMove; {@exclude}
  1433. property OnMouseUp; {@exclude}
  1434. property OnMouseWheel; {@exclude}
  1435. property OnMouseWheelDown; {@exclude}
  1436. property OnMouseWheelUp; {@exclude}
  1437. property OnResize;
  1438. end;
  1439. ////////////////////////////////////////////////////////////////////////////////
  1440. //
  1441. // TVMRBitmap Class
  1442. //
  1443. ////////////////////////////////////////////////////////////////////////////////
  1444. type
  1445. { vmrbDisable: Disable the alpha bitmap.
  1446. vmrbSrcColorKey: Enable ColorKey.
  1447. vmrbSrcRect: Indicates that the Dest property is valid and specifies
  1448. a sub-rectangle of the original image to be blended. }
  1449. TVMRBitmapOption = (
  1450. vmrbDisable,
  1451. vmrbSrcColorKey,
  1452. vmrbSrcRect
  1453. );
  1454. TVMRBitmapOptions = set of TVMRBitmapOption;
  1455. TVMRBitmap = class
  1456. private
  1457. FVideoWindow: TVideoWindow;
  1458. FCanvas: TCanvas;
  1459. FVMRALPHABITMAP: TVMR9ALPHABITMAP;
  1460. FOptions: TVMRBitmapOptions;
  1461. FBMPOld: HBITMAP;
  1462. procedure SetOptions(Options: TVMRBitmapOptions);
  1463. procedure ResetBitmap;
  1464. procedure SetAlpha(const Value: Single);
  1465. procedure SetColorKey(const Value: COLORREF);
  1466. procedure SetDest(const Value: TVMR9NormalizedRect);
  1467. procedure SetDestBottom(const Value: Single);
  1468. procedure SetDestLeft(const Value: Single);
  1469. procedure SetDestRight(const Value: Single);
  1470. procedure SetDestTop(const Value: Single);
  1471. procedure SetSource(const Value: TRect);
  1472. function GetAlpha: Single;
  1473. function GetColorKey: COLORREF;
  1474. function GetDest: TVMR9NormalizedRect;
  1475. function GetDestBottom: Single;
  1476. function GetDestLeft: Single;
  1477. function GetDestRight: Single;
  1478. function GetDestTop: Single;
  1479. function GetSource: TRect;
  1480. public
  1481. // Contructor, set the video Window where the bitmat must be paint.
  1482. constructor Create(VideoWindow: TVideoWindow);
  1483. // Cleanup
  1484. destructor Destroy; override;
  1485. // Load a Bitmap from a TBitmap class.
  1486. procedure LoadBitmap(Bitmap: TBitmap);
  1487. // Initialize with an empty bitmap.
  1488. procedure LoadEmptyBitmap(Width, Height: Integer; PixelFormat: TPixelFormat; Color: TColor);
  1489. // Draw the bitmap to the Video Window.
  1490. procedure Draw;
  1491. // Draw the bitmap on a particular position.
  1492. procedure DrawTo(Left, Top, Right, Bottom, Alpha: Single; doUpdate: boolean = false);
  1493. // update the video window with the current bitmap
  1494. procedure Update;
  1495. // Uses this property to draw on the internal bitmap.
  1496. property Canvas: TCanvas read FCanvas write FCanvas;
  1497. // Change Alpha Blending
  1498. property Alpha: Single read GetAlpha write SetAlpha;
  1499. // set the source rectangle
  1500. property Source: TRect read GetSource write SetSource;
  1501. // Destination Left
  1502. property DestLeft : Single read GetDestLeft write SetDestLeft;
  1503. // Destination Top
  1504. property DestTop : Single read GetDestTop write SetDestTop;
  1505. // Destination Right
  1506. property DestRight : Single read GetDestRight write SetDestRight;
  1507. // Destination Bottom
  1508. property DestBottom : Single read GetDestBottom write SetDestBottom;
  1509. // Destination
  1510. property Dest: TVMR9NormalizedRect read GetDest write SetDest;
  1511. // Set the color key for transparency.
  1512. property ColorKey: COLORREF read GetColorKey write SetColorKey;
  1513. // VMR Bitmap Options.
  1514. property Options: TVMRBitmapOptions read FOptions write SetOptions;
  1515. end;
  1516. implementation
  1517. uses ComObj;
  1518. const
  1519. CLSID_FilterGraphCallback: TGUID = '{C7CAA944-C191-4AB1-ABA7-D8B40EF4D5B2}';
  1520. // *****************************************************************************
  1521. // TFilterGraph
  1522. // *****************************************************************************
  1523. constructor TFilterGraph.Create(AOwner: TComponent);
  1524. begin
  1525. inherited Create(AOwner);
  1526. FHandle := AllocateHWnd(WndProc);
  1527. FVolume := 10000;
  1528. FBalance := 0;
  1529. FRate := 1.0;
  1530. FLinearVolume := True;
  1531. end;
  1532. destructor TFilterGraph.Destroy;
  1533. begin
  1534. SetActive(False);
  1535. DeallocateHWnd(FHandle);
  1536. inherited Destroy;
  1537. end;
  1538. procedure TFilterGraph.SetGraphMode(Mode: TGraphMode);
  1539. var WasActive: boolean;
  1540. begin
  1541. if FMode = Mode then exit;
  1542. WasActive := Active;
  1543. Active := False;
  1544. FMode := Mode;
  1545. Active := WasActive;
  1546. end;
  1547. procedure TFilterGraph.SetActive(Activate: boolean);
  1548. var
  1549. obj: IObjectWithSite;
  1550. fgcb: IAMFilterGraphCallback;
  1551. gbcb: IAMGraphBuilderCallback;
  1552. const
  1553. IID_IObjectWithSite: TGuid = '{FC4801A3-2BA9-11CF-A229-00AA003D7352}';
  1554. begin
  1555. if Activate = FActive then exit;
  1556. case Activate of
  1557. true :
  1558. begin
  1559. case FMode of
  1560. gmNormal : CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FFilterGraph);
  1561. gmCapture: begin
  1562. CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraph);
  1563. CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FFilterGraph);
  1564. FCaptureGraph.SetFiltergraph(IGraphBuilder(FFilterGraph));
  1565. end;
  1566. gmDVD : begin
  1567. CoCreateInstance(CLSID_DvdGraphBuilder, nil, CLSCTX_INPROC_SERVER, IID_IDvdGraphBuilder, FDvdGraph);
  1568. FDvdGraph.GetFiltergraph(IGraphBuilder(FFilterGraph));
  1569. end;
  1570. end;
  1571. FActive := true;
  1572. // Events
  1573. if Succeeded(QueryInterface(IMediaEventEx, FMediaEventEx)) then
  1574. begin
  1575. FMediaEventEx.SetNotifyFlags(0); // enable events notification
  1576. FMediaEventEx.SetNotifyWindow(FHandle,WM_GRAPHNOTIFY,ULONG(FMediaEventEx));
  1577. end;
  1578. // Callbacks
  1579. if Succeeded(QueryInterface(IID_IObjectWithSite,obj)) then
  1580. begin
  1581. QueryInterface(IID_IAMGraphBuilderCallback,gbcb);
  1582. if Assigned(gbcb) then
  1583. begin
  1584. obj.SetSite(gbcb);
  1585. gbcb := nil;
  1586. end;
  1587. QueryInterface(IID_IAMFilterGraphCallback,fgcb);
  1588. if Assigned(fgcb) then
  1589. begin
  1590. obj.SetSite(fgcb);
  1591. fgcb := nil;
  1592. end;
  1593. obj := nil;
  1594. end;
  1595. // Remote Object Table
  1596. GraphEdit := FGraphEdit; // Add the Filter Graph to the ROT if needed.
  1597. // Log File
  1598. SetLogFile(FLogFileName);
  1599. // Load Filters
  1600. AddOwnFilters;
  1601. // Notify Controlers
  1602. if assigned(FOnActivate) then FOnActivate(self);
  1603. ControlEvents(ceActive, 1);
  1604. end;
  1605. false:
  1606. begin
  1607. ControlEvents(ceActive, 0);
  1608. ClearOwnFilters;
  1609. if FMediaEventEx <> nil then
  1610. begin
  1611. FMediaEventEx.SetNotifyFlags(AM_MEDIAEVENT_NONOTIFY); // disable events notification
  1612. FMediaEventEx := nil;
  1613. end;
  1614. if FGraphEditID <> 0 then
  1615. begin
  1616. RemoveGraphFromRot(FGraphEditID);
  1617. FGraphEditID := 0;
  1618. end;
  1619. FFilterGraph.SetLogFile(0);
  1620. if Assigned(FLogFile) then FreeAndNil(FLogFile);
  1621. FFilterGraph := nil;
  1622. FCaptureGraph := nil;
  1623. FDVDGraph := nil;
  1624. FActive := false;
  1625. end;
  1626. end;
  1627. end;
  1628. procedure TFilterGraph.Loaded;
  1629. begin
  1630. if AutoCreate and (not (csDesigning in ComponentState)) then SetActive(True);
  1631. inherited Loaded;
  1632. end;
  1633. procedure TFilterGraph.WndProc(var Msg: TMessage);
  1634. begin
  1635. with Msg do
  1636. if Msg = WM_GRAPHNOTIFY then
  1637. try
  1638. HandleEvents;
  1639. except
  1640. Application.HandleException(Self);
  1641. end
  1642. else
  1643. Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  1644. end;
  1645. procedure TFilterGraph.HandleEvents;
  1646. var hr: HRESULT;
  1647. Event, Param1, Param2: Integer;
  1648. begin
  1649. if assigned(FMediaEventEx) then
  1650. begin
  1651. hr := FMediaEventEx.GetEvent(Event, Param1, Param2, 0);
  1652. while (hr = S_OK) do
  1653. begin
  1654. DoEvent(Event, Param1, Param2);
  1655. FMediaEventEx.FreeEventParams(Event, Param1, Param2);
  1656. hr := FMediaEventEx.GetEvent(Event, Param1, Param2, 0);
  1657. end;
  1658. end;
  1659. end;
  1660. procedure TFilterGraph.DoEvent(Event, Param1, Param2: Integer);
  1661. type
  1662. TVideoSize = record
  1663. Width : WORD;
  1664. Height: WORD;
  1665. end;
  1666. var
  1667. lcid : cardinal;
  1668. achLang : array[0..MAX_PATH] of Char;
  1669. tc : TDVDTimeCode;
  1670. frate : integer;
  1671. hmsftc : TDVDHMSFTimeCode;
  1672. DVDInfo2: IDVDInfo2;
  1673. begin
  1674. GraphEvents(Event, Param1, Param2);
  1675. if assigned(FOnDSEvent) then FOnDSEvent(self, Event, Param1, Param2);
  1676. case Event of
  1677. EC_BUFFERING_DATA : if assigned(FOnGraphBufferingData) then FOnGraphBufferingData(self,(Param1 = 1));
  1678. EC_CLOCK_CHANGED : if assigned(FOnGraphClockChanged) then FOnGraphClockChanged(self);
  1679. EC_COMPLETE : if assigned(FOnGraphComplete) then FOnGraphComplete(self, Param1, IBaseFilter(Param2));
  1680. EC_DEVICE_LOST : if assigned(FOnGraphDeviceLost) then FOnGraphDeviceLost(self,IUnKnown(Param1),(Param2 = 1));
  1681. EC_END_OF_SEGMENT : if assigned(FOnGraphEndOfSegment) then FOnGraphEndOfSegment(self, PReferenceTime(Param1)^, Param2);
  1682. EC_ERROR_STILLPLAYING : if assigned(FOnGraphErrorStillPlaying) then FOnGraphErrorStillPlaying(self, Param1);
  1683. EC_ERRORABORT : if assigned(FOnGraphErrorAbort) then FOnGraphErrorAbort(self, Param1);
  1684. EC_FULLSCREEN_LOST : if assigned(FOnGraphFullscreenLost) then FOnGraphFullscreenLost(self, IBaseFilter(Param2));
  1685. EC_GRAPH_CHANGED : if assigned(FOnGraphChanged) then FOnGraphChanged(self);
  1686. EC_OLE_EVENT : if assigned(FOnGraphOleEvent) then FOnGraphOleEvent(self, WideString(Param1), WideString(Param2));
  1687. EC_OPENING_FILE : if assigned(FOnGraphOpeningFile) then FOnGraphOpeningFile(self, (Param1 = 1));
  1688. EC_PALETTE_CHANGED : if assigned(FOnGraphPaletteChanged) then FOnGraphPaletteChanged(self);
  1689. EC_PAUSED : if assigned(FOnGraphPaused) then FOnGraphPaused(self, Param1);
  1690. EC_QUALITY_CHANGE : if assigned(FOnGraphQualityChange) then FOnGraphQualityChange(self);
  1691. EC_SNDDEV_IN_ERROR : if assigned(FOnGraphSNDDevInError) then FOnGraphSNDDevInError(self, TSndDevErr(Param1), Param2);
  1692. EC_SNDDEV_OUT_ERROR : if assigned(FOnGraphSNDDevOutError) then FOnGraphSNDDevOutError(self, TSndDevErr(Param1), Param2);
  1693. EC_STEP_COMPLETE : if assigned(FOnGraphStepComplete) then FOnGraphStepComplete(self);
  1694. EC_STREAM_CONTROL_STARTED : if assigned(FOnGraphStreamControlStarted) then FOnGraphStreamControlStarted(self, IPin(Param1), Param2);
  1695. EC_STREAM_CONTROL_STOPPED : if assigned(FOnGraphStreamControlStopped) then FOnGraphStreamControlStopped(self, IPin(Param1), Param2);
  1696. EC_STREAM_ERROR_STILLPLAYING : if assigned(FOnGraphStreamErrorStillPlaying) then FOnGraphStreamErrorStillPlaying(self, Param1, Param2);
  1697. EC_STREAM_ERROR_STOPPED : if assigned(FOnGraphStreamErrorStopped) then FOnGraphStreamErrorStopped(self, Param1, Param2);
  1698. EC_USERABORT : if assigned(FOnGraphUserAbort) then FOnGraphUserAbort(self);
  1699. EC_VIDEO_SIZE_CHANGED : if assigned(FOnGraphVideoSizeChanged) then FOnGraphVideoSizeChanged(self, TVideoSize(Param1).Width, TVideoSize(Param1).Height);
  1700. EC_TIMECODE_AVAILABLE : if assigned(FOnGraphTimeCodeAvailable) then FOnGraphTimeCodeAvailable(self,IBaseFilter(Param1), Param2);
  1701. EC_EXTDEVICE_MODE_CHANGE : if assigned(FOnGraphEXTDeviceModeChange) then FOnGraphEXTDeviceModeChange(self, Param1, Param2);
  1702. EC_CLOCK_UNSET : if assigned(FOnGraphClockUnset) then FOnGraphClockUnset(self);
  1703. EC_VMR_RENDERDEVICE_SET : if assigned(FOnGraphVMRRenderDevice) then FOnGraphVMRRenderDevice(self, TVMRRenderDevice(Param1)) ;
  1704. EC_DVD_ANGLE_CHANGE : if Assigned(FOnDVDAngleChange) then FOnDVDAngleChange(self,Param1,Param2);
  1705. EC_DVD_AUDIO_STREAM_CHANGE :
  1706. begin
  1707. if Assigned(FOnDVDAudioStreamChange) then
  1708. if Succeeded(QueryInterFace(IDVDInfo2,DVDInfo2)) then
  1709. begin
  1710. CheckDSError(DvdInfo2.GetAudioLanguage(Param1, lcid));
  1711. GetLocaleInfo(lcid, LOCALE_SENGLANGUAGE, achLang, MAX_PATH);
  1712. FOnDVDAudioStreamChange(self, Param1, lcid, string(achLang));
  1713. DVDInfo2 := nil;
  1714. end;
  1715. end;
  1716. EC_DVD_BUTTON_CHANGE : if Assigned(FOnDVDButtonChange) then FOnDVDButtonChange(self, Param1, Param2);
  1717. EC_DVD_CHAPTER_AUTOSTOP : if Assigned(FOnDVDChapterAutoStop) then FOnDVDChapterAutoStop(self);
  1718. EC_DVD_CHAPTER_START : if Assigned(FOnDVDChapterStart) then FOnDVDChapterStart(self, Param1);
  1719. EC_DVD_CURRENT_TIME :
  1720. begin
  1721. if Assigned(FOnDVDCurrentTime) then
  1722. begin
  1723. tc := IntToTimeCode(Param1);
  1724. case tc.FrameRateCode of
  1725. 1 : frate := 25;
  1726. 3 : frate := 30;
  1727. else
  1728. frate := 0;
  1729. end;
  1730. FOnDVDCurrentTime(self,tc.Hours1+tc.Hours10*10,tc.Minutes1+tc.Minutes10*10,tc.Seconds1+tc.Seconds10*10,tc.Frames1+tc.Frames10*10,frate);
  1731. end;
  1732. end;
  1733. EC_DVD_DOMAIN_CHANGE :
  1734. begin
  1735. case Param1 of
  1736. 1 : if Assigned(FOnDVDDomainFirstPlay) then FOnDVDDomainFirstPlay(self);
  1737. 2 : if Assigned(FOnDVDDomainVideoManagerMenu) then FOnDVDDomainVideoManagerMenu(self);
  1738. 3 : if Assigned(FOnDVDDomainVideoTitleSetMenu) then FOnDVDDomainVideoTitleSetMenu(self);
  1739. 4 : if Assigned(FOnDVDDomainTitle) then FOnDVDDomainTitle(self);
  1740. 5 : if Assigned(FOnDVDDomainStop) then FOnDVDDomainStop(self);
  1741. end;
  1742. end;
  1743. EC_DVD_ERROR :
  1744. begin
  1745. case Param1 of
  1746. 1 : if Assigned(FOnDVDErrorUnexpected) then FOnDVDErrorUnexpected(self);
  1747. 2 : if Assigned(FOnDVDErrorCopyProtectFail) then FOnDVDErrorCopyProtectFail(self);
  1748. 3 : if Assigned(FOnDVDErrorInvalidDVD1_0Disc) then FOnDVDErrorInvalidDVD1_0Disc(self);
  1749. 4 : if Assigned(FOnDVDErrorInvalidDiscRegion) then FOnDVDErrorInvalidDiscRegion(self);
  1750. 5 : if Assigned(FOnDVDErrorLowParentalLevel) then FOnDVDErrorLowParentalLevel(self);
  1751. 6 : if Assigned(FOnDVDErrorMacrovisionFail) then FOnDVDErrorMacrovisionFail(self);
  1752. 7 : if Assigned(FOnDVDErrorIncompatibleSystemAndDecoderRegions) then FOnDVDErrorIncompatibleSystemAndDecoderRegions(self);
  1753. 8 : if Assigned(FOnDVDErrorIncompatibleDiscAndDecoderRegions) then FOnDVDErrorIncompatibleDiscAndDecoderRegions(self);
  1754. end;
  1755. end;
  1756. EC_DVD_NO_FP_PGC : if Assigned(FOnDVDNoFP_PGC) then FOnDVDNoFP_PGC(self);
  1757. EC_DVD_STILL_OFF : if Assigned(FOnDVDStillOff) then FOnDVDStillOff(self);
  1758. EC_DVD_STILL_ON : if Assigned(FOnDVDStillOn) then FOnDVDStillOn(self,(Param1 = 1), Param2);
  1759. EC_DVD_SUBPICTURE_STREAM_CHANGE:
  1760. begin
  1761. if Assigned(FOnDVDSubpictureStreamChange) and Succeeded(QueryInterFace(IDVDInfo2,DVDInfo2)) then
  1762. begin
  1763. DvdInfo2.GetSubpictureLanguage(Param1,lcid);
  1764. GetLocaleInfo(lcid,LOCALE_SENGLANGUAGE,achLang,MAX_PATH);
  1765. FOnDVDSubpictureStreamChange(self,Param1,lcid,string(achLang));
  1766. DVDInfo2 := nil;
  1767. end;
  1768. end;
  1769. EC_DVD_TITLE_CHANGE : if Assigned(FOnDVDTitleChange) then FOnDVDTitleChange(self,Param1);
  1770. EC_DVD_VALID_UOPS_CHANGE : if Assigned(FOnDVDValidUOPSChange) then FOnDVDValidUOPSChange(self, Param1);
  1771. EC_DVD_WARNING :
  1772. begin
  1773. case Param1 of
  1774. 1 : if Assigned(FOnDVDWarningInvalidDVD1_0Disc) then FOnDVDWarningInvalidDVD1_0Disc(self);
  1775. 2 : if Assigned(FOnDVDWarningFormatNotSupported) then FOnDVDWarningFormatNotSupported(self);
  1776. 3 : if Assigned(FOnDVDWarningIllegalNavCommand) then FOnDVDWarningIllegalNavCommand(self);
  1777. 4 : if Assigned(FOnDVDWarningOpen) then FOnDVDWarningOpen(self);
  1778. 5 : if Assigned(FOnDVDWarningSeek) then FOnDVDWarningSeek(self);
  1779. 6 : if Assigned(FOnDVDWarningRead) then FOnDVDWarningRead(self);
  1780. end;
  1781. end;
  1782. EC_DVD_PLAYBACK_RATE_CHANGE : if Assigned(FOnDVDPlaybackRateChange) then FOnDVDPlaybackRateChange(self, Param1/10000);
  1783. EC_DVD_PARENTAL_LEVEL_CHANGE : if Assigned(FOnDVDParentalLevelChange) then FOnDVDParentalLevelChange(self,Param1);
  1784. EC_DVD_PLAYBACK_STOPPED : if Assigned(FOnDVDPlaybackStopped) then FOnDVDPlaybackStopped(self);
  1785. EC_DVD_ANGLES_AVAILABLE : if Assigned(FOnDVDAnglesAvailable) then FOnDVDAnglesAvailable(self,(Param1 = 1));
  1786. EC_DVD_PLAYPERIOD_AUTOSTOP : if Assigned(FOnDVDPlayPeriodAutoStop) then FOnDVDPlayPeriodAutoStop(self);
  1787. EC_DVD_BUTTON_AUTO_ACTIVATED : if Assigned(FOnDVDButtonAutoActivated) then FOnDVDButtonAutoActivated(self,Param1);
  1788. EC_DVD_CMD_START : if Assigned(FOnDVDCMDStart) then FOnDVDCMDStart(self,Param1);
  1789. EC_DVD_CMD_END : if Assigned(FOnDVDCMDEnd) then FOnDVDCMDEnd(self,Param1);
  1790. EC_DVD_DISC_EJECTED : if Assigned(FOnDVDDiscEjected) then FOnDVDDiscEjected(self);
  1791. EC_DVD_DISC_INSERTED : if Assigned(FOnDVDDiscInserted) then FOnDVDDiscInserted(self);
  1792. EC_DVD_CURRENT_HMSF_TIME :
  1793. begin
  1794. if assigned(FOnDVDCurrentHMSFTime) then
  1795. begin
  1796. hmsftc := TDVDHMSFTimeCode(param1);
  1797. tc := IntToTimeCode(Param2);
  1798. FOnDVDCurrentHMSFTime(self,hmsftc,tc);
  1799. end;
  1800. end;
  1801. EC_DVD_KARAOKE_MODE : if assigned(FOnDVDKaraokeMode) then FOnDVDKaraokeMode(self,BOOL(Param1));
  1802. end;
  1803. end;
  1804. function TFilterGraph.QueryInterface(const IID: TGUID; out Obj): HResult;
  1805. begin
  1806. result := inherited QueryInterface(IID, Obj);
  1807. if (not Succeeded(result)) and Active then
  1808. case FMode of
  1809. gmNormal : result := FFilterGraph.QueryInterface(IID, Obj);
  1810. gmCapture : begin
  1811. result := FCaptureGraph.QueryInterface(IID, Obj);
  1812. if not Succeeded(result) then result := FFilterGraph.QueryInterface(IID, Obj);
  1813. end;
  1814. gmDVD : begin
  1815. result := FDvdGraph.QueryInterface(IID, Obj);
  1816. if not Succeeded(result) then result := FDvdGraph.GetDvdInterface(IID, Obj);
  1817. if not Succeeded(result) then result := FFilterGraph.QueryInterface(IID, Obj);
  1818. end;
  1819. end;
  1820. end;
  1821. procedure TFilterGraph.SetGraphEdit(enable: boolean);
  1822. begin
  1823. case enable of
  1824. true :
  1825. begin
  1826. if FGraphEditID = 0 then
  1827. if Active then
  1828. AddGraphToRot(IFilterGraph2(FFilterGraph) , FGraphEditID);
  1829. end;
  1830. false :
  1831. begin
  1832. if FGraphEditID <> 0 then
  1833. begin
  1834. RemoveGraphFromRot(FGraphEditID);
  1835. FGraphEditID := 0;
  1836. end;
  1837. end;
  1838. end;
  1839. FGraphEdit := enable;
  1840. end;
  1841. procedure TFilterGraph.InsertFilter(AFilter: IFilter);
  1842. var FilterName: WideString;
  1843. begin
  1844. if FFilters = nil then FFilters := TInterfaceList.Create;
  1845. FFilters.Add(AFilter);
  1846. if active then
  1847. begin
  1848. AFilter.NotifyFilter(foAdding);
  1849. FilterName := AFilter.GetName;
  1850. FFilterGraph.AddFilter(AFilter.GetFilter, PWideChar(FilterName));
  1851. AFilter.NotifyFilter(foAdded);
  1852. end;
  1853. end;
  1854. procedure TFilterGraph.RemoveFilter(AFilter: IFilter);
  1855. begin
  1856. FFilters.Remove(AFilter);
  1857. if active then
  1858. begin
  1859. AFilter.NotifyFilter(foRemoving);
  1860. FFilterGraph.RemoveFilter(AFilter.GetFilter);
  1861. AFilter.NotifyFilter(foRemoved);
  1862. end;
  1863. if FFilters.Count = 0 then
  1864. FreeAndNil(FFilters);
  1865. end;
  1866. procedure TFilterGraph.InsertEventNotifier(AEvent: IEvent);
  1867. begin
  1868. if FGraphEvents = nil then FGraphEvents := TInterFaceList.Create;
  1869. FGraphEvents.Add(AEvent);
  1870. end;
  1871. procedure TFilterGraph.RemoveEventNotifier(AEvent: IEvent);
  1872. begin
  1873. if FGraphEvents <> nil then
  1874. begin
  1875. FGraphEvents.Remove(AEvent);
  1876. if FGraphEvents.Count = 0 then FreeAndNil(FGraphEvents);
  1877. end;
  1878. end;
  1879. procedure TFilterGraph.ClearOwnFilters;
  1880. var i: integer;
  1881. begin
  1882. if Active and (FFilters <> nil) then
  1883. for i := 0 to FFilters.Count - 1 do
  1884. begin
  1885. IFilter(FFilters.Items[i]).NotifyFilter(foRemoving);
  1886. FFilterGraph.RemoveFilter(IFilter(FFilters.Items[i]).GetFilter);
  1887. IFilter(FFilters.Items[i]).NotifyFilter(foRemoved);
  1888. end;
  1889. end;
  1890. procedure TFilterGraph.AddOwnFilters;
  1891. var
  1892. i: integer;
  1893. FilterName: WideString;
  1894. begin
  1895. if Active and (FFilters <> nil) then
  1896. for i := 0 to FFilters.Count - 1 do
  1897. begin
  1898. IFilter(FFilters.Items[i]).NotifyFilter(foAdding);
  1899. FilterName := IFilter(FFilters.Items[i]).GetName;
  1900. FFilterGraph.AddFilter(IFilter(FFilters.Items[i]).GetFilter, PWideChar(FilterName));
  1901. IFilter(FFilters.Items[i]).NotifyFilter(foAdded);
  1902. end;
  1903. end;
  1904. {
  1905. procedure TFilterGraph.NotifyFilters(operation: TFilterOperation; Param: integer);
  1906. var i: integer;
  1907. begin
  1908. if FFilters <> nil then
  1909. for i := 0 to FFilters.Count - 1 do
  1910. IFilter(FFilters.Items[i]).NotifyFilter(operation, Param);
  1911. end;
  1912. }
  1913. procedure TFilterGraph.GraphEvents(Event, Param1, Param2: integer);
  1914. var i: integer;
  1915. begin
  1916. if FGraphEvents <> nil then
  1917. for i := 0 to FGraphEvents.Count - 1 do
  1918. IEvent(FGraphEvents.Items[i]).GraphEvent(Event, Param1, Param2);
  1919. end;
  1920. procedure TFilterGraph.ControlEvents(Event: TControlEvent; Param: integer = 0);
  1921. var i: integer;
  1922. begin
  1923. if FGraphEvents <> nil then
  1924. for i := 0 to FGraphEvents.Count - 1 do
  1925. IEvent(FGraphEvents.Items[i]).ControlEvent(Event, param);
  1926. end;
  1927. function TFilterGraph.Play: boolean;
  1928. var MediaControl: IMediaControl;
  1929. begin
  1930. result := false;
  1931. if Succeeded(QueryInterface(IMediaControl, MediaControl)) then
  1932. begin
  1933. ControlEvents(cePlay);
  1934. result := Succeeded((CheckDSError(MediaControl.Run)));
  1935. MediaControl := nil;
  1936. end;
  1937. end;
  1938. function TFilterGraph.Pause: boolean;
  1939. var MediaControl: IMediaControl;
  1940. begin
  1941. result := false;
  1942. if Succeeded(QueryInterface(IMediaControl, MediaControl)) then
  1943. begin
  1944. ControlEvents(cePause);
  1945. result := (CheckDSError(MediaControl.Pause) = S_OK);
  1946. MediaControl := nil;
  1947. end;
  1948. end;
  1949. function TFilterGraph.Stop: boolean;
  1950. var MediaControl: IMediaControl;
  1951. begin
  1952. result := false;
  1953. if Succeeded(QueryInterface(IMediaControl, MediaControl)) then
  1954. begin
  1955. ControlEvents(ceStop);
  1956. result := (CheckDSError(MediaControl.Stop) = S_OK);
  1957. MediaControl := nil;
  1958. end;
  1959. end;
  1960. procedure TFilterGraph.SetLogFile(FileName: String);
  1961. begin
  1962. if Active then
  1963. begin
  1964. FFilterGraph.SetLogFile(0);
  1965. if Assigned(FLogFile) then FreeAndNil(FLogFile);
  1966. if FileName <> '' then
  1967. try
  1968. FLogFile := TFileStream.Create(FileName, fmCreate{$IFDEF VER140}, fmShareDenyNone{$ENDIF});
  1969. FFilterGraph.SetLogFile(FLogFile.Handle);
  1970. except
  1971. FFilterGraph.SetLogFile(0);
  1972. if Assigned(FLogFile) then FreeAndNil(FLogFile);
  1973. exit;
  1974. end;
  1975. end;
  1976. FLogFileName := FileName;
  1977. end;
  1978. procedure TFilterGraph.DisconnectFilters;
  1979. var
  1980. FilterList: TFilterList;
  1981. PinList: TPinList;
  1982. BaseFilter: IBaseFilter;
  1983. i, j: integer;
  1984. begin
  1985. if assigned(FFilterGraph) then
  1986. begin
  1987. FilterList:= TFilterList.Create(FFilterGraph);
  1988. if FilterList.Count > 0 then
  1989. for i := 0 to FilterList.Count - 1 do
  1990. begin
  1991. BaseFilter := FilterList.Items[i] as IBaseFilter;
  1992. PinList := TPinList.Create(BaseFilter);
  1993. if PinList.Count > 0 then
  1994. for j := 0 to PinList.Count - 1 do
  1995. CheckDSError(IPin(PinList.Items[j]).Disconnect);
  1996. PinList.Free;
  1997. BaseFilter := nil;
  1998. end;
  1999. FilterList.Free;
  2000. end;
  2001. end;
  2002. procedure TFilterGraph.ClearGraph;
  2003. var
  2004. i: integer;
  2005. FilterList: TFilterList;
  2006. begin
  2007. if Assigned(FFilterGraph) then
  2008. begin
  2009. Stop;
  2010. DisconnectFilters;
  2011. FilterList:= TFilterList.Create(FFilterGraph);
  2012. if assigned(FFilters) then
  2013. if FFilters.Count > 0 then
  2014. for i := 0 to FFilters.count - 1 do
  2015. FilterList.Remove(IFilter(FFilters.Items[i]).GetFilter);
  2016. if FilterList.count > 0 then
  2017. for i := 0 to FilterList.Count - 1 do
  2018. CheckDSError(FFilterGraph.RemoveFilter(FilterList.Items[i]));
  2019. FilterList.Free;
  2020. end;
  2021. end;
  2022. function TFilterGraph.GetState: TGraphState;
  2023. var
  2024. AState: TFilterState;
  2025. MediaControl: IMediaControl;
  2026. begin
  2027. result := gsUninitialized;
  2028. if Succeeded(QueryInterface(IMediaControl, MediaControl)) then
  2029. begin
  2030. MediaControl.GetState(0,AState);
  2031. case AState of
  2032. State_Stopped : result := gsStopped;
  2033. State_Paused : result := gsPaused;
  2034. State_Running : result := gsPlaying;
  2035. end;
  2036. MediaControl := nil;
  2037. end;
  2038. end;
  2039. procedure TFilterGraph.SetState(Value: TGraphState);
  2040. var
  2041. MediaControl: IMediaControl;
  2042. hr: HResult;
  2043. begin
  2044. if Succeeded(QueryInterface(IMediaControl, MediaControl)) then
  2045. begin
  2046. case Value of
  2047. gsStopped: hr := MediaControl.Stop;
  2048. gsPaused : hr := MediaControl.Pause;
  2049. gsPlaying: hr := MediaControl.Run;
  2050. else
  2051. hr := S_OK;
  2052. end;
  2053. MediaControl := nil;
  2054. CheckDSError(hr);
  2055. end;
  2056. end;
  2057. procedure TFilterGraph.SetVolume(Volume: Integer);
  2058. var
  2059. BasicAudio: IBasicAudio;
  2060. begin
  2061. FVolume := EnsureRange(Volume,0,10000);
  2062. if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then
  2063. begin
  2064. if FLinearVolume
  2065. then BasicAudio.put_Volume(SetBasicAudioVolume(FVolume))
  2066. else BasicAudio.put_Volume(FVolume-10000);
  2067. BasicAudio := nil;
  2068. end;
  2069. end;
  2070. procedure TFilterGraph.SetBalance(Balance: integer);
  2071. var BasicAudio: IBasicAudio;
  2072. begin
  2073. FBalance := EnsureRange(Balance,-10000,10000);
  2074. if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then
  2075. begin
  2076. if FLinearVolume
  2077. then BasicAudio.put_Balance(SetBasicAudioPan(FBalance))
  2078. else BasicAudio.put_Balance(FBalance);
  2079. BasicAudio := nil;
  2080. end;
  2081. end;
  2082. function TFilterGraph.GetSeekCaps: TSeekingCaps;
  2083. var
  2084. MediaSeeking: IMediaSeeking;
  2085. Flags: Cardinal;
  2086. begin
  2087. result := [];
  2088. if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then
  2089. begin
  2090. MediaSeeking.GetCapabilities(Flags);
  2091. PByte(@Result)^ := Flags;
  2092. MediaSeeking := nil;
  2093. end;
  2094. end;
  2095. function TFilterGraph.RenderFile(FileName: WideString): HRESULT;
  2096. begin
  2097. result := S_FALSE;
  2098. if assigned(FFilterGraph) then
  2099. begin
  2100. ControlEvents(ceFileRendering);
  2101. result := CheckDSError(FFilterGraph.RenderFile(PWideChar(FileName), nil));
  2102. if Succeeded(result) then
  2103. begin
  2104. UpdateGraph;
  2105. ControlEvents(ceFileRendered);
  2106. end;
  2107. end;
  2108. end;
  2109. { TODO -oHG : Add the audio rendering }
  2110. function TFilterGraph.RenderFileEx(FileName: WideString): HRESULT;
  2111. var
  2112. SourceFilter: IBaseFilter;
  2113. PinList: TPinList;
  2114. i: Integer;
  2115. begin
  2116. result := S_FALSE;
  2117. if assigned(FFilterGraph) then
  2118. begin
  2119. ControlEvents(ceFileRendering);
  2120. CheckDSError(FFilterGraph.AddSourceFilter(PWideChar(FileName), PWideChar(FileName), SourceFilter));
  2121. PinList := TPinList.Create(SourceFilter);
  2122. try
  2123. for i := 0 to PinList.Count - 1 do
  2124. begin
  2125. CheckDSError(IFilterGraph2(FFilterGraph).RenderEx(PinList.Items[i],
  2126. AM_RENDEREX_RENDERTOEXISTINGRENDERERS, nil));
  2127. end;
  2128. finally
  2129. PinList.Free;
  2130. end;
  2131. if Succeeded(result) then
  2132. begin
  2133. ControlEvents(ceFileRendered);
  2134. UpdateGraph;
  2135. end;
  2136. end;
  2137. end;
  2138. function TFilterGraph.RenderDVD(out status: TAMDVDRenderStatus;
  2139. FileName: WideString = ''; Mode: Integer = AM_DVD_HWDEC_PREFER): HRESULT;
  2140. begin
  2141. result := HRESULT(VFW_E_DVD_RENDERFAIL);
  2142. if assigned(FDVDGraph) then
  2143. begin
  2144. ControlEvents(ceDVDRendering, Mode);
  2145. if FileName <> '' then
  2146. result := CheckDSError(FDVDGraph.RenderDvdVideoVolume(PWideChar(FileName), Mode, Status))
  2147. else
  2148. result := CheckDSError(FDVDGraph.RenderDvdVideoVolume(nil, Mode, Status));
  2149. if result in [S_OK..S_FALSE] then
  2150. begin
  2151. ControlEvents(ceDVDRendered, Mode);
  2152. UpdateGraph;
  2153. end;
  2154. end;
  2155. end;
  2156. procedure TFilterGraph.SetRate(Rate: double);
  2157. var MediaSeeking: IMediaSeeking;
  2158. begin
  2159. FRate := Rate;
  2160. if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then
  2161. begin
  2162. MediaSeeking.SetRate(FRate);
  2163. MediaSeeking := nil;
  2164. end;
  2165. end;
  2166. function TFilterGraph.GetDuration: integer;
  2167. var
  2168. MediaSeeking: IMediaSeeking;
  2169. RefTime: int64;
  2170. begin
  2171. if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then
  2172. begin
  2173. MediaSeeking.GetDuration(RefTime);
  2174. result := RefTimeToMiliSec(RefTime);
  2175. MediaSeeking := nil;
  2176. end
  2177. else
  2178. result := 0;
  2179. end;
  2180. procedure TFilterGraph.DVDSaveBookmark(BookMarkFile: WideString);
  2181. var
  2182. DVDInfo2: IDVDInfo2;
  2183. Bookmark: IDvdState;
  2184. pStorage: IStorage;
  2185. pStream : IStream;
  2186. PersistStream : IPersistStream;
  2187. begin
  2188. if Active and (Mode = gmDVD) then
  2189. if Succeeded(QueryInterface(IDVDInfo2, DVDInfo2)) then
  2190. begin
  2191. DVDInfo2.GetState(Bookmark);
  2192. StgCreateDocfile(PWideChar(BookMarkFile), STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, pStorage);
  2193. pStorage.CreateStream('BookMark', STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, 0, pStream);
  2194. if Succeeded(Bookmark.QueryInterface(IID_IPersistStream,PersistStream)) then
  2195. begin
  2196. OleSaveToStream(PersistStream,pStream);
  2197. PersistStream := nil;
  2198. end
  2199. else
  2200. begin
  2201. PersistStream := nil;
  2202. DVDInfo2 := nil;
  2203. exit;
  2204. end;
  2205. DVDInfo2 := nil;
  2206. end;
  2207. end;
  2208. procedure TFilterGraph.DVDRestoreBookmark(BookMarkFile: WideString);
  2209. var
  2210. DVDControl2: IDvdControl2;
  2211. pStorage : IStorage;
  2212. pStream : IStream;
  2213. pBookmark: IDvdState;
  2214. hr : HRESULT;
  2215. obj : IDVDCmd;
  2216. begin
  2217. if Succeeded(QueryInterface(IDvdControl2, DvdControl2)) then
  2218. begin
  2219. StgOpenStorage(PWideChar(BookMarkFile), nil, STGM_READ or STGM_SHARE_EXCLUSIVE, nil , 0, pStorage);
  2220. pStorage.OpenStream('BookMark', nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, pStream);
  2221. OleLoadFromStream(pStream, IID_IDvdState, pBookmark);
  2222. hr := CheckDSError(DVDControl2.SetState(pBookmark, DVD_CMD_FLAG_None, obj));
  2223. if not (failed(hr)) then
  2224. begin
  2225. obj.WaitForEnd;
  2226. obj := nil;
  2227. end;
  2228. DvdControl2 := nil;
  2229. end;
  2230. end;
  2231. procedure TFilterGraph.SetLinearVolume(aEnabled: Boolean);
  2232. begin
  2233. if FLinearVolume = aEnabled then Exit;
  2234. FLinearVolume := aEnabled;
  2235. SetVolume(FVolume);
  2236. SetBalance(FBalance);
  2237. end;
  2238. procedure TFilterGraph.UpdateGraph;
  2239. begin
  2240. SetVolume(FVolume);
  2241. SetBalance(FBalance);
  2242. SetRate(FRate);
  2243. end;
  2244. function TFilterGraph.SelectedFilter(pMon: IMoniker): HResult; stdcall;
  2245. var
  2246. PropBag: IPropertyBag;
  2247. Name: OleVariant;
  2248. vGuid: OleVariant;
  2249. Guid: TGUID;
  2250. begin
  2251. if Assigned(FOnSelectedFilter) then
  2252. begin
  2253. pMon.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
  2254. if PropBag.Read('CLSID',vGuid,nil) = S_OK then Guid := StringToGUID(vGuid)
  2255. else Guid := GUID_NULL;
  2256. if PropBag.Read('FriendlyName', Name, nil) <> S_OK then Name := '';
  2257. PropBag := nil;
  2258. if FOnSelectedFilter(pMon,Name,Guid)
  2259. then Result := S_OK
  2260. else Result := E_FAIL;
  2261. end else
  2262. Result := S_OK;
  2263. end;
  2264. function TFilterGraph.CreatedFilter(pFil: IBaseFilter): HResult; stdcall;
  2265. var
  2266. guid: TGuid;
  2267. begin
  2268. if Assigned(FOnCreatedFilter) then
  2269. begin
  2270. pfil.GetClassID(guid);
  2271. if FOnCreatedFilter(pFil,guid)
  2272. then Result := S_OK
  2273. else Result := E_FAIL;
  2274. end else
  2275. Result := S_OK;
  2276. end;
  2277. function TFilterGraph.UnableToRender(ph1, ph2: integer; pPin: IPin): HResult;
  2278. var
  2279. graph: TFilterGraph;
  2280. PinInfo: TPinInfo;
  2281. FilterInfo: TFilterInfo;
  2282. serviceProvider: IServiceProvider;
  2283. begin
  2284. Result := S_FALSE;
  2285. if (pPin.QueryPinInfo(PinInfo) = S_OK) and
  2286. (Assigned(PinInfo.pFilter)) and
  2287. (PinInfo.pFilter.QueryFilterInfo(FilterInfo) = S_OK) and
  2288. (Assigned(FilterInfo.pGraph)) and
  2289. (FilterInfo.pGraph.QueryInterface(IServiceProvider, serviceProvider) = S_OK) and
  2290. (serviceProvider.QueryService(CLSID_FilterGraphCallback, CLSID_FilterGraphCallback, graph) = S_OK) and
  2291. (Assigned(graph) and Assigned(graph.FOnUnableToRender)) and
  2292. (graph.FOnUnableToRender(pPin))
  2293. then Result := S_OK;
  2294. PinInfo.pFilter := nil;
  2295. FilterInfo.pGraph := nil;
  2296. serviceProvider := nil;
  2297. end;
  2298. function TFilterGraph.QueryService(const rsid, iid: TGuid; out Obj): HResult;
  2299. begin
  2300. if IsEqualGUID(CLSID_FilterGraphCallback, rsid) and
  2301. IsEqualGUID(CLSID_FilterGraphCallback, iid) then
  2302. begin
  2303. Pointer(Obj) := Pointer(Self);
  2304. Result := S_OK;
  2305. end else
  2306. Result := E_NOINTERFACE;
  2307. end;
  2308. //******************************************************************************
  2309. // TVMROptions
  2310. //******************************************************************************
  2311. constructor TVMROptions.Create(AOwner: TVideoWindow);
  2312. begin
  2313. FPreferences := [vpForceMixer];
  2314. FStreams := 4;
  2315. FOwner := AOwner;
  2316. FMode := vmrWindowed;
  2317. FKeepAspectRatio := True;
  2318. end;
  2319. procedure TVMROptions.SetStreams(Streams: cardinal);
  2320. begin
  2321. if Streams in [1..16] then FStreams := Streams else FStreams := 1;
  2322. with FOwner do
  2323. begin
  2324. if (mode <> vmVMR) or (FilterGraph = nil) then exit;
  2325. if not FilterGraph.Active then exit;
  2326. // need to reconnect
  2327. FilterGraph.RemoveFilter(FOwner);
  2328. FilterGraph.InsertFilter(FOwner);
  2329. end;
  2330. end;
  2331. procedure TVMROptions.SetPreferences(Preferences: TVMRPreferences);
  2332. begin
  2333. FPreferences := Preferences;
  2334. with FOwner do
  2335. begin
  2336. if (mode <> vmVMR) or (FilterGraph = nil) then exit;
  2337. if not FilterGraph.Active then exit;
  2338. // need to reconnect
  2339. FilterGraph.RemoveFilter(FOwner);
  2340. FilterGraph.InsertFilter(FOwner);
  2341. end;
  2342. end;
  2343. procedure TVMROptions.SetMode(AMode: TVMRVideoMode);
  2344. begin
  2345. FMode := AMode;
  2346. with FOwner do
  2347. begin
  2348. if (mode <> vmVMR) or (FilterGraph = nil) then exit;
  2349. if not FilterGraph.Active then exit;
  2350. // need to reconnect
  2351. FilterGraph.RemoveFilter(FOwner);
  2352. FilterGraph.InsertFilter(FOwner);
  2353. end;
  2354. end;
  2355. procedure TVMROptions.SetKeepAspectRatio(Keep: boolean);
  2356. var AspectRatioControl: IVMRAspectRatioControl9;
  2357. begin
  2358. FKeepAspectRatio := Keep;
  2359. case Mode of
  2360. vmrWindowed, vmrWindowless:
  2361. begin
  2362. if Succeeded(FOwner.QueryInterface(IVMRAspectRatioControl9, AspectRatioControl)) then
  2363. case Keep of
  2364. true: CheckDSError(AspectRatioControl.SetAspectRatioMode(VMR_ARMODE_LETTER_BOX));
  2365. false: CheckDSError(AspectRatioControl.SetAspectRatioMode(VMR_ARMODE_NONE));
  2366. end;
  2367. end;
  2368. vmrRenderless: {TODO};
  2369. end;
  2370. end;
  2371. //******************************************************************************
  2372. // TVideoWindow
  2373. //******************************************************************************
  2374. constructor TVideoWindow.Create(AOwner: TComponent);
  2375. begin
  2376. inherited Create(AOwner);
  2377. FVMROptions:= TVMROptions.Create(self);
  2378. ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  2379. csDoubleClicks, csReflector];
  2380. TabStop := true;
  2381. Height := 120;
  2382. Width := 160;
  2383. color := $000000;
  2384. FIsFullScreen := false;
  2385. FKeepAspectRatio := True;
  2386. end;
  2387. destructor TVideoWindow.Destroy;
  2388. begin
  2389. FVMROptions.Free;
  2390. FilterGraph := nil;
  2391. inherited destroy;
  2392. end;
  2393. procedure TVideoWindow.SetVideoMode(AMode: TVideoMode);
  2394. begin
  2395. if (AMode = vmVMR) and (not CheckVMR)
  2396. then FMode := vmNormal
  2397. else FMode := AMode;
  2398. if FilterGraph = nil then exit;
  2399. if not FilterGraph.Active then exit;
  2400. // need to reconnect
  2401. FilterGraph.RemoveFilter(self);
  2402. FilterGraph.InsertFilter(self);
  2403. end;
  2404. procedure TVideoWindow.Loaded;
  2405. begin
  2406. inherited Loaded;
  2407. FWindowStyle := GetWindowLong(Handle, GWL_STYLE);
  2408. FWindowStyleEx := GetWindowLong(Handle, GWL_EXSTYLE);
  2409. end;
  2410. procedure TVideoWindow.Notification(AComponent: TComponent;
  2411. Operation: TOperation);
  2412. begin
  2413. inherited Notification(AComponent, Operation);
  2414. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  2415. FFilterGraph := nil;
  2416. end;
  2417. procedure TVideoWindow.SetFilterGraph(AFilterGraph: TFilterGraph);
  2418. begin
  2419. if AFilterGraph = FFilterGraph then exit;
  2420. if FFilterGraph <> nil then
  2421. begin
  2422. FFilterGraph.RemoveFilter(self);
  2423. FFilterGraph.RemoveEventNotifier(self);
  2424. end;
  2425. if AFilterGraph <> nil then
  2426. begin
  2427. AFilterGraph.InsertFilter(self);
  2428. AFilterGraph.InsertEventNotifier(self);
  2429. end;
  2430. FFilterGraph := AFilterGraph;
  2431. end;
  2432. function TVideoWindow.GetFilter: IBaseFilter;
  2433. begin
  2434. result := FBaseFilter;
  2435. end;
  2436. function TVideoWindow.GetName: string;
  2437. begin
  2438. result := name;
  2439. end;
  2440. procedure TVideoWindow.NotifyFilter(operation: TFilterOperation; Param: integer);
  2441. var
  2442. EnumPins: TPinList;
  2443. VMRFilterConfig: IVMRFilterConfig9;
  2444. VMRSurfaceAllocatorNotify: IVMRSurfaceAllocatorNotify9;
  2445. VMRSurfaceAllocator: IVMRSurfaceAllocator9;
  2446. MyPrefs: TVMRPreferences;
  2447. APrefs: cardinal;
  2448. i: integer;
  2449. CW: Word;
  2450. hr: HResult;
  2451. DSPackException: EDSPackException;
  2452. procedure UpdatePreferences;
  2453. begin
  2454. // VMR9 preferences
  2455. MyPrefs := FVMROptions.FPreferences - [vpForceMixer];
  2456. CheckDSError(VMRFilterConfig.SetRenderingPrefs(PByte(@MyPrefs)^));
  2457. APrefs := 0;
  2458. CheckDSError(VMRFilterConfig.GetRenderingPrefs(APrefs));
  2459. if (vpForceMixer in FVMROptions.FPreferences) then
  2460. FVMROptions.FPreferences := PVMRPreferences(@APrefs)^ + [vpForceMixer]
  2461. else
  2462. FVMROptions.FPreferences := PVMRPreferences(@APrefs)^;
  2463. end;
  2464. begin
  2465. case operation of
  2466. foAdding:
  2467. begin
  2468. case mode of
  2469. vmVMR :
  2470. begin
  2471. CW := Get8087CW;
  2472. try
  2473. CoCreateInstance(CLSID_VideoMixingRenderer9, nil, CLSCTX_INPROC, IID_IBaseFilter ,FBaseFilter);
  2474. FBaseFilter.QueryInterface(IVMRFilterConfig9, VMRFilterConfig);
  2475. case FVMROptions.Mode of
  2476. vmrWindowed: CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Windowed));
  2477. vmrWindowless: CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Windowless));
  2478. vmrRenderless:
  2479. begin
  2480. if (FAllocatorClass = nil) then
  2481. raise EDSPackException.Create('Allocator class not set.');
  2482. FCurrentAllocator := FAllocatorClass.Create(hr, Handle);
  2483. if failed(hr) then
  2484. begin
  2485. DSPackException := EDSPackException.Create('Error Creating Allocator');
  2486. DSPackException.ErrorCode := hr;
  2487. raise DSPackException;
  2488. end;
  2489. CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Renderless));
  2490. CheckDSError(FBaseFilter.QueryInterface(IID_IVMRSurfaceAllocatorNotify9, VMRSurfaceAllocatorNotify));
  2491. CheckDSError(FCurrentAllocator.QueryInterface(IID_IVMRSurfaceAllocator9, VMRSurfaceAllocator));
  2492. VMRSurfaceAllocatorNotify.AdviseSurfaceAllocator(FRenderLessUserID, VMRSurfaceAllocator);
  2493. VMRSurfaceAllocator._AddRef; // manual increment;
  2494. VMRSurfaceAllocator.AdviseNotify(VMRSurfaceAllocatorNotify);
  2495. end;
  2496. end;
  2497. VMRFilterConfig := nil;
  2498. finally
  2499. Set8087CW(CW);
  2500. end;
  2501. end;
  2502. vmNormal : CoCreateInstance(CLSID_VideoRenderer, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter ,FBaseFilter);
  2503. end;
  2504. end;
  2505. foAdded:
  2506. begin
  2507. case mode of
  2508. vmVMR:
  2509. begin
  2510. if (FBaseFilter <> nil) then
  2511. if CheckDSError(FBaseFilter.QueryInterface(IVMRFilterConfig9, VMRFilterConfig)) = S_OK then
  2512. begin
  2513. if (FVMROptions.FStreams <> 4)
  2514. or (vpForceMixer in FVMROptions.FPreferences) then
  2515. begin
  2516. CheckDSError(VMRFilterConfig.SetNumberOfStreams(FVMROptions.FStreams));
  2517. CheckDSError(VMRFilterConfig.GetNumberOfStreams(FVMROptions.FStreams));
  2518. end;
  2519. case FVMROptions.Mode of
  2520. vmrWindowed :
  2521. begin
  2522. CheckDSError(FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow));
  2523. UpdatePreferences;
  2524. end;
  2525. vmrWindowless :
  2526. begin
  2527. CheckDSError(FBaseFilter.QueryInterface(IVMRWindowlessControl9, FWindowLess));
  2528. CheckDSError(FWindowLess.SetVideoClippingWindow(Handle));
  2529. UpdatePreferences;
  2530. Resize;
  2531. end;
  2532. vmrRenderless :
  2533. begin
  2534. //Assert(False, 'not yet imlemented.');
  2535. //CheckDSError(FBaseFilter.QueryInterface(IVMRWindowlessControl9, FWindowLess));
  2536. //CheckDSError(FWindowLess.SetVideoClippingWindow(Handle));
  2537. end;
  2538. end;
  2539. VMRFilterConfig := nil;
  2540. VMROptions.SetKeepAspectRatio(VMROptions.FKeepAspectRatio);
  2541. end;
  2542. end;
  2543. vmNormal: CheckDSError(FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow));
  2544. end;
  2545. end;
  2546. foRemoving:
  2547. if FBaseFilter <> nil then
  2548. begin
  2549. // it's important to stop and disconnect the filter before removing the VMR filter.
  2550. CheckDSError(FBaseFilter.Stop);
  2551. EnumPins := TPinList.Create(FBaseFilter);
  2552. if EnumPins.Count > 0 then
  2553. for i := 0 to EnumPins.Count - 1 do
  2554. CheckDSError(EnumPins.Items[i].Disconnect);
  2555. EnumPins.Free;
  2556. if (FCurrentAllocator <> nil) and (mode = vmVMR) and (VMROptions.Mode = vmrRenderless) then
  2557. begin
  2558. IUnKnown(FCurrentAllocator)._Release;
  2559. FCurrentAllocator := nil;
  2560. end;
  2561. end;
  2562. foRemoved :
  2563. begin
  2564. FVideoWindow := nil;
  2565. FWindowLess := nil;
  2566. FBaseFilter := nil;
  2567. end;
  2568. end;
  2569. end;
  2570. procedure TVideoWindow.Paint;
  2571. begin
  2572. inherited Paint;
  2573. if Assigned(FOnPaint) then FOnPaint(self);
  2574. end;
  2575. procedure TVideoWindow.Resize;
  2576. var ARect: TRect;
  2577. begin
  2578. inherited Resize;
  2579. case FMode of
  2580. vmNormal:
  2581. begin
  2582. if (FVideoWindow <> nil) and (not FullScreen) then
  2583. if FIsVideoWindowOwner then
  2584. FVideoWindow.SetWindowPosition(0, 0, Width, Height)
  2585. else
  2586. FVideoWindow.SetWindowPosition(Left, Top, Width, Height);
  2587. end;
  2588. vmVMR:
  2589. case FVMROptions.Mode of
  2590. vmrWindowed:
  2591. begin
  2592. if (FVideoWindow <> nil) and (not FullScreen) then
  2593. if FIsVideoWindowOwner then
  2594. FVideoWindow.SetWindowPosition(0, 0, Width, Height)
  2595. else
  2596. FVideoWindow.SetWindowPosition(Left, Top, Width, Height);
  2597. end;
  2598. vmrWindowless:
  2599. if FWindowLess <> nil then
  2600. begin
  2601. ARect := Rect(0,0, width, height);
  2602. FWindowLess.SetVideoPosition(nil, @ARect);
  2603. end;
  2604. end;
  2605. end;
  2606. end;
  2607. procedure TVideoWindow.ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
  2608. begin
  2609. inherited ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
  2610. Resize;
  2611. end;
  2612. function TVideoWindow.GetVideoHandle: THandle;
  2613. begin
  2614. if FVideoWindow <> nil then
  2615. result := FindWindowEx(Parent.Handle,0,Pchar('VideoRenderer'), Pchar(name))
  2616. else
  2617. Result := Canvas.Handle;
  2618. end;
  2619. class function TVideoWindow.CheckVMR: boolean;
  2620. var
  2621. AFilter: IBaseFilter;
  2622. CW: Word;
  2623. begin
  2624. CW := Get8087CW;
  2625. try
  2626. result := (CoCreateInstance(CLSID_VideoMixingRenderer9, nil, CLSCTX_INPROC, IID_IBaseFilter ,AFilter) = S_OK);
  2627. finally
  2628. Set8087CW(CW);
  2629. AFilter := nil;
  2630. end;
  2631. end;
  2632. procedure TVideoWindow.SetFullScreen(Value: boolean);
  2633. var
  2634. StyleEX: LongWord;
  2635. begin
  2636. if (FVideoWindow <> nil) and CheckInputPinsConnected then
  2637. case Value of
  2638. true:
  2639. begin
  2640. CheckDSError(FVideoWindow.put_Owner(0));
  2641. CheckDSError(FVideoWindow.put_WindowStyle(FWindowStyle and not(WS_BORDER or WS_CAPTION or WS_THICKFRAME)));
  2642. StyleEX := FWindowStyleEx and not(WS_EX_CLIENTEDGE or WS_EX_STATICEDGE
  2643. or WS_EX_WINDOWEDGE or WS_EX_DLGMODALFRAME);
  2644. if FTopMost then StyleEX := StyleEX or WS_EX_TOPMOST;
  2645. CheckDSError(FVideoWindow.put_WindowStyleEx(StyleEX));
  2646. CheckDSError(FVideoWindow.SetWindowPosition(0, 0, Screen.Width, Screen.Height));
  2647. FIsFullScreen := True;
  2648. end;
  2649. false:
  2650. begin
  2651. if FIsVideoWindowOwner then
  2652. CheckDSError(FVideoWindow.put_Owner(Handle))
  2653. else
  2654. CheckDSError(FVideoWindow.put_Owner(Parent.Handle));
  2655. CheckDSError(FVideoWindow.put_WindowStyle(FWindowStyle or WS_CHILD or WS_CLIPSIBLINGS));
  2656. CheckDSError(FVideoWindow.put_WindowStyleEx(FWindowStyleEx));
  2657. if FIsVideoWindowOwner then
  2658. CheckDSError(FVideoWindow.SetWindowPosition(0, 0, Self.Width, Self.Height))
  2659. else
  2660. CheckDSError(FVideoWindow.SetWindowPosition(Self.Left, Self.Top, Self.Width, Self.Height));
  2661. FIsFullScreen := false;
  2662. end;
  2663. end;
  2664. if FWindowLess <> nil then
  2665. FIsFullScreen := false;
  2666. FFullScreen := Value;
  2667. end;
  2668. function TVideoWindow.QueryInterface(const IID: TGUID; out Obj): HResult;
  2669. begin
  2670. if IsEqualGUID(IID_IVMRWindowlessControl9, IID) and (FWindowLess <> nil) then
  2671. begin
  2672. result := S_OK;
  2673. IunKnown(Obj) := FWindowLess;
  2674. exit;
  2675. end;
  2676. result := inherited QueryInterface(IID, Obj);
  2677. if failed(result) and assigned(FBaseFilter) then
  2678. result := FBaseFilter.QueryInterface(IID, Obj);
  2679. end;
  2680. procedure TVideoWindow.GraphEvent(Event, Param1, Param2: integer);
  2681. begin
  2682. case Event of
  2683. EC_PALETTE_CHANGED:
  2684. if FVideoWindow <> nil then
  2685. begin
  2686. SetFullScreen(FFullScreen);
  2687. if Name <> '' then
  2688. CheckDSError(FVideoWindow.put_Caption(Name));
  2689. CheckDSError(FVideoWindow.put_MessageDrain(Handle));
  2690. end;
  2691. EC_VMR_RENDERDEVICE_SET:
  2692. begin
  2693. if (FVMROptions.FMode = vmrWindowed) and (FVideoWindow <> nil) then
  2694. begin
  2695. if Name <> '' then
  2696. CheckDSError(FVideoWindow.put_Caption(Name));
  2697. CheckDSError(FVideoWindow.put_MessageDrain(Handle));
  2698. end;
  2699. end;
  2700. end;
  2701. end;
  2702. function TVideoWindow.CheckInputPinsConnected: boolean;
  2703. var
  2704. PinList: TPinList;
  2705. i: Integer;
  2706. begin
  2707. result := False;
  2708. if (FBaseFilter = nil) then Exit;
  2709. PinList := TPinList.Create(FBaseFilter);
  2710. try
  2711. for i := 0 to PinList.Count - 1 do
  2712. if PinList.Connected[i] then
  2713. begin
  2714. Result := True;
  2715. Break;
  2716. end;
  2717. finally
  2718. PinList.Free;
  2719. end;
  2720. end;
  2721. procedure TVideoWindow.ControlEvent(Event: TControlEvent; Param: integer = 0);
  2722. var
  2723. FilterInfo: TFilterInfo;
  2724. FilterList: TFilterList;
  2725. i: integer;
  2726. GUID: TGUID;
  2727. begin
  2728. case Event of
  2729. ceDVDRendered: // mean our Video Filter have been removed
  2730. begin
  2731. ZeroMemory(@FilterInfo, SizeOf(TFilterInfo));
  2732. CheckDSError(FBaseFilter.QueryFilterInfo(FilterInfo));
  2733. if not assigned(FilterInfo.pGraph) then
  2734. begin
  2735. FilterList:= TFilterList.Create(FilterGraph.FFilterGraph);
  2736. if FilterList.Count > 0 then
  2737. for i := 0 to FilterList.Count - 1 do
  2738. begin
  2739. FilterList.Items[i].GetClassID(GUID);
  2740. if ISEqualGUID(GUID, CLSID_VideoRenderer) and (Mode = vmNormal) then
  2741. begin
  2742. FBaseFilter := nil;
  2743. FVideoWindow := nil;
  2744. FWindowLess := nil;
  2745. FBaseFilter := FilterList.Items[i];
  2746. FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow);
  2747. break;
  2748. end;
  2749. end;
  2750. end;
  2751. end;
  2752. cePlay:
  2753. begin
  2754. if CheckInputPinsConnected then
  2755. begin
  2756. case FMode of
  2757. vmNormal:
  2758. if FVideoWindow <> nil then
  2759. begin
  2760. SetFullScreen(FFullScreen);
  2761. if Name <> '' then
  2762. CheckDSError(FVideoWindow.put_Caption(Name));
  2763. CheckDSError(FVideoWindow.put_MessageDrain(Handle));
  2764. end;
  2765. vmVMR: SetFullScreen(FFullScreen);
  2766. end;
  2767. end;
  2768. end;
  2769. end;
  2770. end;
  2771. procedure TVideoWindow.WndProc(var Message: TMessage);
  2772. begin
  2773. if ((Message.Msg = WM_CONTEXTMENU) and FullScreen) then
  2774. begin
  2775. if assigned(PopupMenu) then
  2776. if PopupMenu.AutoPopup then
  2777. begin
  2778. PopupMenu.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
  2779. Message.Result := 1;
  2780. end;
  2781. end
  2782. else
  2783. inherited WndProc(Message);
  2784. end;
  2785. procedure TVideoWindow.SetTopMost(TopMost: boolean);
  2786. begin
  2787. FTopMost := TopMost;
  2788. if FFullScreen then SetFullScreen(true);
  2789. end;
  2790. procedure TVideoWindow.MouseDown(Button: TMouseButton;
  2791. Shift: TShiftState; X, Y: Integer);
  2792. begin
  2793. if FIsFullScreen then
  2794. inherited MouseDown(Button, Shift, mouse.CursorPos.X, mouse.CursorPos.Y)
  2795. else
  2796. inherited MouseDown(Button, Shift, X, Y)
  2797. end;
  2798. procedure TVideoWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
  2799. begin
  2800. if Fisfullscreen then
  2801. inherited MouseMove(Shift, mouse.CursorPos.X, mouse.CursorPos.Y)
  2802. else
  2803. inherited MouseMove(Shift, X, Y)
  2804. end;
  2805. procedure TVideoWindow.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2806. begin
  2807. if Fisfullscreen then
  2808. inherited MouseUp(Button, Shift, mouse.CursorPos.X, mouse.CursorPos.Y)
  2809. else
  2810. inherited MouseUp(Button, Shift, X, Y)
  2811. end;
  2812. function TVideoWindow.VMRGetBitMap(Stream: TStream): boolean;
  2813. var
  2814. Image: PBitmapInfoHeader;
  2815. BFH: TBITMAPFILEHEADER;
  2816. function DibSize: cardinal; begin result := (Image.biSize + Image.biSizeImage + Image.biClrUsed * sizeof(TRGBQUAD)); end;
  2817. function DibNumColors: cardinal;
  2818. begin if (image.biClrUsed = 0) and (image.biBitCount <= 8) then
  2819. result := 1 shl integer(image.biBitCount) else
  2820. result := image.biClrUsed; end;
  2821. function DibPaletteSize: cardinal; begin result := (DibNumColors * sizeof(TRGBQUAD)) end;
  2822. begin
  2823. assert(assigned(Stream));
  2824. result := false;
  2825. if FWindowLess <> nil then
  2826. if Succeeded(FWindowLess.GetCurrentImage(PByte(image))) then
  2827. begin
  2828. BFH.bfType := $4d42; // BM
  2829. BFH.bfSize := DibSize + sizeof(TBITMAPFILEHEADER);
  2830. BFH.bfReserved1 := 0;
  2831. BFH.bfReserved2 := 0;
  2832. BFH.bfOffBits := sizeof(TBITMAPFILEHEADER) + image.biSize + DibPaletteSize;
  2833. Stream.Write(BFH, SizeOf(TBITMAPFILEHEADER));
  2834. Stream.Write(image^, BFH.bfSize);
  2835. Stream.Position :=0;
  2836. CoTaskMemFree(image);
  2837. result := true;
  2838. end;
  2839. end;
  2840. function TVideoWindow.GetVisible: boolean;
  2841. begin
  2842. result := inherited visible;
  2843. end;
  2844. procedure TVideoWindow.SetVisible(Vis: boolean);
  2845. begin
  2846. inherited Visible := Vis;
  2847. if assigned(FVideoWindow) then CheckDSError(FVideoWindow.put_Visible(vis));
  2848. end;
  2849. procedure TVideoWindow.SetAllocator(Allocator: TAbstractAllocatorClass; UserID: Cardinal);
  2850. begin
  2851. FAllocatorClass := Allocator;
  2852. FRenderLessUserID := UserID;
  2853. end;
  2854. // *****************************************************************************
  2855. // TSampleGrabber
  2856. // *****************************************************************************
  2857. procedure TSampleGrabber.SetFilterGraph(AFilterGraph: TFilterGraph);
  2858. begin
  2859. if AFilterGraph = FFilterGraph then exit;
  2860. if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self);
  2861. if AFilterGraph <> nil then AFilterGraph.InsertFilter(self);
  2862. FFilterGraph := AFilterGraph;
  2863. end;
  2864. function TSampleGrabber.GetFilter: IBaseFilter;
  2865. begin
  2866. result := FBaseFilter;
  2867. end;
  2868. function TSampleGrabber.GetName: string;
  2869. begin
  2870. result := name;
  2871. end;
  2872. procedure TSampleGrabber.NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  2873. var
  2874. EnumPins: IEnumPins;
  2875. begin
  2876. case operation of
  2877. foAdding : Cocreateinstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC ,IID_IBASEFilter, FBaseFilter);
  2878. foAdded :
  2879. begin
  2880. FBaseFilter.QueryInterface(IID_ISampleGrabber,SampleGrabber);
  2881. FBaseFilter.EnumPins(EnumPins);
  2882. EnumPins.Next(1,InPutPin,nil);
  2883. EnumPins.Next(1,OutPutPin,nil);
  2884. EnumPins := nil;
  2885. UpdateMediaType;
  2886. SampleGrabber.SetBufferSamples(true);
  2887. SampleGrabber.SetCallback(Self ,1);
  2888. end;
  2889. foRemoving :
  2890. begin
  2891. FBaseFilter.Stop;
  2892. InPutPin.Disconnect;
  2893. OutPutPin.Disconnect;
  2894. end;
  2895. foRemoved :
  2896. begin
  2897. SampleGrabber.SetCallback(nil ,1);
  2898. SampleGrabber.SetBufferSamples(false);
  2899. FBaseFilter := nil;
  2900. SampleGrabber := nil;
  2901. InPutPin := nil;
  2902. OutPutPin := nil;
  2903. end;
  2904. foRefresh: UpdateMediaType;
  2905. end;
  2906. end;
  2907. constructor TSampleGrabber.Create(AOwner: TComponent);
  2908. begin
  2909. inherited Create(AOwner);
  2910. FCriticalSection := TCriticalSection.Create;
  2911. assert(CheckFilter, 'The SampleGrabber Filter is not available on this system.');
  2912. FMediaType := TMediaType.Create(MEDIATYPE_Video);
  2913. FMediaType.SubType := MEDIASUBTYPE_RGB24;
  2914. FMediaType.FormatType := FORMAT_VideoInfo;
  2915. // [pjh, 2003-07-14] BMPInfo local
  2916. // new(BMPInfo);
  2917. end;
  2918. destructor TSampleGrabber.Destroy;
  2919. begin
  2920. FilterGraph := nil;
  2921. FMediaType.Free;
  2922. // [pjh, 2003-07-14] BMPInfo local
  2923. // Dispose(BMPInfo);
  2924. FCriticalSection.Free;
  2925. inherited destroy;
  2926. end;
  2927. class function TSampleGrabber.CheckFilter: boolean;
  2928. var
  2929. AFilter: IBaseFilter;
  2930. begin
  2931. result := Cocreateinstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC ,IID_IBASEFilter, AFilter) = S_OK;
  2932. AFilter := nil;
  2933. end;
  2934. procedure TSampleGrabber.Notification(AComponent: TComponent; Operation: TOperation);
  2935. begin
  2936. inherited Notification(AComponent, Operation);
  2937. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  2938. FFilterGraph := nil;
  2939. end;
  2940. procedure TSampleGrabber.UpdateMediaType;
  2941. begin
  2942. if assigned(SampleGrabber) then
  2943. begin
  2944. FBaseFilter.Stop;
  2945. InPutPin.Disconnect;
  2946. SampleGrabber.SetMediaType(MediaType.AMMediaType^);
  2947. end;
  2948. end;
  2949. procedure TSampleGrabber.SetBMPCompatible(Source: PAMMediaType; SetDefault: cardinal);
  2950. var
  2951. SubType : TGUID;
  2952. BitCount: LongWord;
  2953. begin
  2954. BitCount := SetDefault;
  2955. MediaType.ResetFormatBuffer;
  2956. ZeroMemory(MediaType.AMMediaType, sizeof(TAMMediaType));
  2957. MediaType.majortype := MEDIATYPE_Video;
  2958. MediaType.formattype := FORMAT_VideoInfo;
  2959. if Source = nil then
  2960. begin
  2961. case SetDefault of
  2962. 0 : MediaType.subtype := MEDIASUBTYPE_RGB24;
  2963. 1 : MediaType.subtype := MEDIASUBTYPE_RGB1;
  2964. 2 ..4 : MediaType.subtype := MEDIASUBTYPE_RGB4;
  2965. 5 ..8 : MediaType.subtype := MEDIASUBTYPE_RGB8;
  2966. 9 ..16 : MediaType.subtype := MEDIASUBTYPE_RGB555;
  2967. 17..24 : MediaType.subtype := MEDIASUBTYPE_RGB24;
  2968. 25..32 : MediaType.subtype := MEDIASUBTYPE_RGB32
  2969. else
  2970. MediaType.subtype := MEDIASUBTYPE_RGB32;
  2971. end;
  2972. UpdateMediaType;
  2973. exit;
  2974. end;
  2975. SubType := Source.subtype;
  2976. if (IsEqualGUID(SubType, MEDIASUBTYPE_RGB1) or
  2977. IsEqualGUID(SubType, MEDIASUBTYPE_RGB4) or
  2978. IsEqualGUID(SubType, MEDIASUBTYPE_RGB8) or
  2979. IsEqualGUID(SubType, MEDIASUBTYPE_RGB555) or
  2980. IsEqualGUID(SubType, MEDIASUBTYPE_RGB24) or
  2981. IsEqualGUID(SubType, MEDIASUBTYPE_RGB32)) then
  2982. MediaType.subtype := SubType // no change
  2983. else
  2984. begin
  2985. // get bitcount
  2986. if assigned(Source.pbFormat) then
  2987. if IsEqualGUID(Source.formattype, FORMAT_VideoInfo) then
  2988. BitCount := PVideoInfoHeader(Source.pbFormat)^.bmiHeader.biBitCount else
  2989. if IsEqualGUID(Source.formattype, FORMAT_VideoInfo2) then
  2990. BitCount := PVideoInfoHeader2(Source.pbFormat)^.bmiHeader.biBitCount else
  2991. if IsEqualGUID(Source.formattype, FORMAT_MPEGVideo) then
  2992. BitCount := PMPEG1VideoInfo(Source.pbFormat)^.hdr.bmiHeader.biBitCount else
  2993. if IsEqualGUID(Source.formattype, FORMAT_MPEG2Video) then
  2994. BitCount := PMPEG2VideoInfo(Source.pbFormat)^.hdr.bmiHeader.biBitCount;
  2995. case BitCount of
  2996. 0 : MediaType.subtype := MEDIASUBTYPE_RGB24;
  2997. 1 : MediaType.subtype := MEDIASUBTYPE_RGB1;
  2998. 2 ..4 : MediaType.subtype := MEDIASUBTYPE_RGB4;
  2999. 5 ..8 : MediaType.subtype := MEDIASUBTYPE_RGB8;
  3000. 9 ..16 : MediaType.subtype := MEDIASUBTYPE_RGB555;
  3001. 17..24 : MediaType.subtype := MEDIASUBTYPE_RGB24;
  3002. 25..32 : MediaType.subtype := MEDIASUBTYPE_RGB32
  3003. else
  3004. MediaType.subtype := MEDIASUBTYPE_RGB32;
  3005. end;
  3006. end;
  3007. UpdateMediaType;
  3008. end;
  3009. function GetDIBLineSize(BitCount, Width: Integer): Integer;
  3010. begin
  3011. if BitCount = 15 then
  3012. BitCount := 16;
  3013. Result := ((BitCount * Width + 31) div 32) * 4;
  3014. end;
  3015. // [pjh, 2003-07-17] modified
  3016. // Buffer = Nil -> Get the data from SampleGrabber
  3017. // Buffer <> Nil -> Copy the DIB from buffer to Bitmap
  3018. function TSampleGrabber.GetBitmap(Bitmap: TBitmap; Buffer: Pointer; BufferLen: Integer): Boolean;
  3019. var
  3020. hr: HRESULT;
  3021. BIHeaderPtr: PBitmapInfoHeader;
  3022. MediaType: TAMMediaType;
  3023. BitmapHandle: HBitmap;
  3024. DIBPtr: Pointer;
  3025. DIBSize: LongInt;
  3026. begin
  3027. Result := False;
  3028. if not Assigned(Bitmap) then
  3029. Exit;
  3030. if Assigned(Buffer) and (BufferLen = 0) then
  3031. Exit;
  3032. hr := SampleGrabber.GetConnectedMediaType(MediaType);
  3033. if hr <> S_OK then
  3034. Exit;
  3035. try
  3036. if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
  3037. begin
  3038. BIHeaderPtr := Nil;
  3039. if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
  3040. begin
  3041. if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then // check size
  3042. BIHeaderPtr := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
  3043. end
  3044. else if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo2) then
  3045. begin
  3046. if MediaType.cbFormat = SizeOf(TVideoInfoHeader2) then // check size
  3047. BIHeaderPtr := @(PVideoInfoHeader2(MediaType.pbFormat)^.bmiHeader);
  3048. end;
  3049. // check, whether format is supported by TSampleGrabber
  3050. if not Assigned(BIHeaderPtr) then
  3051. Exit;
  3052. BitmapHandle := CreateDIBSection(0, PBitmapInfo(BIHeaderPtr)^,
  3053. DIB_RGB_COLORS, DIBPtr, 0, 0);
  3054. if BitmapHandle <> 0 then
  3055. begin
  3056. try
  3057. if DIBPtr = Nil then
  3058. Exit;
  3059. // get DIB size
  3060. DIBSize := BIHeaderPtr^.biSizeImage;
  3061. if DIBSize = 0 then
  3062. begin
  3063. with BIHeaderPtr^ do
  3064. DIBSize := GetDIBLineSize(biBitCount, biWidth) * biHeight * biPlanes;
  3065. end;
  3066. // copy DIB
  3067. if not Assigned(Buffer) then
  3068. begin
  3069. // get buffer size
  3070. BufferLen := 0;
  3071. hr := SampleGrabber.GetCurrentBuffer(BufferLen, Nil);
  3072. if (hr <> S_OK) or (BufferLen <= 0) then
  3073. Exit;
  3074. // copy buffer to DIB
  3075. if BufferLen > DIBSize then // copy Min(BufferLen, DIBSize)
  3076. BufferLen := DIBSize;
  3077. hr := SampleGrabber.GetCurrentBuffer(BufferLen, DIBPtr);
  3078. if hr <> S_OK then
  3079. Exit;
  3080. end
  3081. else
  3082. begin
  3083. if BufferLen > DIBSize then // copy Min(BufferLen, DIBSize)
  3084. BufferLen := DIBSize;
  3085. Move(Buffer^, DIBPtr^, BufferLen);
  3086. end;
  3087. Bitmap.Handle := BitmapHandle;
  3088. Result := True;
  3089. finally
  3090. if Bitmap.Handle <> BitmapHandle then // preserve for any changes in Graphics.pas
  3091. DeleteObject(BitmapHandle);
  3092. end;
  3093. end;
  3094. end;
  3095. finally
  3096. FreeMediaType(@MediaType);
  3097. end;
  3098. end;
  3099. function TSampleGrabber.GetBitmap(Bitmap: TBitmap): Boolean;
  3100. begin
  3101. Result := GetBitmap(Bitmap, Nil, 0);
  3102. end;
  3103. function TSampleGrabber.QueryInterface(const IID: TGUID; out Obj): HResult;
  3104. begin
  3105. result := inherited QueryInterface(IID, Obj);
  3106. if failed(result) and assigned(FBaseFilter) then
  3107. result := FBaseFilter.QueryInterface(IID, Obj);
  3108. end;
  3109. function TSampleGrabber.BufferCB(SampleTime: Double; pBuffer: PByte;
  3110. BufferLen: Integer): HResult;
  3111. begin
  3112. if assigned(FOnBuffer) then
  3113. begin
  3114. FCriticalSection.Enter;
  3115. try
  3116. FOnBuffer(self, SampleTime, pBuffer, BufferLen);
  3117. finally
  3118. FCriticalSection.Leave;
  3119. end;
  3120. end;
  3121. result := S_OK;
  3122. end;
  3123. function TSampleGrabber.SampleCB(SampleTime: Double;
  3124. pSample: IMediaSample): HResult;
  3125. begin
  3126. result := S_OK;
  3127. end;
  3128. // *****************************************************************************
  3129. // TFilter
  3130. // *****************************************************************************
  3131. function TFilter.GetFilter: IBaseFilter;
  3132. begin
  3133. result := FFilter;
  3134. end;
  3135. function TFilter.GetName: string;
  3136. begin
  3137. result := name;
  3138. end;
  3139. procedure TFilter.NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  3140. var
  3141. State : TFilterState;
  3142. begin
  3143. case operation of
  3144. foAdding: FFilter := BaseFilter.CreateFilter;
  3145. foRemoving: if (FFilter <> nil) and (FFilter.GetState(0,State) = S_OK) then
  3146. case State of
  3147. State_Paused,
  3148. State_Running: FFilter.Stop;
  3149. end;
  3150. foRemoved: FFilter := nil;
  3151. foRefresh: if assigned(FFilterGraph) then
  3152. begin
  3153. FFilterGraph.RemoveFilter(self);
  3154. FFilterGraph.InsertFilter(self);
  3155. end;
  3156. end;
  3157. end;
  3158. constructor TFilter.Create(AOwner: TComponent);
  3159. begin
  3160. inherited Create(AOwner);
  3161. FBaseFilter := TBaseFilter.Create;
  3162. end;
  3163. destructor TFilter.Destroy;
  3164. begin
  3165. FBaseFilter.Free;
  3166. FilterGraph := nil;
  3167. inherited Destroy;
  3168. end;
  3169. procedure TFilter.SetFilterGraph(AFilterGraph: TFilterGraph);
  3170. begin
  3171. if AFilterGraph = FFilterGraph then exit;
  3172. if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self);
  3173. if AFilterGraph <> nil then AFilterGraph.InsertFilter(self);
  3174. FFilterGraph := AFilterGraph;
  3175. end;
  3176. procedure TFilter.Notification(AComponent: TComponent; Operation: TOperation);
  3177. begin
  3178. inherited Notification(AComponent, Operation);
  3179. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  3180. FFilterGraph := nil;
  3181. end;
  3182. function TFilter.QueryInterface(const IID: TGUID; out Obj): HResult;
  3183. begin
  3184. result := inherited QueryInterface(IID, Obj);
  3185. if not Succeeded(Result) then
  3186. if Assigned(FFilter) then
  3187. result := FFilter.QueryInterface(IID, Obj);
  3188. end;
  3189. // *****************************************************************************
  3190. // TASFWriter
  3191. // *****************************************************************************
  3192. constructor TASFWriter.Create(AOwner: TComponent);
  3193. begin
  3194. inherited Create(AOwner);
  3195. FAutoIndex := true;
  3196. FMultiPass := False;
  3197. FDontCompress := False;
  3198. end;
  3199. destructor TASFWriter.Destroy;
  3200. begin
  3201. FilterGraph := nil;
  3202. inherited Destroy;
  3203. end;
  3204. procedure TASFWriter.SetFilterGraph(AFilterGraph: TFilterGraph);
  3205. begin
  3206. if AFilterGraph = FFilterGraph then exit;
  3207. if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self);
  3208. if AFilterGraph <> nil then AFilterGraph.InsertFilter(self);
  3209. FFilterGraph := AFilterGraph;
  3210. end;
  3211. function TASFWriter.GetFilter: IBaseFilter;
  3212. begin
  3213. result := FFilter;
  3214. end;
  3215. function TASFWriter.GetName: string;
  3216. begin
  3217. result := name;
  3218. end;
  3219. procedure TASFWriter.NotifyFilter(operation: TFilterOperation; Param: integer = 0);
  3220. var
  3221. PinList: TPinList;
  3222. ServiceProvider: IServiceProvider;
  3223. FAsfConfig: IConfigAsfWriter2;
  3224. begin
  3225. case operation of
  3226. foAdding: cocreateinstance(CLSID_WMAsfWriter, nil, CLSCTX_INPROC ,IBaseFilter, FFilter);
  3227. foAdded : begin
  3228. if assigned(FFilter) then
  3229. begin
  3230. SetProfile(FProfile);
  3231. SetFileName(FFileName);
  3232. if Succeeded(FFilter.QueryInterface(IID_IConfigAsfWriter2, FAsfConfig)) then
  3233. begin
  3234. FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_AUTOINDEX, Cardinal(FAutoIndex), 0);
  3235. FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_MULTIPASS, Cardinal(FMultiPass), 0);
  3236. FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_DONTCOMPRESS, Cardinal(FDontCompress), 0);
  3237. end;
  3238. PinList:= TPinList.Create(FFilter);
  3239. try
  3240. if PinList.Count >= 1 then
  3241. begin
  3242. AudioInput := PinList.Items[0];
  3243. if PinList.Count = 2 then
  3244. begin
  3245. VideoInput := PinList.Items[1];
  3246. VideoInput.QueryInterface(IID_IAMStreamConfig, VideoStreamConfig);
  3247. end;
  3248. AudioInput.QueryInterface(IID_IAMStreamConfig, AudioStreamConfig);
  3249. if Succeeded(QueryInterface(IServiceProvider, ServiceProvider)) then
  3250. begin
  3251. ServiceProvider.QueryService(IID_IWMWriterAdvanced2, IID_IWMWriterAdvanced2, WriterAdvanced2);
  3252. ServiceProvider := nil;
  3253. end;
  3254. if ((FPort > 0) and (FMaxUsers > 0)) then
  3255. if Succeeded(WMCreateWriterNetworkSink(WriterNetworkSink)) then
  3256. begin
  3257. WriterNetworkSink.SetNetworkProtocol(WMT_PROTOCOL_HTTP);
  3258. WriterNetworkSink.SetMaximumClients(FMaxUsers);
  3259. WriterNetworkSink.Open(FPort);
  3260. WriterAdvanced2.AddSink(WriterNetworkSink);
  3261. end;
  3262. end;
  3263. finally
  3264. PinList.Free;
  3265. end;
  3266. end;
  3267. end;
  3268. foRemoving: begin
  3269. if assigned(FFilter) then FFilter.Stop;
  3270. if assigned(WriterNetworkSink) then
  3271. begin
  3272. WriterNetworkSink.Disconnect;
  3273. WriterNetworkSink.Close;
  3274. end;
  3275. if assigned(AudioInput) then AudioInput.Disconnect;
  3276. if assigned(VideoInput) then VideoInput.Disconnect;
  3277. end;
  3278. foRemoved: begin
  3279. WriterAdvanced2 := nil;
  3280. WriterNetworkSink := nil;
  3281. AudioInput := nil;
  3282. VideoInput := nil;
  3283. AudioStreamConfig := nil;
  3284. VideoStreamConfig := nil;
  3285. FFilter := nil;
  3286. end;
  3287. end;
  3288. end;
  3289. procedure TASFWriter.Notification(AComponent: TComponent; Operation: TOperation);
  3290. begin
  3291. inherited Notification(AComponent, Operation);
  3292. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  3293. FFilterGraph := nil;
  3294. end;
  3295. function TASFWriter.GetProfile: TWMPofiles8;
  3296. var
  3297. GUIDProf: TGUID;
  3298. ConfigAsfWriter: IConfigAsfWriter;
  3299. begin
  3300. if Succeeded(QueryInterface(IConfigAsfWriter, ConfigAsfWriter)) then
  3301. begin
  3302. ConfigAsfWriter.GetCurrentProfileGuid(GUIDProf);
  3303. result := ProfileFromGUID(GUIDProf);
  3304. ConfigAsfWriter := nil;
  3305. end
  3306. else
  3307. result := FProfile
  3308. end;
  3309. procedure TASFWriter.SetProfile(profile: TWMPofiles8);
  3310. var
  3311. ConfigAsfWriter: IConfigAsfWriter;
  3312. begin
  3313. if Succeeded(QueryInterface(IConfigAsfWriter, ConfigAsfWriter)) then
  3314. begin
  3315. ConfigAsfWriter.ConfigureFilterUsingProfileGuid(WMProfiles8[profile]);
  3316. ConfigAsfWriter := nil;
  3317. end
  3318. else
  3319. FProfile := profile;
  3320. end;
  3321. function TASFWriter.GetFileName: String;
  3322. var
  3323. F: PWideChar;
  3324. FileSinkFilter2: IFileSinkFilter2;
  3325. begin
  3326. if Succeeded(QueryInterface(IFileSinkFilter2, FileSinkFilter2)) then
  3327. begin
  3328. FileSinkFilter2.GetCurFile(F,nil);
  3329. FileSinkFilter2 := nil;
  3330. result := F;
  3331. end
  3332. else
  3333. result := FFileName;
  3334. end;
  3335. procedure TASFWriter.SetFileName(FileName: String);
  3336. var FileSinkFilter2: IFileSinkFilter2;
  3337. begin
  3338. FFileName := FileName;
  3339. if Succeeded(QueryInterface(IFileSinkFilter2, FileSinkFilter2)) then
  3340. begin
  3341. FileSinkFilter2.SetFileName(PWideChar(FFileName),nil);
  3342. FileSinkFilter2 := nil;
  3343. end;
  3344. end;
  3345. function TASFWriter.QueryInterface(const IID: TGUID; out Obj): HResult;
  3346. begin
  3347. result := inherited QueryInterface(IID, Obj);
  3348. if failed(result) and assigned(FFilter) then
  3349. result := FFilter.QueryInterface(IID, Obj);
  3350. end;
  3351. // *****************************************************************************
  3352. // TDSTrackBar
  3353. // *****************************************************************************
  3354. procedure TDSTrackBar.SetFilterGraph(AFilterGraph: TFilterGraph);
  3355. begin
  3356. if AFilterGraph = FFilterGraph then exit;
  3357. if FFilterGraph <> nil then FFilterGraph.RemoveEventNotifier(self);
  3358. if AFilterGraph <> nil then AFilterGraph.InsertEventNotifier(self);
  3359. FFilterGraph := AFilterGraph;
  3360. end;
  3361. constructor TDSTrackBar.Create(AOwner: TComponent);
  3362. begin
  3363. inherited Create(AOwner);
  3364. FMouseDown := false;
  3365. FEnabled := false;
  3366. FInterval := 1000;
  3367. FWindowHandle := AllocateHWnd(TimerWndProc);
  3368. end;
  3369. destructor TDSTrackBar.Destroy;
  3370. begin
  3371. FEnabled := False;
  3372. UpdateTimer;
  3373. FilterGraph := nil;
  3374. DeallocateHWnd(FWindowHandle);
  3375. FMediaSeeking := nil;
  3376. inherited Destroy;
  3377. end;
  3378. procedure TDSTrackBar.Notification(AComponent: TComponent;
  3379. Operation: TOperation);
  3380. begin
  3381. inherited Notification(AComponent, Operation);
  3382. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  3383. begin
  3384. FMediaSeeking := nil;
  3385. FFilterGraph := nil;
  3386. end;
  3387. end;
  3388. procedure TDSTrackBar.GraphEvent(Event, Param1, Param2: integer);
  3389. var
  3390. Duration: int64;
  3391. Zero: int64;
  3392. begin
  3393. case Event of
  3394. EC_CLOCK_CHANGED: if assigned(FMediaSeeking) then
  3395. begin
  3396. Zero := 0;
  3397. FMediaSeeking.GetDuration(Duration);
  3398. FMediaSeeking.SetPositions(Zero, AM_SEEKING_AbsolutePositioning,
  3399. Duration , AM_SEEKING_NoPositioning);
  3400. end;
  3401. end;
  3402. end;
  3403. procedure TDSTrackBar.ControlEvent(Event: TControlEvent; Param: integer = 0);
  3404. begin
  3405. case event of
  3406. cePlay: TimerEnabled := Enabled;
  3407. cePause..ceStop: TimerEnabled := false;
  3408. ceActive: case Param of
  3409. 0: FMediaSeeking := nil;
  3410. 1: FFilterGraph.QueryInterface(IMediaSeeking, FMediaSeeking);
  3411. end;
  3412. end;
  3413. end;
  3414. procedure TDSTrackBar.SetTimerEnabled(Value: Boolean);
  3415. begin
  3416. if Value <> FEnabled then
  3417. begin
  3418. FEnabled := Value;
  3419. UpdateTimer;
  3420. end;
  3421. end;
  3422. procedure TDSTrackBar.SetInterval(Value: Cardinal);
  3423. begin
  3424. if Value <> FInterval then
  3425. begin
  3426. FInterval := Value;
  3427. UpdateTimer;
  3428. end;
  3429. end;
  3430. procedure TDSTrackBar.SetOnTimer(Value: TTimerEvent);
  3431. begin
  3432. FOnTimer := Value;
  3433. UpdateTimer;
  3434. end;
  3435. procedure TDSTrackBar.UpdateTimer;
  3436. begin
  3437. KillTimer(FWindowHandle, 1);
  3438. if (FInterval <> 0) and FEnabled then
  3439. if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
  3440. raise EOutOfResources.Create(SNoTimers);
  3441. end;
  3442. procedure TDSTrackBar.Timer;
  3443. var
  3444. CurrentPos, StopPos: int64;
  3445. MlsCurrentPos, MlsStopPos: Cardinal;
  3446. begin
  3447. if assigned(FMediaSeeking) and (not FMouseDown) then
  3448. if Succeeded(FMediaSeeking.GetDuration(StopPos)) then
  3449. if Succeeded(FMediaSeeking.GetCurrentPosition(CurrentPos)) then
  3450. begin
  3451. MlsCurrentPos := RefTimeToMiliSec(CurrentPos);
  3452. MlsStopPos := RefTimeToMiliSec(StopPos);
  3453. min := 0;
  3454. max := MlsStopPos div TimerInterval;
  3455. Position := MlsCurrentPos div TimerInterval;
  3456. if Assigned(FOnTimer) then FOnTimer(Self, MlsCurrentPos, MlsStopPos);
  3457. end;
  3458. end;
  3459. procedure TDSTrackBar.TimerWndProc(var Msg: TMessage);
  3460. begin
  3461. with Msg do
  3462. if Msg = WM_TIMER then
  3463. try
  3464. Timer;
  3465. except
  3466. Application.HandleException(Self);
  3467. end
  3468. else
  3469. Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  3470. end;
  3471. procedure TDSTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3472. var
  3473. StopPosition, CurrentPosition: int64;
  3474. begin
  3475. inherited MouseUp(Button, Shift, X, Y);
  3476. if Button = mbLeft then
  3477. if assigned(FMediaSeeking) then
  3478. begin
  3479. FMediaSeeking.GetStopPosition(StopPosition);
  3480. CurrentPosition := (StopPosition * Position) div max ;
  3481. FMediaSeeking.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning,
  3482. StopPosition , AM_SEEKING_NoPositioning);
  3483. end;
  3484. FMouseDown := False;
  3485. end;
  3486. procedure TDSTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3487. begin
  3488. inherited MouseDown(Button, Shift, X, Y);
  3489. if Button = mbLeft then FMouseDown := true;
  3490. end;
  3491. // --------------------------- Color Control -------------------------------
  3492. constructor TColorControl.Create(AOwner: TDSVideoWindowEx2);
  3493. begin
  3494. inherited Create;
  3495. FOwner := AOwner;
  3496. ZeroMemory(@FDefault,SizeOf(TDDColorControl));
  3497. with FDefault do
  3498. begin
  3499. dwSize := SizeOf(TDDCOLORCONTROL);
  3500. dwFlags := DDCOLOR_BRIGHTNESS or DDCOLOR_CONTRAST or DDCOLOR_HUE
  3501. or DDCOLOR_SATURATION or DDCOLOR_GAMMA or DDCOLOR_SHARPNESS
  3502. or DDCOLOR_COLORENABLE;
  3503. lBrightness := 750;
  3504. lContrast := 10000;
  3505. lGamma := 1;
  3506. lHue := 0;
  3507. lSaturation := 10000;
  3508. lSharpness := 5;
  3509. lColorEnable := integer(True);
  3510. dwReserved1 := 0;
  3511. end;
  3512. FBrightness := FDefault.lBrightness;
  3513. FContrast := FDefault.lContrast;
  3514. FGamma := FDefault.lGamma;
  3515. FHue := FDefault.lHue;
  3516. FSaturation := FDefault.lSaturation;
  3517. FSharpness := FDefault.lSharpness;
  3518. FUtilColor := Bool(FDefault.lColorEnable);
  3519. end;
  3520. procedure TColorControl.ReadDefault;
  3521. var
  3522. EnumPins : IEnumPins;
  3523. Pin : IPin;
  3524. ul : cardinal;
  3525. pd : TPinDirection;
  3526. MPC : IMixerPinConfig2;
  3527. Tel : Integer;
  3528. FG : IFilterGraph;
  3529. FilterList : TFilterList;
  3530. Hr : HResult;
  3531. OVM : IBaseFilter;
  3532. FClass : TGuid;
  3533. Tmp : TDDColorControl;
  3534. begin
  3535. if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or
  3536. (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or
  3537. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit;
  3538. MPC := nil;
  3539. OVM := nil;
  3540. FG := nil;
  3541. FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph;
  3542. FilterList := TFilterList.Create(FG);
  3543. try
  3544. for Tel := 0 to FilterList.Count -1 do
  3545. begin
  3546. FilterList[Tel].GetClassID(FClass);
  3547. if IsEqualGuid(FClass, CLSID_OverlayMixer) then
  3548. OVM := FilterList[Tel];
  3549. if IsEqualGuid(FClass, CLSID_OverlayMixer2) then
  3550. OVM := FilterList[Tel];
  3551. end;
  3552. if OVM = nil then Exit;
  3553. Hr := OVM.EnumPins(EnumPins);
  3554. if Failed(Hr) then Exit;
  3555. Tel := 0;
  3556. while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do
  3557. begin
  3558. Hr := Pin.QueryDirection(pd);
  3559. if Failed(Hr) then Exit;
  3560. if pd = PINDIR_INPUT then
  3561. begin
  3562. Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC);
  3563. if Failed(Hr) then Exit;
  3564. Inc(Tel);
  3565. end;
  3566. Pin := nil;
  3567. end;
  3568. EnumPins := nil;
  3569. ZeroMemory(@Tmp,SizeOf(TDDColorControl));
  3570. Tmp.dwSize:=SizeOf(TDDCOLORCONTROL);
  3571. Hr := MPC.GetOverlaySurfaceColorControls(Tmp);
  3572. if Failed(Hr) then Exit;
  3573. FDefault := Tmp;
  3574. finally
  3575. FilterList.Free;
  3576. FG := nil;
  3577. OVM := nil;
  3578. EnumPins := nil;
  3579. Pin := nil;
  3580. MPC := nil;
  3581. end;
  3582. end;
  3583. procedure TColorControl.UpdateColorControls;
  3584. var
  3585. EnumPins : IEnumPins;
  3586. Pin : IPin;
  3587. ul : cardinal;
  3588. pd : TPinDirection;
  3589. MPC : IMixerPinConfig2;
  3590. Tel : Integer;
  3591. FG : IFilterGraph;
  3592. FilterList : TFilterList;
  3593. Hr : HResult;
  3594. OVM : IBaseFilter;
  3595. FClass : TGuid;
  3596. Tmp : TDDColorControl;
  3597. begin
  3598. if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or
  3599. (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or
  3600. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit;
  3601. MPC := nil;
  3602. OVM := nil;
  3603. FG := nil;
  3604. FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph;
  3605. FilterList := TFilterList.Create(FG);
  3606. try
  3607. for Tel := 0 to FilterList.Count -1 do
  3608. begin
  3609. FilterList[Tel].GetClassID(FClass);
  3610. if IsEqualGuid(FClass, CLSID_OverlayMixer) then
  3611. OVM := FilterList[Tel];
  3612. if IsEqualGuid(FClass, CLSID_OverlayMixer2) then
  3613. OVM := FilterList[Tel];
  3614. end;
  3615. if OVM = nil then Exit;
  3616. Hr := OVM.EnumPins(EnumPins);
  3617. if Failed(Hr) then Exit;
  3618. Tel := 0;
  3619. while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do
  3620. begin
  3621. Hr := Pin.QueryDirection(pd);
  3622. if Failed(Hr) then Exit;
  3623. if pd = PINDIR_INPUT then
  3624. begin
  3625. Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC);
  3626. if Failed(Hr) then Exit;
  3627. Inc(Tel);
  3628. end;
  3629. Pin := nil;
  3630. end;
  3631. EnumPins := nil;
  3632. Tmp.dwSize := SizeOf(TDDCOLORCONTROL);
  3633. Tmp.dwFlags := DDCOLOR_BRIGHTNESS or DDCOLOR_CONTRAST or DDCOLOR_HUE or DDCOLOR_SATURATION or DDCOLOR_GAMMA or DDCOLOR_SHARPNESS or DDCOLOR_COLORENABLE;
  3634. Tmp.lBrightness := FBrightness;
  3635. Tmp.lContrast := FContrast;
  3636. Tmp.lHue := FHue;
  3637. Tmp.lSaturation := FSaturation;
  3638. Tmp.lSharpness := FSharpness;
  3639. Tmp.lGamma := FGamma;
  3640. Tmp.lColorEnable := integer(FUtilColor);
  3641. Tmp.dwReserved1 := 0;
  3642. Hr := MPC.setOverlaySurfaceColorControls(Pointer(@Tmp));
  3643. if Failed(Hr) then Exit;
  3644. finally
  3645. FilterList.Free;
  3646. FG := nil;
  3647. OVM := nil;
  3648. EnumPins := nil;
  3649. Pin := nil;
  3650. MPC := nil;
  3651. end;
  3652. end;
  3653. procedure TColorControl.GetColorControls;
  3654. var
  3655. EnumPins : IEnumPins;
  3656. Pin : IPin;
  3657. ul : cardinal;
  3658. pd : TPinDirection;
  3659. MPC : IMixerPinConfig2;
  3660. Tel : Integer;
  3661. FG : IFilterGraph;
  3662. FilterList : TFilterList;
  3663. Hr : HResult;
  3664. OVM : IBaseFilter;
  3665. FClass : TGuid;
  3666. Tmp : TDDColorControl;
  3667. begin
  3668. if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or
  3669. (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or
  3670. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit;
  3671. MPC := nil;
  3672. OVM := nil;
  3673. FG := nil;
  3674. FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph;
  3675. FilterList := TFilterList.Create(FG);
  3676. try
  3677. for Tel := 0 to FilterList.Count -1 do
  3678. begin
  3679. FilterList[Tel].GetClassID(FClass);
  3680. if IsEqualGuid(FClass, CLSID_OverlayMixer) then
  3681. OVM := FilterList[Tel];
  3682. if IsEqualGuid(FClass, CLSID_OverlayMixer2) then
  3683. OVM := FilterList[Tel];
  3684. end;
  3685. if OVM = nil then Exit;
  3686. Hr := OVM.EnumPins(EnumPins);
  3687. if Failed(Hr) then Exit;
  3688. Tel := 0;
  3689. while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do
  3690. begin
  3691. Hr := Pin.QueryDirection(pd);
  3692. if Failed(Hr) then Exit;
  3693. if pd = PINDIR_INPUT then
  3694. begin
  3695. Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC);
  3696. if Failed(Hr) then Exit;
  3697. Inc(Tel);
  3698. end;
  3699. Pin := nil;
  3700. end;
  3701. EnumPins := nil;
  3702. ZeroMemory(@Tmp,SizeOf(TDDColorControl));
  3703. Tmp.dwSize := SizeOf(TDDCOLORCONTROL);
  3704. Hr := MPC.GetOverlaySurfaceColorControls(Tmp);
  3705. if Failed(Hr) then
  3706. begin
  3707. FBrightness := 750;
  3708. FContrast := 10000;
  3709. FHue := 0;
  3710. FSaturation := 10000;
  3711. FSharpness := 5;
  3712. FGamma := 1;
  3713. FUtilColor := True;
  3714. Exit;
  3715. end
  3716. else
  3717. begin
  3718. FBrightness := Tmp.lBrightness;
  3719. FContrast := Tmp.lContrast;
  3720. FHue := Tmp.lHue;
  3721. FSaturation := Tmp.lSaturation;
  3722. FSharpness := Tmp.lSharpness;
  3723. FGamma := Tmp.lGamma;
  3724. FUtilColor := Bool(Tmp.lColorEnable);
  3725. end;
  3726. finally
  3727. FilterList.Free;
  3728. FG := nil;
  3729. OVM := nil;
  3730. EnumPins := nil;
  3731. Pin := nil;
  3732. MPC := nil;
  3733. end;
  3734. end;
  3735. procedure TColorControl.RestoreDefault;
  3736. begin
  3737. FBrightness := FDefault.lBrightness;
  3738. FContrast := FDefault.lContrast;
  3739. FHue := FDefault.lHue;
  3740. FSaturation := FDefault.lSaturation;
  3741. FSharpness := FDefault.lSharpness;
  3742. FGamma := FDefault.lGamma;
  3743. FUtilColor := Bool(FDefault.lColorEnable);
  3744. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3745. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3746. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3747. UpdateColorControls;
  3748. end;
  3749. Procedure TColorControl.SetBrightness(Value : Integer);
  3750. begin
  3751. if (Value > -1) and (Value < 10001) then
  3752. begin
  3753. if Value <> FBrightness then
  3754. FBrightness := Value;
  3755. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3756. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3757. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3758. UpdateColorControls;
  3759. end
  3760. else
  3761. raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 10.000', [Value]);
  3762. end;
  3763. Procedure TColorControl.SetContrast(Value : Integer);
  3764. begin
  3765. if (Value > -1) and (Value < 20001) then
  3766. begin
  3767. if Value <> FContrast then
  3768. FContrast := Value;
  3769. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3770. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3771. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3772. UpdateColorControls;
  3773. end
  3774. else
  3775. raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 20.000', [Value]);
  3776. end;
  3777. procedure TColorControl.SetHue(Value : Integer);
  3778. begin
  3779. if (Value > -181) and (Value < 182) then
  3780. begin
  3781. if Value <> FHue then
  3782. FHue := Value;
  3783. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3784. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3785. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3786. UpdateColorControls;
  3787. end
  3788. else
  3789. raise Exception.CreateFmt('Value %d out of range. Value must bee between -180 -> 180', [Value]);
  3790. end;
  3791. procedure TColorControl.SetSaturation(Value : Integer);
  3792. begin
  3793. if (Value > -1) and (Value < 20001) then
  3794. begin
  3795. if Value <> FSaturation then
  3796. FSaturation := Value;
  3797. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3798. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3799. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3800. UpdateColorControls;
  3801. end
  3802. else
  3803. raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 20.000', [Value]);
  3804. end;
  3805. procedure TColorControl.SetSharpness(Value : Integer);
  3806. begin
  3807. if (Value > -1) and (Value < 11) then
  3808. begin
  3809. if Value <> FSharpness then
  3810. FSharpness := Value;
  3811. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3812. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3813. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3814. UpdateColorControls;
  3815. end
  3816. else
  3817. raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 10', [Value]);
  3818. end;
  3819. procedure TColorControl.SetGamma(Value : Integer);
  3820. begin
  3821. if (Value > 0) and (Value < 501) then
  3822. begin
  3823. if Value <> FGamma then
  3824. FGamma := Value;
  3825. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3826. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3827. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3828. UpdateColorControls;
  3829. end
  3830. else
  3831. raise Exception.CreateFmt('Value %d out of range. Value must bee between 1 -> 500', [Value]);
  3832. end;
  3833. procedure TColorControl.SetUtilColor(Value : Boolean);
  3834. begin
  3835. FUtilColor := Value;
  3836. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3837. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3838. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3839. UpdateColorControls;
  3840. end;
  3841. function TColorControl.GetBrightness : Integer;
  3842. begin
  3843. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3844. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3845. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3846. GetColorControls;
  3847. Result := fBrightness;
  3848. end;
  3849. function TColorControl.GetContrast : Integer;
  3850. begin
  3851. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3852. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3853. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3854. GetColorControls;
  3855. Result := fContrast;
  3856. end;
  3857. function TColorControl.GetHue : Integer;
  3858. begin
  3859. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3860. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3861. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3862. GetColorControls;
  3863. Result := fHue;
  3864. end;
  3865. function TColorControl.GetSaturation : Integer;
  3866. begin
  3867. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3868. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3869. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3870. GetColorControls;
  3871. Result := fSaturation;
  3872. end;
  3873. function TColorControl.GetSharpness : Integer;
  3874. begin
  3875. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3876. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3877. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3878. GetColorControls;
  3879. Result := fSharpness;
  3880. end;
  3881. function TColorControl.GetGamma : Integer;
  3882. begin
  3883. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3884. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3885. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3886. GetColorControls;
  3887. Result := fGamma;
  3888. end;
  3889. function TColorControl.GetUtilColor : Boolean;
  3890. begin
  3891. if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and
  3892. (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and
  3893. (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then
  3894. GetColorControls;
  3895. Result := fUtilColor;
  3896. end;
  3897. // ---------------------- DSVideoWindowEx2Capabilities -------------------
  3898. constructor TDSVideoWindowEx2Caps.create(AOwner: TDSVideoWindowEx2);
  3899. begin
  3900. inherited Create;
  3901. Owner := AOwner;
  3902. end;
  3903. function TDSVideoWindowEx2Caps.GetCanOverlay : Boolean;
  3904. begin
  3905. Result := TDSVideoWindowEx2(Owner).FOverlayMixer <> nil;
  3906. end;
  3907. function TDSVideoWindowEx2Caps.GetCanControlBrigtness : Boolean;
  3908. begin
  3909. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3910. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_BRIGHTNESS = DDCOLOR_BRIGHTNESS
  3911. else
  3912. Result := False;
  3913. end;
  3914. function TDSVideoWindowEx2Caps.GetCanControlContrast : Boolean;
  3915. begin
  3916. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3917. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_CONTRAST = DDCOLOR_CONTRAST
  3918. else
  3919. Result := False;
  3920. end;
  3921. function TDSVideoWindowEx2Caps.GetCanControlHue : Boolean;
  3922. begin
  3923. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3924. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_HUE = DDCOLOR_HUE
  3925. else
  3926. Result := False;
  3927. end;
  3928. function TDSVideoWindowEx2Caps.GetCanControlSaturation : Boolean;
  3929. begin
  3930. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3931. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_SATURATION = DDCOLOR_SATURATION
  3932. else
  3933. Result := False;
  3934. end;
  3935. function TDSVideoWindowEx2Caps.GetCanControlSharpness : Boolean;
  3936. begin
  3937. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3938. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_SHARPNESS = DDCOLOR_SHARPNESS
  3939. else
  3940. Result := False;
  3941. end;
  3942. function TDSVideoWindowEx2Caps.GetCanControlGamma : Boolean;
  3943. begin
  3944. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3945. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_GAMMA = DDCOLOR_GAMMA
  3946. else
  3947. Result := False;
  3948. end;
  3949. function TDSVideoWindowEx2Caps.GetCanControlUtilizedColor : Boolean;
  3950. begin
  3951. if TDSVideoWindowEx2(Owner).FColorControl <> nil then
  3952. Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_COLORENABLE = DDCOLOR_COLORENABLE
  3953. else
  3954. Result := False;
  3955. end;
  3956. // ----------------------------------- Overlay Callback ------------------
  3957. constructor TOverlayCallBack.Create(Owner : TObject);
  3958. begin
  3959. AOwner := Owner;
  3960. end;
  3961. function TOverlayCallback.OnUpdateOverlay(bBefore: BOOL; dwFlags: DWORD; bOldVisible: BOOL;
  3962. var prcOldSrc, prcOldDest: TRECT; bNewVisible: BOOL; var prcNewSrc, prcNewDest: TRECT): HRESULT; stdcall;
  3963. begin
  3964. Result := S_OK;
  3965. end;
  3966. function TOverlayCallback.OnUpdateColorKey(var pKey: TCOLORKEY; dwColor: DWORD): HRESULT; stdcall;
  3967. begin
  3968. TDSVideoWindowEx2(AOwner).FColorKey := pKey.HighColorValue;
  3969. if Assigned(TDSVideoWindowEx2(AOwner).FOnColorKey) then
  3970. TDSVideoWindowEx2(AOwner).FOnColorKey(Self);
  3971. Result := S_OK;
  3972. end;
  3973. function TOverlayCallback.OnUpdateSize(dwWidth, dwHeight, dwARWidth, dwARHeight: DWORD): HRESULT; stdcall;
  3974. begin
  3975. if (AOwner = nil) then
  3976. begin
  3977. Result := S_OK;
  3978. Exit;
  3979. end;
  3980. TDSVideoWindowEx2(AOwner).GetVideoInfo;
  3981. TDSVideoWindowEx2(AOwner).Clearback;
  3982. Result := S_OK;
  3983. end;
  3984. // ------------------------------ DSVideoWindowEx -------------------------
  3985. procedure TDSVideoWindowEx2.NotifyFilter(operation: TFilterOperation; Param: integer);
  3986. var
  3987. i: integer;
  3988. EnumPins: TPinList;
  3989. pGB : IGraphBuilder;
  3990. begin
  3991. EnumPins := nil;
  3992. pGB := nil;
  3993. try
  3994. case operation of
  3995. foAdding: begin
  3996. GraphWasUpdatet := False;
  3997. CoCreateInstance(CLSID_VideoRenderer, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter ,FBaseFilter);
  3998. end;
  3999. foAdded: begin
  4000. FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow);
  4001. end;
  4002. foRemoving: begin
  4003. if FOverlayMixer <> nil then
  4004. begin
  4005. FColorControl.RestoreDefault;
  4006. FBaseFilter.Stop;
  4007. EnumPins := TPinList.Create(FOverlayMixer);
  4008. if EnumPins.Count > 0 then
  4009. for i := 0 to EnumPins.Count - 1 do
  4010. EnumPins.Items[i].Disconnect;
  4011. end;
  4012. if FBaseFilter <> nil then
  4013. begin
  4014. FBaseFilter.Stop;
  4015. EnumPins := TPinList.Create(FBaseFilter);
  4016. if EnumPins.Count > 0 then
  4017. for i := 0 to EnumPins.Count - 1 do
  4018. EnumPins.Items[i].Disconnect;
  4019. end;
  4020. if FDDXM <> nil then
  4021. FDDXM.SetCallbackInterface(nil, 0);
  4022. if OverlayCallback <> nil then
  4023. OverlayCallback := nil;
  4024. end;
  4025. foRemoved : begin
  4026. GraphWasUpdatet := False;
  4027. FDDXM := nil;
  4028. FOverlayMixer := nil;
  4029. FVideoRenderer := nil;
  4030. FVideoWindow := nil;
  4031. FBaseFilter := nil;
  4032. end;
  4033. end;
  4034. finally
  4035. if EnumPins <> nil then
  4036. EnumPins.Free;
  4037. pGB := nil;
  4038. end;
  4039. end;
  4040. procedure TDSVideoWindowEx2.GraphEvent(Event, Param1, Param2: integer);
  4041. begin
  4042. case Event of
  4043. EC_PALETTE_CHANGED : RefreshVideoWindow;
  4044. EC_CLOCK_CHANGED : begin
  4045. if GraphBuildOk then SetVideoZOrder;
  4046. SetZoom(FZoom);
  4047. SetAspectMode(FAspectMode);
  4048. if GraphBuildOk then ClearBack;
  4049. end;
  4050. end;
  4051. end;
  4052. function TDSVideoWindowEx2.GetName: string;
  4053. begin
  4054. result := name;
  4055. end;
  4056. procedure TDSVideoWindowEx2.ControlEvent(Event: TControlEvent; Param: integer = 0);
  4057. var
  4058. FilterInfo: TFilterInfo;
  4059. FilterList: TFilterList;
  4060. i: integer;
  4061. GUID: TGUID;
  4062. TmpName : WideString;
  4063. begin
  4064. FilterList := nil;
  4065. try
  4066. case Event of
  4067. ceDVDRendered: begin // mean our Video Filter have been removed
  4068. ZeroMemory(@FilterInfo, SizeOf(TFilterInfo));
  4069. FBaseFilter.QueryFilterInfo(FilterInfo);
  4070. if not assigned(FilterInfo.pGraph) then
  4071. begin
  4072. FilterList:= TFilterList.Create(FilterGraph.FFilterGraph);
  4073. if FilterList.Count > 0 then
  4074. for i := 0 to FilterList.Count - 1 do
  4075. begin
  4076. FilterList.Items[i].GetClassID(GUID);
  4077. if ISEqualGUID(GUID, CLSID_VideoRenderer) then
  4078. begin
  4079. FOverlayMixer := nil;
  4080. FBaseFilter := nil;
  4081. FVideoWindow := nil;
  4082. FVideoRenderer := nil;
  4083. FBaseFilter := FilterList.Items[i];
  4084. FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow);
  4085. GraphBuildOk := Succeeded(UpdateGraph);
  4086. if GraphBuildOk then
  4087. begin
  4088. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4089. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4090. end;
  4091. RefreshVideoWindow;
  4092. break;
  4093. end
  4094. else
  4095. if ISEqualGUID(GUID, CLSID_VideoMixingRenderer) then
  4096. begin
  4097. FOverlayMixer := nil;
  4098. FBaseFilter := nil;
  4099. FVideoRenderer := nil;
  4100. TmpName := Name;
  4101. if FVideoWindow <> nil then
  4102. FilterGraph.FFilterGraph.AddFilter(FVideoWindow as IBaseFilter, PWideChar(TmpName));
  4103. FBaseFilter := FVideoWindow as IBaseFilter;
  4104. GraphBuildOk := Succeeded(UpdateGraph);
  4105. if GraphBuildOk then
  4106. begin
  4107. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4108. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4109. end;
  4110. RefreshVideoWindow;
  4111. break;
  4112. end;
  4113. end;
  4114. end;
  4115. end;
  4116. cePlay: begin
  4117. if not GraphWasUpdatet then
  4118. begin
  4119. GraphBuildOk := Succeeded(UpdateGraph);
  4120. if GraphBuildOk then
  4121. begin
  4122. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4123. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4124. end;
  4125. RefreshVideoWindow;
  4126. end;
  4127. if GraphBuildOk then
  4128. begin
  4129. if (not FOverlayVisible) and (not FDesktopPlay) then
  4130. begin
  4131. FOverlayVisible := True;
  4132. if Assigned(FOnOverlay) then
  4133. FOnOverlay(Self, True);
  4134. Clearback;
  4135. end;
  4136. end;
  4137. end;
  4138. cePause: begin
  4139. if not GraphWasUpdatet then
  4140. begin
  4141. GraphBuildOk := Succeeded(UpdateGraph);
  4142. if GraphBuildOk then
  4143. begin
  4144. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4145. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4146. end;
  4147. RefreshVideoWindow;
  4148. end;
  4149. if GraphBuildOk then
  4150. if (not FOverlayVisible) and (not FDesktopPlay) then
  4151. begin
  4152. FOverlayVisible := True;
  4153. if Assigned(FOnOverlay) then
  4154. FOnOverlay(Self, True);
  4155. Clearback;
  4156. end;
  4157. end;
  4158. ceStop: begin
  4159. if not GraphWasUpdatet then
  4160. begin
  4161. GraphBuildOk := Succeeded(UpdateGraph);
  4162. if GraphBuildOk then
  4163. begin
  4164. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4165. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4166. end;
  4167. RefreshVideoWindow;
  4168. end;
  4169. if GraphBuildOk then
  4170. if FOverlayVisible then
  4171. begin
  4172. FOverlayVisible := False;
  4173. Clearback;
  4174. if Assigned(FOnOverlay) then
  4175. FOnOverlay(Self, False);
  4176. end;
  4177. end;
  4178. ceFileRendered: begin
  4179. GraphBuildOk := Succeeded(UpdateGraph);
  4180. if GraphBuildOk then
  4181. begin
  4182. FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer.
  4183. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls.
  4184. end;
  4185. RefreshVideoWindow;
  4186. end;
  4187. end;
  4188. finally
  4189. if FilterList <> nil then
  4190. FilterList.Free;
  4191. end;
  4192. end;
  4193. procedure TDSVideoWindowEx2.RefreshVideoWindow;
  4194. begin
  4195. if FVideoWindow <> nil then
  4196. with FVideoWindow do
  4197. begin
  4198. if FIsVideoWindowOwner then
  4199. put_Owner(Handle)
  4200. else
  4201. put_Owner(Parent.Handle);
  4202. put_WindowStyle(FWindowStyle or WS_CHILD or WS_CLIPSIBLINGS);
  4203. put_WindowStyleEx(FWindowStyleEx);
  4204. if FIsVideoWindowOwner then
  4205. FVideoWindow.SetWindowPosition(0, 0, Width, Height)
  4206. else
  4207. FVideoWindow.SetWindowPosition(Left, Top, Width, Height);
  4208. if Name <> '' then
  4209. put_Caption(Name);
  4210. put_MessageDrain(Handle);
  4211. Application.ProcessMessages;
  4212. put_AutoShow(not FDesktopPlay);
  4213. end;
  4214. end;
  4215. function TDSVideoWindowEx2.GetFilter: IBaseFilter;
  4216. begin
  4217. result := FBaseFilter;
  4218. end;
  4219. constructor TDSVideoWindowEx2.Create(AOwner: TComponent);
  4220. begin
  4221. inherited Create(AOwner);
  4222. ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  4223. csDoubleClicks, csReflector];
  4224. TabStop := true;
  4225. Height := 240;
  4226. Width := 320;
  4227. color := $000000;
  4228. FColorKey := $100010; //clNone;
  4229. FFullScreen := false;
  4230. FColorControl := TColorControl.create(Self);
  4231. FCaps := TDSVideoWindowEx2Caps.Create(Self);
  4232. AspectRatio := rmLetterBox;
  4233. DigitalZoom := 0;
  4234. GraphBuildOK := False;
  4235. FNoScreenSaver := False;
  4236. FIdleCursor := 0;
  4237. if (csDesigning in componentstate) then Exit;
  4238. FFullScreenControl := TForm.Create(nil);
  4239. FFullScreenControl.Color := Color;
  4240. FFullScreenControl.DefaultMonitor := dmDesktop;
  4241. FFullScreenControl.BorderStyle := bsNone;
  4242. FFullScreenControl.OnCloseQuery := FullScreenCloseQuery;
  4243. FOldParent := nil;
  4244. FMonitor := nil;
  4245. FVideoWindowHandle := 0;
  4246. GraphWasUpdatet := False;
  4247. Application.OnIdle := MyIdleHandler;
  4248. end;
  4249. destructor TDSVideoWindowEx2.Destroy;
  4250. begin
  4251. if DesktopPlayback then
  4252. NormalPlayback;
  4253. if FDDXM <> nil then
  4254. FDDXM.SetCallbackInterface(nil, 0);
  4255. OverlayCallback := nil;
  4256. FOverlayMixer := nil;
  4257. FFilterGraph := nil;
  4258. FVideoWindow := nil;
  4259. FVideoRenderer := nil;
  4260. FCaps.Free;
  4261. FColorControl.Free;
  4262. inherited Destroy;
  4263. end;
  4264. procedure TDSVideoWindowEx2.resize;
  4265. begin
  4266. if (FVideoWindow <> nil) and (not FFullScreen) and (not DesktopPlayback) then
  4267. if FIsVideoWindowOwner then
  4268. FVideoWindow.SetWindowPosition(0, 0, Width, Height)
  4269. else
  4270. FVideoWindow.SetWindowPosition(Left, Top, Width, Height);
  4271. end;
  4272. procedure TDSVideoWindowEx2.Loaded;
  4273. begin
  4274. inherited Loaded;
  4275. FWindowStyle := GetWindowLong(Handle, GWL_STYLE);
  4276. FWindowStyleEx := GetWindowLong(Handle, GWL_EXSTYLE);
  4277. end;
  4278. procedure TDSVideoWindowEx2.Notification(AComponent: TComponent;
  4279. Operation: TOperation);
  4280. begin
  4281. inherited Notification(AComponent, Operation);
  4282. if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
  4283. FFilterGraph := nil;
  4284. end;
  4285. procedure TDSVideoWindowEx2.SetFilterGraph(AFilterGraph: TFilterGraph);
  4286. begin
  4287. if AFilterGraph = FFilterGraph then exit;
  4288. if FFilterGraph <> nil then
  4289. begin
  4290. FFilterGraph.RemoveFilter(self);
  4291. FFilterGraph.RemoveEventNotifier(self);
  4292. end;
  4293. if AFilterGraph <> nil then
  4294. begin
  4295. AFilterGraph.InsertFilter(self);
  4296. AFilterGraph.InsertEventNotifier(self);
  4297. end;
  4298. FFilterGraph := AFilterGraph;
  4299. end;
  4300. procedure TDSVideoWindowEx2.SetTopMost(TopMost: boolean);
  4301. begin
  4302. FTopMost := TopMost;
  4303. end;
  4304. procedure TDSVideoWindowEx2.SetVideoZOrder;
  4305. var
  4306. input : IPin;
  4307. enum : IEnumPins;
  4308. ColorKey : TColorKey;
  4309. dwColorKey : DWord;
  4310. MPC : IMixerPinConfig;
  4311. begin
  4312. if not GraphBuildOK then Exit;
  4313. try
  4314. ColorKey.KeyType := CK_INDEX or CK_RGB;
  4315. ColorKey.PaletteIndex := 0;
  4316. ColorKey.LowColorValue := $000F000F;
  4317. ColorKey.HighColorValue := $000F000F;
  4318. FVideoWindowHandle := findWindowEx(Parent.handle, 0, 'VideoRenderer', pchar(name));
  4319. if FVideoWindowHandle = 0 then
  4320. FVideoWindowHandle := findWindowEx(0, 0, 'VideoRenderer', pchar(name));
  4321. if FVideoWindowHandle = 0 then Exit;
  4322. SetWindowPos(FVideoWindowHandle, Handle, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE or SWP_NOCOPYBITS or SWP_NOACTIVATE);
  4323. if (FVideoWindowHandle <> 0) then
  4324. begin
  4325. FOverlayMixer.EnumPins(Enum);
  4326. Enum.Next(1, Input, nil);
  4327. if Succeeded(Input.QueryInterface(IID_IMixerPinConfig2, MPC)) then
  4328. begin
  4329. MPC.GetColorKey(ColorKey, dwColorKey);
  4330. FColorKey := ColorKey.HighColorValue;
  4331. if Assigned(FOnColorKey) then
  4332. FOnColorKey(Self);
  4333. end;
  4334. end;
  4335. finally
  4336. Input := nil;
  4337. Enum := nil;
  4338. MPC := nil;
  4339. end;
  4340. end;
  4341. function TDSVideoWindowEx2.QueryInterface(const IID: TGUID; out Obj): HResult;
  4342. begin
  4343. result := inherited QueryInterface(IID, Obj);
  4344. if failed(result) and assigned(FBaseFilter) then
  4345. result := FBaseFilter.QueryInterface(IID, Obj);
  4346. end;
  4347. function TDSVideoWindowEx2.UpdateGraph : HResult;
  4348. Type
  4349. TConnectAction = (caConnect, caDisConnect);
  4350. PConnection = ^TConnection;
  4351. TConnection = record
  4352. FromPin : IPin;
  4353. ToPin : IPin;
  4354. Action : TConnectAction;
  4355. end;
  4356. var
  4357. FilterList : TFilterList;
  4358. VMRPinList : TPinList;
  4359. OVMPinList : TPinList;
  4360. TmpPinList : TPinList;
  4361. OrigConnections : TList;
  4362. TmpVMRPinList : TPinList;
  4363. Connection : pConnection;
  4364. i, a: integer;
  4365. GUID: TGUID;
  4366. pGB : IGraphBuilder;
  4367. VRInputPin,
  4368. VRConnectedToPin : IPin;
  4369. OVMInputPin : IPin;
  4370. OVMOutputPin : IPIN;
  4371. Pin : IPin;
  4372. pEnumPins : IEnumPins;
  4373. ul : cardinal;
  4374. pd : TPinDirection;
  4375. PinInfo : TPinInfo;
  4376. Hr : HResult;
  4377. VMR : IBaseFilter;
  4378. Line21Dec,
  4379. Line21Dec2 : IBaseFilter;
  4380. OVMInConected : Boolean;
  4381. OVMOutConected : Boolean;
  4382. Found : Boolean;
  4383. label
  4384. FailedSoReconnect, Cleanup, SetDrawExclMode;
  4385. begin
  4386. // Check if we are using Overlay.
  4387. FOverlayMixer := nil;
  4388. FVideoRenderer := nil;
  4389. VMR := nil;
  4390. Line21Dec := nil;
  4391. Line21Dec2 := nil;
  4392. GraphWasUpdatet := True;
  4393. OrigConnections := TList.Create;
  4394. FilterList:= TFilterList.Create(FilterGraph.FFilterGraph);
  4395. if FilterList.Count > 0 then
  4396. for i := 0 to FilterList.Count - 1 do
  4397. begin
  4398. FilterList.Items[i].GetClassID(GUID);
  4399. if ISEqualGUID(GUID, CLSID_OverlayMixer) then
  4400. FOverlayMixer := FilterList.Items[i];
  4401. if ISEqualGUID(GUID, CLSID_VideoMixingRenderer) then
  4402. VMR := FilterList.Items[i];
  4403. if ISEqualGUID(GUID, CLSID_VideoRenderer) then
  4404. FVideoRenderer := FilterList.Items[i];
  4405. end;
  4406. // The Graph holds no overlay mixer filter, Let's add one.
  4407. Result := FFilterGraph.QueryInterface(IID_IGraphBuilder, pGB);
  4408. if Failed(Result) then
  4409. begin
  4410. Goto Cleanup;
  4411. end;
  4412. if FOverlayMixer <> nil then
  4413. begin
  4414. // Check if The Overlay Mixer that already exists is connected
  4415. // correct to out VideoWindow
  4416. OVMInConected := False;
  4417. OVMOutConected := False;
  4418. OVMPinList := TPinList.Create(FOverlayMixer);
  4419. for i := 0 To OVMPinList.Count -1 do
  4420. begin
  4421. OVMPinList.Items[i].QueryDirection(pd);
  4422. if pd = PINDIR_OUTPUT then
  4423. begin
  4424. if Succeeded(OVMPinlist.Items[i].ConnectedTo(Pin)) then
  4425. begin
  4426. Pin.QueryPinInfo(PinInfo);
  4427. if PinInfo.pFilter = FVideoRenderer then
  4428. OVMOutConected := True;
  4429. end;
  4430. end
  4431. else
  4432. begin
  4433. if Succeeded(OVMPinlist.Items[i].ConnectedTo(Pin)) then
  4434. OVMInConected := True;
  4435. end;
  4436. end;
  4437. if (not OVMOutConected) or (not OVMInConected) then
  4438. begin
  4439. Result := E_FAIL;
  4440. Goto Cleanup;
  4441. end
  4442. else
  4443. begin
  4444. // Everything looks okay stop here.
  4445. OVMPinList.Free;
  4446. Goto SetDrawExclMode;
  4447. end;
  4448. end;
  4449. Result := CoCreateInstance(CLSID_OverlayMixer, nil, CLSCTX_INPROC, IID_IBaseFilter, FOverlayMixer);
  4450. if Failed(Result) then goto Cleanup;
  4451. Result := pGB.AddFilter(fOverlayMixer, 'Overlay Mixer');
  4452. if Failed(Result) then goto Cleanup;
  4453. if FVideoRenderer = nil then
  4454. begin
  4455. Result := E_Fail;
  4456. Goto Cleanup;
  4457. end;
  4458. Result := FVideoRenderer.EnumPins(pEnumPins);
  4459. if Failed(Result) then goto Cleanup;
  4460. Result := pEnumPins.Next(1, VRInputPin, @ul);
  4461. if Failed(Result) then goto Cleanup;
  4462. Result := VRInputPin.QueryDirection(pd);
  4463. if (Failed(Result)) or (PD <> PINDIR_INPUT) then goto Cleanup;
  4464. if VMR <> nil then
  4465. begin
  4466. // The Graph Uses the new VideoMixerRenderer let's try to connect
  4467. // all filter connected to the VideoMixerRenderer to the Overlay
  4468. // Mixer filter instead.
  4469. VMRPinList := TPinList.Create(VMR);
  4470. OVMPinList := TPinList.Create(FOverlayMixer);
  4471. TmpVMRPinList := TPinList.Create;
  4472. I := 0;
  4473. while (i < VMRPinList.Count) and (Succeeded(VMRPinList.Items[i].ConnectedTo(Pin))) do
  4474. begin
  4475. // Let's find the first Input Pin on the overlay mixer not
  4476. // connected to anything.
  4477. Result := Pin.Disconnect;
  4478. if Failed(Result) then goto FailedSoReconnect;
  4479. Result := VMRPinList.Items[i].Disconnect;
  4480. if Failed(Result) then goto FailedSoReconnect;
  4481. New(Connection);
  4482. Connection^.FromPin := VMRPinList.Items[i];
  4483. Connection^.ToPin := Pin;
  4484. Connection^.Action := caDisconnect;
  4485. OrigConnections.Add(Connection);
  4486. TmpVMRPinList.Add(Pin);
  4487. VMRPinList.Update;
  4488. Inc(i);
  4489. end;
  4490. i := 0;
  4491. Repeat
  4492. Pin := TmpVMRPinList[i];
  4493. a := 0;
  4494. Found := False;
  4495. Repeat
  4496. OVMPinList.Items[a].QueryDirection(pd);
  4497. if pd = PINDIR_INPUT then
  4498. begin
  4499. OVMInputPin := OVMPinList.Items[a];
  4500. if Failed(OVMPinList.Items[a].ConnectedTo(OVMOutputPin)) then
  4501. begin
  4502. Found := True;
  4503. end;
  4504. end;
  4505. OVMPinList.Update;
  4506. inc(a);
  4507. until (a >= OVMPinList.count) or (Found);
  4508. if not Found then
  4509. begin
  4510. VMRPinList.Free;
  4511. OVMPinList.Free;
  4512. Result := E_Fail;
  4513. goto FailedSoReconnect;
  4514. end;
  4515. // Before connecting we need to check if the filter we ar working on is a Line21 Decoder2
  4516. // And the exchange it with a Line21 Decoder because The Overlay Mixer Filter cannot connect
  4517. // with a Line21 Decoder2
  4518. Pin.QueryPinInfo(PinInfo);
  4519. PinInfo.pFilter.GetClassID(GUID);
  4520. if ISEqualGUID(GUID, CLSID_Line21Decoder2) then
  4521. begin
  4522. Line21Dec2 := PinInfo.pFilter;
  4523. TmpPinList := TPinList.Create(Line21Dec2);
  4524. Result := TmpPinList.Items[0].ConnectedTo(Pin);
  4525. if Failed(Result) then goto FailedSoReconnect;
  4526. Result := TmpPinList.Items[0].Disconnect;
  4527. if Failed(Result) then goto FailedSoReconnect;
  4528. Result := Pin.Disconnect;
  4529. if Failed(Result) then goto FailedSoReconnect;
  4530. New(Connection);
  4531. Connection^.FromPin := Pin;
  4532. Connection^.ToPin := TmpPinList.Items[0];
  4533. Connection^.Action := caDisconnect;
  4534. OrigConnections.Add(Connection);
  4535. TmpPinList.Free;
  4536. Result := CoCreateInstance(CLSID_Line21Decoder, nil, CLSCTX_INPROC, IID_IBaseFilter, Line21Dec);
  4537. if Failed(Result) then goto Cleanup;
  4538. Result := FilterGraph.FFilterGraph.AddFilter(Line21Dec, 'Line21 Decoder');
  4539. if Failed(Result) then goto Cleanup;
  4540. TmpPinList := TPinList.Create(Line21Dec);
  4541. Result := FilterGraph.FFilterGraph.Connect(Pin, TmpPinList.Items[0]);
  4542. if Failed(Result) then goto Cleanup;
  4543. New(Connection);
  4544. Connection^.FromPin := Pin;
  4545. Connection^.ToPin := TmpPinList.Items[0];
  4546. Connection^.Action := caConnect;
  4547. OrigConnections.Add(Connection);
  4548. Pin := TmpPinList.Items[1];
  4549. TmpPinList.Free;
  4550. Result := pGB.Connect(Pin, OVMInputPin);
  4551. if Failed(Result) then
  4552. begin
  4553. VMRPinList.Free;
  4554. OVMPinList.Free;
  4555. Goto Failedsoreconnect;
  4556. end;
  4557. New(Connection);
  4558. Connection^.FromPin := Pin;
  4559. Connection^.ToPin := OVMInputPin;
  4560. Connection^.Action := caConnect;
  4561. OrigConnections.Add(Connection);
  4562. end
  4563. else
  4564. begin
  4565. Result := pGB.Connect(Pin, OVMInputPin);
  4566. if Failed(Result) then
  4567. begin
  4568. VMRPinList.Free;
  4569. OVMPinList.Free;
  4570. Goto Failedsoreconnect;
  4571. end;
  4572. New(Connection);
  4573. Connection^.FromPin := Pin;
  4574. Connection^.ToPin := OVMInputPin;
  4575. Connection^.Action := caConnect;
  4576. OrigConnections.Add(Connection);
  4577. end;
  4578. OVMPinList.Update;
  4579. inc(i);
  4580. until I >= TmpVMRPinList.Count;
  4581. VMRPinList.Free;
  4582. OVMPinList.Free;
  4583. TmpVMRPinList.Free;
  4584. end
  4585. else
  4586. begin
  4587. Result := VRInputPin.ConnectedTo(VRConnectedToPin);
  4588. if Failed(Result) then goto FailedSoReconnect;
  4589. Result := VRInputPin.Disconnect;
  4590. if Failed(Result) then goto FailedSoReconnect;
  4591. Result := VRConnectedToPin.Disconnect;
  4592. if Failed(Result) then goto FailedSoReconnect;
  4593. New(Connection);
  4594. Connection^.FromPin := VRInputPin;
  4595. Connection^.ToPin := VRConnectedToPin;
  4596. Connection^.Action := caDisconnect;
  4597. OrigConnections.Add(Connection);
  4598. OVMPinList := TPinList.Create(FOverlayMixer);
  4599. a := 0;
  4600. Found := False;
  4601. Repeat
  4602. OVMPinList.Items[a].QueryDirection(pd);
  4603. if pd = PINDIR_INPUT then
  4604. begin
  4605. OVMInputPin := OVMPinList.Items[a];
  4606. if Failed(OVMPinList.Items[a].ConnectedTo(Pin)) then
  4607. Found := True;
  4608. end;
  4609. inc(a);
  4610. until (a >= OVMPinList.count) or (Found);
  4611. if not Found then
  4612. begin
  4613. OVMPinList.Free;
  4614. Result := E_Fail;
  4615. Goto Cleanup;
  4616. end;
  4617. result := pGB.Connect(VRConnectedToPin, OVMInputPin);
  4618. if Failed(Result) then
  4619. begin
  4620. OVMPinList.Free;
  4621. Goto FailedSoReconnect;
  4622. end;
  4623. New(Connection);
  4624. Connection^.FromPin := VRConnectedToPin;
  4625. Connection^.ToPin := OVMInputPin;
  4626. Connection^.Action := caConnect;
  4627. OrigConnections.Add(Connection);
  4628. OVMPinList.Free;
  4629. end;
  4630. Result := FOverlayMixer.FindPin('Output', OVMOutputPin);
  4631. if Failed(Result) then goto FailedSoReconnect;
  4632. Result := pGB.Connect(OVMOutputPin, VRInputPin);
  4633. if Failed(Result) then goto FailedSoReconnect;
  4634. New(Connection);
  4635. Connection^.FromPin := OVMOutputPin;
  4636. Connection^.ToPin := VRInputPin;
  4637. Connection^.Action := caConnect;
  4638. OrigConnections.Add(Connection);
  4639. SetDrawExclMode:
  4640. Result := FOverlayMixer.QueryInterface(IID_IDDrawExclModeVideo, FDDXM);
  4641. if Failed(Result) then goto FailedSoReconnect;
  4642. OverlayCallback := TOverlayCallback.Create(Self);
  4643. Result := FDDXM.SetCallbackInterface(OverlayCallBack, 0);
  4644. if Failed(Result) then goto FailedSoReconnect;
  4645. if Line21Dec2 <> nil then
  4646. filtergraph.FFilterGraph.RemoveFilter(Line21Dec2);
  4647. if VMR <> nil then
  4648. filtergraph.FFilterGraph.RemoveFilter(VMR);
  4649. Goto Cleanup;
  4650. FailedSoReconnect:
  4651. for i := OrigConnections.Count -1 downto 0 do
  4652. begin
  4653. Connection := OrigConnections[i];
  4654. Case Connection^.Action of
  4655. caConnect : begin
  4656. Connection^.FromPin.Disconnect;
  4657. Connection^.ToPin.Disconnect;
  4658. end;
  4659. caDisconnect : begin
  4660. pGB.Connect(Connection^.FromPin, Connection^.ToPin);
  4661. end;
  4662. end;
  4663. end;
  4664. if Line21Dec <> nil then
  4665. FilterGraph.FFilterGraph.RemoveFilter(Line21Dec);
  4666. Hr := pGB.RemoveFilter(FOverlayMixer);
  4667. if Failed(Hr) then
  4668. begin
  4669. Result := Hr;
  4670. Goto CleanUp;
  4671. end;
  4672. FOverlayMixer := nil;
  4673. if VMR <> nil then
  4674. begin
  4675. pGB.RemoveFilter((FVideoWindow as IBaseFilter));
  4676. FVideoWindow := nil;
  4677. FVideoRenderer := VMR;
  4678. FVideoWindow := (VMR as IVIdeoWindow);
  4679. end;
  4680. Cleanup:
  4681. for i := 0 to OrigConnections.Count -1 do
  4682. begin
  4683. Connection := OrigConnections[i];
  4684. Connection^.FromPin := nil;
  4685. Connection^.ToPin := nil;
  4686. end;
  4687. VMR := nil;
  4688. pEnumPins := nil;
  4689. OVMInputpin := nil;
  4690. OVMOutputPin := nil;
  4691. VRInputPin := nil;
  4692. VRConnectedToPin := nil;
  4693. Line21Dec := nil;
  4694. Line21Dec2 := nil;
  4695. OrigConnections.Free;
  4696. FilterList.Free;
  4697. end;
  4698. procedure TDSVideoWindowEx2.WndProc(var Message: TMessage);
  4699. begin
  4700. if (csDesigning in ComponentState) then
  4701. begin
  4702. inherited WndProc(Message);
  4703. Exit;
  4704. end;
  4705. if ((Message.Msg = WM_CONTEXTMENU) and FullScreen) then
  4706. begin
  4707. if assigned(PopupMenu) then
  4708. if PopupMenu.AutoPopup then
  4709. begin
  4710. PopupMenu.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
  4711. Message.Result := 1;
  4712. end;
  4713. inherited WndProc(Message);
  4714. Exit;
  4715. end;
  4716. if (Message.Msg = WM_ERASEBKGND) and (GraphBuildOk) then
  4717. begin
  4718. Message.Result := -1;
  4719. Exit;
  4720. end;
  4721. if FNoScreenSaver then
  4722. if (Message.Msg = SC_SCREENSAVE) or (Message.Msg = SC_MONITORPOWER) then
  4723. begin
  4724. Message.Result := 0;
  4725. Exit;
  4726. end;
  4727. inherited WndProc(Message);
  4728. end;
  4729. procedure TDSVideoWindowEx2.ClearBack;
  4730. var
  4731. DC, MemDC: HDC;
  4732. MemBitmap, OldBitmap: HBITMAP;
  4733. BackBrush, OverlayBrush : HBrush;
  4734. begin
  4735. BackBrush := 0;
  4736. OverlayBrush := 0;
  4737. if (csDestroying in componentstate) then exit;
  4738. DC := GetDC(0);
  4739. MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
  4740. ReleaseDC(0, DC);
  4741. MemDC := CreateCompatibleDC(0);
  4742. OldBitmap := SelectObject(MemDC, MemBitmap);
  4743. try
  4744. DC := GetDC(Handle);
  4745. BackBrush := CreateSolidBrush(Color);
  4746. FillRect(MemDC, Rect(0,0, ClientRect.Right, ClientRect.Bottom), BackBrush);
  4747. if not (csDesigning in ComponentState) then
  4748. begin
  4749. if Succeeded(GetVideoInfo) and (FOverlayVisible) then
  4750. begin
  4751. OverlayBrush := CreateSolidBrush(FColorKey);
  4752. FillRect(MemDC, FVideoRect, OverlayBrush);
  4753. end;
  4754. end;
  4755. BitBlt(DC, 0, 0, Self.ClientRect.Right, Self.ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
  4756. finally
  4757. SelectObject(MemDC, OldBitmap);
  4758. DeleteDC(MemDC);
  4759. DeleteObject(MemBitmap);
  4760. DeleteObject(BackBrush);
  4761. DeleteObject(OverlayBrush);
  4762. ReleaseDC(Handle, DC);
  4763. end;
  4764. if Assigned(FOnPaint) then FOnPaint(self);
  4765. end;
  4766. procedure TDSVideoWindowEx2.Paint;
  4767. begin
  4768. inherited Paint;
  4769. clearback;
  4770. end;
  4771. function TDSVideoWindowEx2.GetVideoInfo : HResult;
  4772. Var
  4773. BasicVideo : IBasicVideo2;
  4774. AspX, AspY : DWord;
  4775. VideoWidth, VideoHeight : DWord;
  4776. begin
  4777. Result := E_Fail;
  4778. if (FVideoWindow = nil) or (FBaseFilter = nil) or (FDDXM = nil) or
  4779. (FVideoRenderer = nil) or (FOverlayMixer = nil) then Exit;
  4780. try
  4781. if FAspectMode = rmLetterbox then
  4782. begin
  4783. FDDXM.GetNativeVideoProps(VideoWidth, VideoHeight, AspX, AspY);
  4784. FVideoRect := StretchRect(ClientRect, Rect(0,0, AspX, AspY));
  4785. end
  4786. else
  4787. FVideoRect := ClientRect;
  4788. Result := S_OK;
  4789. finally
  4790. BasicVideo := nil;
  4791. end;
  4792. end;
  4793. Procedure TDSVideoWindowEx2.StartDesktopPlayback;
  4794. type
  4795. TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary);
  4796. const
  4797. MonitorDefaultFlags: array[TMonitorDefaultTo] of DWORD = (MONITOR_DEFAULTTONEAREST,
  4798. MONITOR_DEFAULTTONULL,
  4799. MONITOR_DEFAULTTOPRIMARY);
  4800. function FindMonitor(Handle: HMONITOR): TMonitor;
  4801. var
  4802. I: Integer;
  4803. begin
  4804. Result := nil;
  4805. for I := 0 to Screen.MonitorCount - 1 do
  4806. if HMonitor(Screen.Monitors[I].Handle) = HMonitor(Handle) then
  4807. begin
  4808. Result := Screen.Monitors[I];
  4809. break;
  4810. end;
  4811. end;
  4812. function MonitorFromWindow(const Handle: THandle;
  4813. MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
  4814. begin
  4815. Result := FindMonitor(MultiMon.MonitorFromWindow(Handle,
  4816. MonitorDefaultFlags[MonitorDefault]));
  4817. end;
  4818. begin
  4819. StartDesktopPlayback(MonitorfromWindow(Self.Handle));
  4820. end;
  4821. procedure TDSVideoWindowEx2.StartDesktopPlayBack(OnMonitor : TMonitor);
  4822. procedure SetWallpaper(sWallpaperBMPPath : String);
  4823. var
  4824. reg : TRegistry;
  4825. begin
  4826. reg := TRegistry.Create;
  4827. with reg do
  4828. begin
  4829. RootKey := HKEY_CURRENT_USER;
  4830. if KeyExists('\Control Panel\Desktop') then
  4831. if OpenKey('\Control Panel\Desktop', False) then
  4832. begin
  4833. if ValueExists('WallPaper') then
  4834. WriteString('WallPaper', sWallpaperBMPPath);
  4835. end;
  4836. end;
  4837. reg.Free;
  4838. SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE );
  4839. end;
  4840. function GetWallpaper : String;
  4841. var
  4842. reg : TRegistry;
  4843. begin
  4844. Result := '';
  4845. reg := TRegistry.Create;
  4846. with reg do
  4847. begin
  4848. RootKey := HKEY_CURRENT_USER;
  4849. if KeyExists('\Control Panel\Desktop') then
  4850. if OpenKey('\Control Panel\Desktop', False) then
  4851. begin
  4852. if ValueExists('WallPaper') then
  4853. Result := ReadString('Wallpaper');
  4854. end;
  4855. end;
  4856. reg.Free;
  4857. end;
  4858. var
  4859. ColorIndex : Integer;
  4860. Color : Longint;
  4861. begin
  4862. if DesktopPlayback then Exit;
  4863. FMonitor := OnMonitor;
  4864. OldDesktopPic := GetWallpaper;
  4865. ColorIndex:=COLOR_DESKTOP;
  4866. OldDesktopColor := GetSysColor(ColorIndex);
  4867. SetWallPaper('');
  4868. Color := ColorTorgb(FColorKey);
  4869. SetSysColors(1, ColorIndex, Color);
  4870. if FullScreen then
  4871. NormalPlayback;
  4872. FOldParent := Parent;
  4873. Parent := FFullScreenControl;
  4874. FFullScreenControl.BoundsRect := rect(OnMonitor.Left,
  4875. OnMonitor.Top,
  4876. OnMonitor.Left + OnMonitor.Width,
  4877. OnMonitor.Top + OnMonitor.Height);
  4878. FFullScreenControl.Show;
  4879. FDesktopPlay := True;
  4880. RefreshVideoWindow;
  4881. if GraphBuildOk then SetVideoZOrder;
  4882. FFullScreenControl.Hide;
  4883. FOverlayVisible := False;
  4884. ClearBack;
  4885. if Assigned(FOnOverlay) then
  4886. FOnOverlay(Self, False);
  4887. end;
  4888. procedure TDSVideoWindowEx2.NormalPlayback;
  4889. procedure SetWallpaper(sWallpaperBMPPath : String);
  4890. var
  4891. reg : TRegistry;
  4892. begin
  4893. reg := TRegistry.Create;
  4894. with reg do
  4895. begin
  4896. RootKey := HKEY_CURRENT_USER;
  4897. if KeyExists('\Control Panel\Desktop') then
  4898. if OpenKey('\Control Panel\Desktop', False) then
  4899. begin
  4900. if ValueExists('WallPaper') then
  4901. WriteString('WallPaper', sWallpaperBMPPath);
  4902. end;
  4903. end;
  4904. reg.Free;
  4905. SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE );
  4906. end;
  4907. var
  4908. ColorIndex : Integer;
  4909. begin
  4910. if DesktopPlayback then
  4911. begin
  4912. ColorIndex := COLOR_DESKTOP;
  4913. SetWallPaper(OldDesktopPic);
  4914. SetSysColors(1, ColorIndex, OldDesktopColor);
  4915. FDesktopPlay := False;
  4916. if (csDestroying in componentstate) then exit;
  4917. end;
  4918. if FoldParent <> nil then
  4919. Parent := FOldParent;
  4920. if FullScreen then
  4921. begin
  4922. FFullScreenControl.Hide;
  4923. FFullScreenControl.Invalidate;
  4924. FFullScreen := False;
  4925. end;
  4926. RefreshVideoWindow;
  4927. if GraphBuildOk then SetVideoZOrder;
  4928. FOverlayVisible := True;
  4929. ClearBack;
  4930. if Assigned(FOnOverlay) then
  4931. FOnOverlay(Self, True);
  4932. FMonitor := nil;
  4933. end;
  4934. procedure TDSVideoWindowEx2.StartFullScreen;
  4935. type
  4936. TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary);
  4937. const
  4938. MonitorDefaultFlags: array[TMonitorDefaultTo] of DWORD = (MONITOR_DEFAULTTONEAREST,
  4939. MONITOR_DEFAULTTONULL,
  4940. MONITOR_DEFAULTTOPRIMARY);
  4941. function FindMonitor(Handle: HMONITOR): TMonitor;
  4942. var
  4943. I: Integer;
  4944. begin
  4945. Result := nil;
  4946. for I := 0 to Screen.MonitorCount - 1 do
  4947. if HMonitor(Screen.Monitors[I].Handle) = HMonitor(Handle) then
  4948. begin
  4949. Result := Screen.Monitors[I];
  4950. break;
  4951. end;
  4952. end;
  4953. function MonitorFromWindow(const Handle: THandle;
  4954. MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
  4955. begin
  4956. Result := FindMonitor(MultiMon.MonitorFromWindow(Handle,
  4957. MonitorDefaultFlags[MonitorDefault]));
  4958. end;
  4959. begin
  4960. StartFullScreen(MonitorfromWindow(Self.Handle));
  4961. end;
  4962. procedure TDSVideoWindowEx2.StartFullScreen(OnMonitor : TMonitor);
  4963. begin
  4964. if FFullscreen then Exit;
  4965. if DesktopPlayback then
  4966. NormalPlayback;
  4967. FMonitor := OnMonitor;
  4968. FOldParent := Parent;
  4969. Parent := FFullScreenControl;
  4970. FFullScreenControl.BoundsRect := rect(OnMonitor.Left,
  4971. OnMonitor.Top,
  4972. OnMonitor.Left + OnMonitor.Width,
  4973. OnMonitor.Top + OnMonitor.Height);
  4974. if FTopMost then
  4975. FFullScreenControl.FormStyle := fsStayOnTop
  4976. Else
  4977. FFullScreenControl.FormStyle := fsNormal;
  4978. FFullScreenControl.Show;
  4979. FFullScreen := True;
  4980. RefreshVideoWindow;
  4981. if GraphBuildOk then SetVideoZOrder;
  4982. end;
  4983. procedure TDSVideoWindowEx2.FullScreenCloseQuery(Sender: TObject; var CanClose: Boolean);
  4984. begin
  4985. if csDestroying in componentstate then
  4986. begin
  4987. NormalPlayback;
  4988. CanClose := True;
  4989. end
  4990. else
  4991. CanClose := False;
  4992. end;
  4993. procedure TDSVideoWindowEx2.SetZoom(Value : Integer);
  4994. var
  4995. Ratio : Real;
  4996. TmpX, TmpY : Real;
  4997. TmpLeft, TmpTop : Real;
  4998. BasicVideo2 : IBasicVideo2;
  4999. SLeft, STop, SWidth, SHeight : Integer;
  5000. begin
  5001. // Set DigitalZoom
  5002. if (Value < 0) or (Value > 99) then
  5003. begin
  5004. raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 99', [Value]);
  5005. Exit;
  5006. end;
  5007. if (csDesigning in ComponentState) or (FVideoRenderer = nil) then
  5008. begin
  5009. FZoom := Value;
  5010. Exit;
  5011. end;
  5012. BasicVideo2 := nil;
  5013. try
  5014. if (FVideoRenderer.QueryInterface(IID_IBasicVideo2, BasicVideo2) = S_OK) then
  5015. begin
  5016. BasicVideo2.SetDefaultSourcePosition;
  5017. BasicVideo2.get_SourceLeft(SLeft);
  5018. BasicVideo2.get_SourceTop(STop);
  5019. BasicVideo2.get_SourceWidth(SWidth);
  5020. BasicVideo2.get_SourceHeight(SHeight);
  5021. Ratio := SHeight / SWidth;
  5022. TmpX := SWidth - ((Value * Swidth) / 100);
  5023. TmpY := TmpX * Ratio;
  5024. TmpLeft := (SWidth - TmpX) / 2;
  5025. TmpTop := (SHeight - TmpY) / 2;
  5026. BasicVideo2.put_SourceWidth(Trunc(TmpX));
  5027. BasicVideo2.put_SourceHeight(Trunc(TmpY));
  5028. BasicVideo2.put_SourceLeft(Trunc(TmpLeft));
  5029. BasicVideo2.put_SourceTop(Trunc(TmpTop));
  5030. end;
  5031. FZoom := Value;
  5032. finally
  5033. BasicVideo2 := nil;
  5034. end;
  5035. end;
  5036. procedure TDSVideoWindowEx2.SetAspectMode(Value : TRatioModes);
  5037. var
  5038. input : IPin;
  5039. enum : IEnumPins;
  5040. pMPC : IMixerPinConfig2;
  5041. begin
  5042. if (csDesigning in ComponentState) or (FVideoRenderer = nil) or (FOverlayMixer = nil) then
  5043. begin
  5044. FAspectMode := Value;
  5045. Exit;
  5046. end;
  5047. try
  5048. FOverlayMixer.EnumPins(Enum);
  5049. Enum.Next(1, Input, nil);
  5050. if Succeeded(Input.QueryInterface(IID_IMixerPinConfig2, pMPC)) then
  5051. if Succeeded(pMPC.SetAspectRatioMode(TAMAspectRatioMode(integer(Value)))) then
  5052. FAspectMode := Value;
  5053. finally
  5054. input := nil;
  5055. enum := nil;
  5056. pMPC := nil;
  5057. end;
  5058. if (GraphBuildOk) and (not FDesktopPlay) then Clearback;
  5059. end;
  5060. procedure TDSVideoWindowEx2.MouseDown(Button: TMouseButton;
  5061. Shift: TShiftState; X, Y: Integer);
  5062. Var
  5063. MPos : TPoint;
  5064. begin
  5065. if Ffullscreen then
  5066. MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y)
  5067. else
  5068. MPos := Point(X, Y);
  5069. if FVideoWindow <> nil then
  5070. begin
  5071. if GraphBuildOK then
  5072. begin
  5073. if Self.Cursor = crnone then
  5074. begin
  5075. Self.Cursor := RememberCursor;
  5076. LMousePos.X := MPos.X;
  5077. LMousePos.Y := MPos.Y;
  5078. LCursorMov := GetTickCount;
  5079. if Assigned(FOnCursorVisible) then
  5080. FOnCursorVisible(Self, True);
  5081. end;
  5082. end
  5083. else
  5084. begin
  5085. FVideoWindow.IsCursorHidden(IsHidden);
  5086. if IsHidden then
  5087. begin
  5088. FVideoWindow.HideCursor(False);
  5089. LMousePos.X := MPos.X;
  5090. LMousePos.Y := MPos.Y;
  5091. LCursorMov := GetTickCount;
  5092. IsHidden := False;
  5093. if Assigned(FOnCursorVisible) then
  5094. FOnCursorVisible(Self, True);
  5095. end;
  5096. end;
  5097. end;
  5098. inherited MouseDown(Button, Shift, MPos.X, MPos.Y);
  5099. end;
  5100. procedure TDSVideoWindowEx2.MouseMove(Shift: TShiftState; X, Y: Integer);
  5101. var
  5102. MPos : TPoint;
  5103. begin
  5104. if Ffullscreen then
  5105. MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y)
  5106. else
  5107. MPos := Point(X, Y);
  5108. if (LMousePos.X <> MPos.X) or (LMousePos.Y <> MPos.Y) then
  5109. begin
  5110. LMousePos.X := MPos.X;
  5111. LMousePos.Y := MPos.Y;
  5112. LCursorMov := GetTickCount;
  5113. if FVideoWindow <> nil then
  5114. begin
  5115. if GraphBuildOk then
  5116. begin
  5117. if Self.Cursor = crnone then
  5118. begin
  5119. Self.Cursor := RememberCursor;
  5120. if Assigned(FOnCursorVisible) then
  5121. FOnCursorVisible(Self, True);
  5122. end;
  5123. end
  5124. else
  5125. begin
  5126. FVideoWindow.IsCursorHidden(IsHidden);
  5127. if IsHidden then
  5128. begin
  5129. FVideoWindow.HideCursor(False);
  5130. IsHidden := False;
  5131. if Assigned(FOnCursorVisible) then
  5132. FOnCursorVisible(Self, True);
  5133. end;
  5134. end;
  5135. end;
  5136. end;
  5137. inherited MouseMove(Shift, MPos.X, MPos.Y);
  5138. end;
  5139. procedure TDSVideoWindowEx2.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  5140. var
  5141. MPos : TPoint;
  5142. begin
  5143. if Ffullscreen then
  5144. MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y)
  5145. else
  5146. MPos := Point(X, Y);
  5147. if FVideoWindow <> nil then
  5148. begin
  5149. if GraphBuildOK then
  5150. begin
  5151. if Self.Cursor = crnone then
  5152. begin
  5153. Self.Cursor := RememberCursor;
  5154. LMousePos.X := MPos.X;
  5155. LMousePos.Y := MPos.Y;
  5156. LCursorMov := GetTickCount;
  5157. if Assigned(FOnCursorVisible) then
  5158. FOnCursorVisible(Self, True);
  5159. end;
  5160. end
  5161. else
  5162. begin
  5163. FVideoWindow.IsCursorHidden(IsHidden);
  5164. if IsHidden then
  5165. begin
  5166. FVideoWindow.HideCursor(False);
  5167. LMousePos.X := MPos.X;
  5168. LMousePos.Y := MPos.Y;
  5169. LCursorMov := GetTickCount;
  5170. IsHidden := False;
  5171. if Assigned(FOnCursorVisible) then
  5172. FOnCursorVisible(Self, True);
  5173. end;
  5174. end;
  5175. end;
  5176. inherited MouseUp(Button, Shift, MPos.X, MPos.Y);
  5177. end;
  5178. procedure TDSVideoWindowEx2.MyIdleHandler(Sender: TObject; var Done: Boolean);
  5179. var
  5180. pt : TPoint;
  5181. begin
  5182. Done := True;
  5183. if (FIdleCursor = 0) or (csDesigning in ComponentState) then exit;
  5184. if (GetTickCount - LCursorMov >= Cardinal(FIdleCursor)) and (FVideoWindow <> nil) then
  5185. begin
  5186. if GraphBuildOK then
  5187. begin
  5188. if Self.Cursor <> crNone then
  5189. begin
  5190. RememberCursor := Self.Cursor;
  5191. Self.Cursor := crNone;
  5192. GetCursorPos(pt);
  5193. SetCursorPos(pt.x, pt.y);
  5194. if Assigned(FOnCursorVisible) then
  5195. FOnCursorVisible(Self, False);
  5196. end;
  5197. end
  5198. else
  5199. begin
  5200. FVideoWindow.IsCursorHidden(IsHidden);
  5201. if not IsHidden then
  5202. begin
  5203. FVideoWindow.HideCursor(True);
  5204. IsHidden := True;
  5205. GetCursorPos(pt);
  5206. SetCursorPos(pt.x, pt.y);
  5207. if Assigned(FOnCursorVisible) then
  5208. FOnCursorVisible(Self, False);
  5209. end;
  5210. end;
  5211. end;
  5212. end;
  5213. { TVMRBitmap }
  5214. constructor TVMRBitmap.Create(VideoWindow: TVideoWindow);
  5215. begin
  5216. Assert(Assigned(VideoWindow),'No valid video Window.');
  5217. FCanvas := TCanvas.Create;
  5218. FVideoWindow := VideoWindow;
  5219. FillChar(FVMRALPHABITMAP, SizeOf(FVMRALPHABITMAP), 0);
  5220. Options := [];
  5221. FVMRALPHABITMAP.hdc := 0;
  5222. FVMRALPHABITMAP.fAlpha := 1;
  5223. end;
  5224. destructor TVMRBitmap.Destroy;
  5225. begin
  5226. ResetBitmap;
  5227. FCanvas.Free;
  5228. end;
  5229. procedure TVMRBitmap.Draw;
  5230. var VMRMixerBitmap: IVMRMixerBitmap9;
  5231. begin
  5232. if Succeeded(FVideoWindow.QueryInterface(IVMRMixerBitmap9, VMRMixerBitmap)) then
  5233. VMRMixerBitmap.SetAlphaBitmap(@FVMRALPHABITMAP);
  5234. end;
  5235. procedure TVMRBitmap.DrawTo(Left, Top, Right, Bottom, Alpha: Single; doUpdate: boolean = false);
  5236. begin
  5237. with FVMRALPHABITMAP do
  5238. begin
  5239. rDest.left := Left;
  5240. rDest.top := Top;
  5241. rDest.right := Right;
  5242. rDest.bottom := Bottom;
  5243. fAlpha := Alpha;
  5244. end;
  5245. if doUpdate then Update else Draw;
  5246. end;
  5247. function TVMRBitmap.GetAlpha: Single;
  5248. begin
  5249. result := FVMRALPHABITMAP.fAlpha;
  5250. end;
  5251. function TVMRBitmap.GetColorKey: COLORREF;
  5252. begin
  5253. Result := FVMRALPHABITMAP.clrSrcKey;
  5254. end;
  5255. function TVMRBitmap.GetDest: TVMR9NormalizedRect;
  5256. begin
  5257. Result := FVMRALPHABITMAP.rDest;
  5258. end;
  5259. function TVMRBitmap.GetDestBottom: Single;
  5260. begin
  5261. Result := FVMRALPHABITMAP.rDest.bottom;
  5262. end;
  5263. function TVMRBitmap.GetDestLeft: Single;
  5264. begin
  5265. Result := FVMRALPHABITMAP.rDest.Left;
  5266. end;
  5267. function TVMRBitmap.GetDestRight: Single;
  5268. begin
  5269. Result := FVMRALPHABITMAP.rDest.right
  5270. end;
  5271. function TVMRBitmap.GetDestTop: Single;
  5272. begin
  5273. Result := FVMRALPHABITMAP.rDest.top;
  5274. end;
  5275. function TVMRBitmap.GetSource: TRect;
  5276. begin
  5277. result := FVMRALPHABITMAP.rSrc;
  5278. end;
  5279. procedure TVMRBitmap.LoadBitmap(Bitmap: TBitmap);
  5280. var
  5281. TmpHDC, HdcBMP: HDC;
  5282. BMP: Windows.TBITMAP;
  5283. begin
  5284. Assert(Assigned(Bitmap),'Invalid Bitmap.');
  5285. ResetBitmap;
  5286. TmpHDC := GetDC(FVideoWindow.Handle);
  5287. if (TmpHDC = 0) then Exit;
  5288. HdcBMP := CreateCompatibleDC(TmpHDC);
  5289. ReleaseDC(FVideoWindow.Handle, TmpHDC);
  5290. if (HdcBMP = 0) then Exit;
  5291. if (0 = GetObject(Bitmap.Handle, sizeof(BMP), @BMP)) then exit;
  5292. FBMPOld := SelectObject(HdcBMP, Bitmap.Handle);
  5293. if (FBMPOld = 0) then Exit;
  5294. FVMRALPHABITMAP.hdc := HdcBMP;
  5295. FCanvas.Handle := HdcBMP;
  5296. end;
  5297. procedure TVMRBitmap.LoadEmptyBitmap(Width, Height: Integer;
  5298. PixelFormat: TPixelFormat; Color: TColor);
  5299. var Bitmap: TBitmap;
  5300. begin
  5301. Bitmap := TBitmap.Create;
  5302. try
  5303. Bitmap.Width := Width;
  5304. Bitmap.Height := Height;
  5305. Bitmap.PixelFormat := PixelFormat;
  5306. Bitmap.Canvas.Brush.Color := Color;
  5307. Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
  5308. LoadBitmap(Bitmap);
  5309. finally
  5310. Bitmap.Free;
  5311. end;
  5312. end;
  5313. procedure TVMRBitmap.ResetBitmap;
  5314. begin
  5315. FCanvas.Handle := 0;
  5316. if FVMRALPHABITMAP.hdc <> 0 then
  5317. begin
  5318. DeleteObject(SelectObject(FVMRALPHABITMAP.hdc, FBMPOld));
  5319. DeleteDC(FVMRALPHABITMAP.hdc);
  5320. FVMRALPHABITMAP.hdc := 0;
  5321. end;
  5322. end;
  5323. procedure TVMRBitmap.SetAlpha(const Value: Single);
  5324. begin
  5325. FVMRALPHABITMAP.fAlpha := Value;
  5326. end;
  5327. procedure TVMRBitmap.SetColorKey(const Value: COLORREF);
  5328. begin
  5329. FVMRALPHABITMAP.clrSrcKey := Value;
  5330. end;
  5331. procedure TVMRBitmap.SetDest(const Value: TVMR9NormalizedRect);
  5332. begin
  5333. FVMRALPHABITMAP.rDest := Value;
  5334. end;
  5335. procedure TVMRBitmap.SetDestBottom(const Value: Single);
  5336. begin
  5337. FVMRALPHABITMAP.rDest.bottom := Value;
  5338. end;
  5339. procedure TVMRBitmap.SetDestLeft(const Value: Single);
  5340. begin
  5341. FVMRALPHABITMAP.rDest.Left := Value;
  5342. end;
  5343. procedure TVMRBitmap.SetDestRight(const Value: Single);
  5344. begin
  5345. FVMRALPHABITMAP.rDest.right := Value;
  5346. end;
  5347. procedure TVMRBitmap.SetDestTop(const Value: Single);
  5348. begin
  5349. FVMRALPHABITMAP.rDest.top := Value;
  5350. end;
  5351. procedure TVMRBitmap.SetOptions(Options: TVMRBitmapOptions);
  5352. begin
  5353. FOptions := Options;
  5354. FVMRALPHABITMAP.dwFlags := VMR9AlphaBitmap_hDC;
  5355. if vmrbDisable in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_Disable;
  5356. if vmrbSrcColorKey in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_SrcColorKey;
  5357. if vmrbSrcRect in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_SrcRect;
  5358. end;
  5359. procedure TVMRBitmap.SetSource(const Value: TRect);
  5360. begin
  5361. FVMRALPHABITMAP.rSrc := Value;
  5362. end;
  5363. procedure TVMRBitmap.Update;
  5364. var VMRMixerBitmap: IVMRMixerBitmap9;
  5365. begin
  5366. if Succeeded(FVideoWindow.QueryInterface(IVMRMixerBitmap9, VMRMixerBitmap)) then
  5367. VMRMixerBitmap.UpdateAlphaBitmapParameters(@FVMRALPHABITMAP);
  5368. end;
  5369. end.