| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156 |
- unit TalkingFrm;
- interface
- uses
- IdBaseComponent, RealICQDBHistory, IdComponent, IdTCPConnection, IdTCPClient,
- IdHTTP, VideoTransmitter, MD5_32, AudioTransmitter, WinInet,
- PtoPFileTransmitter, PerlRegEx, TransmitDirection, FileTransmitterObjective,
- MD5, RealICQUtils, cvcode, ClipBrd, ShareUtils, DSUtil, DirectShow9,
- RealICQModel, MainFrm, GIFImage, pngimage, xFonts, MSHTML, DateUtils, Types,
- MyUtils, ShellAPI, RealICQSkinFrm, RealICQUIColor, RealICQColors,
- RealICQClient, RealICQContacterListView, Windows, Messages, SysUtils, Variants,
- Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ToolWin, ActnMan,
- ActnCtrls, ActnMenus, StdActns, ActnList, XPStyleActnCtrls, RealICQSpeedButton,
- ComCtrls, ImgList, StdCtrls, Buttons, RealICQButton, OleCtrls, SHDocVw,
- StdStyleActnCtrls, Menus, ActnPopup, RealICQRoundBorderPanel,
- RealICQNoBorderPageControl, jpeg, RealICQUserCard, RxRichEd, RealICQRichEdit,
- ExtDlgs, StrUtils, ActiveX, XMLDoc, XMLIntf, AppEvnts, RealICQTrackBar,
- RealICQMicrophoneVolumeControl, RealICQMasterVolumeControl,
- RealICQSingleImageButton, DSPack, ConfirmSendOfflineFileFrm,
- RealICQRemoteControlImage, ExtWebBrowser, lxkj_TLB, HTTPApp, UpLoadFileToWeb,
- WebBrowserWithUI, MyInputBoxFrm, BlockingTCPClient, FileTransferWithNode,
- TransmiteFileMission, UploadOrDownloadFileMission, VCardFrm;
- const
- TalkingTextColor: string = '#585858'; {对话窗口中系统信息字体颜色}
- MaxMessageLength: Integer = 3500; {消息的最大字符数}
- type
- PImageInfo = ^TImageInfo;
- TImageInfo = record
- Name: string;
- iFlag: Integer;
- end;
- TTalkingCategory = (tcNormal, tcTeam);
- TTalkingForm = class(TRealICQSkinForm)
- pnlClient: TPanel;
- ActionManager1: TActionManager;
- actSaveAsTextFile: TAction;
- EditCut: TEditCut;
- EditCopy: TEditCopy;
- EditPaste: TEditPaste;
- EditSelectAll: TEditSelectAll;
- EditUndo: TEditUndo;
- EditDelete: TEditDelete;
- actAlwayOnTop: TAction;
- pnlToolBar: TPanel;
- Shape1: TShape;
- ImgLstForActions: TImageList;
- pnlForActionToolBar: TPanel;
- actAddUser: TAction;
- actSendFile: TAction;
- actVideo: TAction;
- actAudio: TAction;
- ImgLstForShowHideUserPanel: TImageList;
- TimerForGetUserInformation: TTimer;
- ppMyOptions: TPopupActionBar;
- N2: TMenuItem;
- V1: TMenuItem;
- miShowMyHeadImage: TMenuItem;
- miShowMyCard: TMenuItem;
- ppYourOptions: TPopupActionBar;
- miShowYourHeadImage: TMenuItem;
- miShowYourCard: TMenuItem;
- miShowYourVideo: TMenuItem;
- miShowMyVideo: TMenuItem;
- N11: TMenuItem;
- miSeeYourDetailInformation: TMenuItem;
- FontDialog: TFontDialog;
- ppForWebBrowser: TPopupActionBar;
- miCopyFromIE: TMenuItem;
- miSelAllFromIE: TMenuItem;
- ppForInputer: TPopupActionBar;
- U1: TMenuItem;
- N14: TMenuItem;
- C1: TMenuItem;
- C2: TMenuItem;
- P1: TMenuItem;
- T1: TMenuItem;
- A1: TMenuItem;
- EditFontSet: TAction;
- OpenDialog: TOpenDialog;
- miSaveImageAs: TMenuItem;
- miAddImageToCustomFaces: TMenuItem;
- ApplicationEvents: TApplicationEvents;
- miSplitAtWebBrowser: TMenuItem;
- actPrint: TAction;
- actPageSet: TAction;
- actPreview: TAction;
- actClose: TAction;
- actSaveAsHTMLFile: TAction;
- actShowHistory: TAction;
- actEnter: TAction;
- actCtrlEnter: TAction;
- ClearInputtingMessageTimer: TTimer;
- ImgLstForAudio: TImageList;
- ppAudioSet: TPopupActionBar;
- miOpenSpeak: TMenuItem;
- miCloseSpeak: TMenuItem;
- miOpenMic: TMenuItem;
- MenuItem14: TMenuItem;
- miStopAudioTransmite: TMenuItem;
- miCloseMic: TMenuItem;
- miStopVideo: TMenuItem;
- actStopVideo: TAction;
- S1: TMenuItem;
- miMyVideoSize: TMenuItem;
- miMyVideoMiddleSize: TMenuItem;
- miMyVideoSmallSize: TMenuItem;
- miYourVideoSize: TMenuItem;
- miYourVideoSmallSize: TMenuItem;
- miYourVideoBigSize: TMenuItem;
- miMyVideoBigSize: TMenuItem;
- miYourVideoMiddleSize: TMenuItem;
- ReEnabledVideoActionTimer: TTimer;
- miSaveYourVideoImageAs: TMenuItem;
- miSaveMyVideoImageAs: TMenuItem;
- OpenPictureDialog: TOpenPictureDialog;
- miSeeTeamDetailInformation: TMenuItem;
- ppUserItemRightMenu: TPopupActionBar;
- miSendMessage: TMenuItem;
- miSeeUserInformation: TMenuItem;
- actSeeTeamOptions: TAction;
- actQuitTeam: TAction;
- actDisbandTeam: TAction;
- pnlAdvertisement: TPanel;
- pnlForWebBrowserAdvertisement: TPanel;
- WebBrowserForAdvertisement: TWebBrowser;
- pnlForHideWebBrowserAdvertisement: TPanel;
- ppColors: TPopupActionBar;
- MenuItem18: TMenuItem;
- miMoreColors: TMenuItem;
- miShowVideoForm: TMenuItem;
- imgToolbarBack: TImage;
- spbAddUser: TRealICQSpeedButton;
- spbSendFile: TRealICQSpeedButton;
- spbAudio: TRealICQSpeedButton;
- spbVideo: TRealICQSpeedButton;
- spbSeeTeamOptions: TRealICQSpeedButton;
- spbQuitTeam: TRealICQSpeedButton;
- spbDisbandTeam: TRealICQSpeedButton;
- miVideoSet: TMenuItem;
- spbUploadFile: TRealICQSpeedButton;
- spbRemoteControl: TRealICQSpeedButton;
- pnlRC: TPanel;
- pnlTalkingArea: TPanel;
- Splitter1: TSplitter;
- pnlDisplayer: TPanel;
- ShpDisplayerTopMiddle: TShape;
- ShpDisplayerClient: TShape;
- ImgDisplayerTopLeft: TImage;
- ImgDisplayerTopRight: TImage;
- lblDest: TLabel;
- pnlForWebBrowser: TPanel;
- pnlHint: TPanel;
- Image1: TImage;
- LblHint: TLabel;
- pnlUserInformation: TPanel;
- pnlMyInfo: TPanel;
- rndMyInfo: TRealICQRoundBorderPanel;
- SpbForMyInfo: TRealICQSpeedButton;
- spbMic: TRealICQSpeedButton;
- MicrophoneVolume: TRealICQMicrophoneVolumeControl;
- pnlTeamCallBoard: TPanel;
- rndTeamCallBoard: TRealICQRoundBorderPanel;
- Image2: TImage;
- lblTeamCallBoardTitle: TLabel;
- mmTeamCallBoard: TMemo;
- pnlRemoteControl: TPanel;
- rndRemoteControl: TRealICQRoundBorderPanel;
- btSetControl: TRealICQSpeedButton;
- btClose: TRealICQSpeedButton;
- btReleaseControl: TRealICQSpeedButton;
- lblRCState: TLabel;
- SplitterRC: TSplitter;
- ppForTeamMenu: TPopupActionBar;
- miTeamSendMessage: TMenuItem;
- miTeamSMS: TMenuItem;
- miTeamSeeUserInfo: TMenuItem;
- miTeamAddFriend: TMenuItem;
- miAddFriend: TMenuItem;
- miSendSms: TMenuItem;
- ppForInputerImg: TPopupActionBar;
- MenuItem3: TMenuItem;
- miCopyImage: TMenuItem;
- miPasteImg: TMenuItem;
- MenuItem6: TMenuItem;
- MenuItem7: TMenuItem;
- S2: TMenuItem;
- actSaveImgAs: TAction;
- actAddImageToCustomFaces: TAction;
- F2: TMenuItem;
- spbSendFolder: TRealICQSpeedButton;
- miSaveToWeb: TMenuItem;
- LblSendSMS: TLabel;
- LblSendSMS1: TLabel;
- PnlShowHideUserInfo: TPanel;
- ImgHideShowUserInformation: TImage;
- spbTeamNetWorkDisk: TRealICQSpeedButton;
- PnlTeamWebDisk: TPanel;
- pnlTeamMembers: TPanel;
- rndTeamMembers: TRealICQRoundBorderPanel;
- SpbForTeamMemberInfo: TRealICQSpeedButton;
- rndTeamMemberContainer: TRealICQRoundBorderPanel;
- pnlTeamMemberContainer: TPanel;
- FLVTeamMembers: TRealICQContacterListView;
- rndTeamWebDisk: TRealICQRoundBorderPanel;
- Panel2: TPanel;
- imgTeamWebDiskToolbarBack: TImage;
- lblTeamWebDiskHint: TLabel;
- spbCloseTeamWebDisk: TRealICQSpeedButton;
- Panel4: TPanel;
- WebBrowserForTeamDiskold: TWebBrowser;
- pnlForHideTeamDisk: TPanel;
- N3: TMenuItem;
- N4: TMenuItem;
- N5: TMenuItem;
- N6: TMenuItem;
- N7: TMenuItem;
- N8: TMenuItem;
- N9: TMenuItem;
- N10: TMenuItem;
- N17: TMenuItem;
- TimerForCheckPastedContent: TTimer;
- actCopyScreenHideForm: TAction;
- spbSendSMS: TRealICQSpeedButton;
- SaveDialog: TSaveDialog;
- miAddWorkOrder: TMenuItem;
- spbUploadTeamFile: TRealICQSpeedButton;
- spbUploadTeamFileProcess: TRealICQSpeedButton;
- WebBrowserForTeamDisk: TWebBrowserWithUI;
- UpdateAlias: TMenuItem;
- CaptureGraph: TFilterGraph;
- VideoSourceFilter: TFilter;
- spbPostSMS: TRealICQSpeedButton;
- pnlInputer: TPanel;
- ImgInputerTopLeft: TImage;
- ImgInputerTopRight: TImage;
- ImgInputerTopMiddle: TImage;
- ShpInputerClient: TShape;
- spbFont: TRealICQSpeedButton;
- spbFace: TRealICQSpeedButton;
- lblState: TLabel;
- spbSendImage: TRealICQSpeedButton;
- spbCopyScreen: TRealICQSpeedButton;
- spbSelUIColor: TRealICQSpeedButton;
- spbShakeWindow: TRealICQSpeedButton;
- spbBackground: TRealICQSpeedButton;
- spbHistroyMessage: TRealICQSpeedButton;
- pnlInputeBack: TPanel;
- Panel1: TPanel;
- RichEditTemp: TRealICQRichEdit;
- RichEdInputer: TRealICQRichEdit;
- Panel5: TPanel;
- Image3: TImage;
- btSend: TRealICQButton;
- btCloseTalk: TRealICQButton;
- spbUserInfo: TRealICQSpeedButton;
- lblTeamMemberCount: TLabel;
- actClearWeb: TAction;
- E1: TMenuItem;
- N12: TMenuItem;
- E2: TMenuItem;
- actClearEdit: TAction;
- btDownArrow: TRealICQButton;
- ppForSnap: TPopupActionBar;
- ppForDown: TPopupActionBar;
- H1: TMenuItem;
- N16: TMenuItem;
- Enter: TMenuItem;
- CtrlEnter: TMenuItem;
- ppForMsg: TPopupActionBar;
- H2: TMenuItem;
- MClearWindow: TMenuItem;
- spbNormalMsg: TRealICQSpeedButton;
- spbEncryMsg: TRealICQSpeedButton;
- Image4: TImage;
- pnlYourInfo: TPanel;
- rndYourInfo: TRealICQRoundBorderPanel;
- SpbForYourInfo: TRealICQSpeedButton;
- spbSpk: TRealICQSpeedButton;
- MasterVolume: TRealICQMasterVolumeControl;
- rndMy: TRealICQRoundBorderPanel;
- pgcMyInfo: TRealICQNoBorderPageControl;
- tsMyHeadImage: TTabSheet;
- ImgHeadForMyInfo: TImage;
- tsMyCard: TTabSheet;
- cardMine: TRealICQUserCard;
- tsMyVideo: TTabSheet;
- ImgMyVideo: TImage;
- lblMyInfo: TLabel;
- N18: TMenuItem;
- ShpHeadBackForMyInfo: TShape;
- lblYourInfo: TLabel;
- rndYour: TRealICQRoundBorderPanel;
- pgcYourInfo: TRealICQNoBorderPageControl;
- tsYourHeadImage: TTabSheet;
- ShpHeadBackForYourInfo: TShape;
- ImgHeadForYourInfo: TImage;
- tsYourCard: TTabSheet;
- cardYour: TRealICQUserCard;
- tsYourVideo: TTabSheet;
- ImgYourVideo: TImage;
- N1: TMenuItem;
- HTML1: TMenuItem;
- N19: TMenuItem;
- N20: TMenuItem;
- V2: TMenuItem;
- U2: TMenuItem;
- pnlForHideWebBrowser: TPanel;
- WebBrowser: TWebBrowser;
- spbSet: TRealICQSpeedButton;
- ppForSet: TPopupActionBar;
- O1: TMenuItem;
- N13: TMenuItem;
- I1: TMenuItem;
- W1: TMenuItem;
- spbAbout: TRealICQSpeedButton;
- O2: TMenuItem;
- btnQR: TRealICQSpeedButton;
- //ImgMyVideoBorder: TImage;
- procedure spbHistroyMessageClick(Sender: TObject);
- procedure UpdateAliasClick(Sender: TObject);
- procedure spbUploadTeamFileClick(Sender: TObject);
- procedure miAddWorkOrderClick(Sender: TObject);
- procedure spbSendSMSClick(Sender: TObject);
- procedure sbpSMSClick(Sender: TObject);
- procedure actCopyScreenHideFormExecute(Sender: TObject);
- procedure ppForWebBrowserPopup(Sender: TObject);
- procedure ppForInputerImgPopup(Sender: TObject);
- procedure TimerForCheckPastedContentTimer(Sender: TObject);
- procedure RichEdInputerInsertObject(Sender: TObject);
- procedure RichEdInputerDropFiles(Sender: TObject; AFiles: TStringList);
- procedure WebBrowserForTeamDiskoldBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure WebBrowserForTeamDiskoldDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure RichEdInputerSelectionChange(Sender: TObject);
- procedure EditPasteUpdate(Sender: TObject);
- procedure EditPasteExecute(Sender: TObject);
- procedure spbCloseTeamWebDiskClick(Sender: TObject);
- procedure spbTeamNetWorkDiskClick(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure ImgHideShowUserInformationClick(Sender: TObject);
- procedure ImgHideShowUserInformationMouseLeave(Sender: TObject);
- procedure ImgHideShowUserInformationMouseEnter(Sender: TObject);
- procedure LblSendSMSClick(Sender: TObject);
- procedure LblSendSMSMouseLeave(Sender: TObject);
- procedure LblSendSMSMouseEnter(Sender: TObject);
- procedure miSaveToWebClick(Sender: TObject);
- procedure spbSendFolderClick(Sender: TObject);
- procedure miPasteImgClick(Sender: TObject);
- procedure actAddImageToCustomFacesExecute(Sender: TObject);
- procedure actSaveImgAsExecute(Sender: TObject);
- procedure ppForInputerImgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure miCopyImageClick(Sender: TObject);
- procedure miTeamAddFriendClick(Sender: TObject);
- procedure miAddFriendClick(Sender: TObject);
- procedure miTeamSeeUserInfoClick(Sender: TObject);
- procedure ppForTeamMenuPopup(Sender: TObject);
- procedure miSendSmsClick(Sender: TObject);
- procedure miTeamSMSClick(Sender: TObject);
- procedure miTeamSendMessageClick(Sender: TObject);
- procedure ppForTeamMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure btCloseClick(Sender: TObject);
- procedure btReleaseControlClick(Sender: TObject);
- procedure btSetControlClick(Sender: TObject);
- procedure spbRemoteControlClick(Sender: TObject);
- procedure spbUploadFileClick(Sender: TObject);
- procedure miMoreColorsClick(Sender: TObject);
- procedure ppColorsPopup(Sender: TObject);
- procedure ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure actShowHistoryExecute(Sender: TObject);
- procedure WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure actAddUserExecute(Sender: TObject);
- procedure actDisbandTeamExecute(Sender: TObject);
- procedure actQuitTeamExecute(Sender: TObject);
- procedure actSeeTeamOptionsExecute(Sender: TObject);
- procedure miSeeUserInformationClick(Sender: TObject);
- procedure miSendMessageClick(Sender: TObject);
- procedure ppUserItemRightMenuPopup(Sender: TObject);
- procedure ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure miSeeTeamDetailInformationClick(Sender: TObject);
- procedure spbCopyScreenClick(Sender: TObject);
- procedure miSaveYourVideoImageAsClick(Sender: TObject);
- procedure miSaveMyVideoImageAsClick(Sender: TObject);
- procedure ReEnabledVideoActionTimerTimer(Sender: TObject);
- procedure miMyVideoSmallSizeClick(Sender: TObject);
- procedure miYourVideoSmallSizeClick(Sender: TObject);
- procedure actStopVideoExecute(Sender: TObject);
- procedure actVideoExecute(Sender: TObject);
- procedure miStopAudioTransmiteClick(Sender: TObject);
- procedure miOpenMicClick(Sender: TObject);
- procedure miCloseMicClick(Sender: TObject);
- procedure miOpenSpeakClick(Sender: TObject);
- procedure miCloseSpeakClick(Sender: TObject);
- procedure spbMicClick(Sender: TObject);
- procedure spbSpkClick(Sender: TObject);
- procedure ppAudioSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure actAudioExecute(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure ClearInputtingMessageTimerTimer(Sender: TObject);
- procedure actCtrlEnterExecute(Sender: TObject);
- procedure actEnterExecute(Sender: TObject);
- procedure actAlwayOnTopExecute(Sender: TObject);
- procedure actEmptyWebExecute(Sender: TObject);
- procedure spbSendImageClick(Sender: TObject);
- procedure actSaveAsHTMLFileExecute(Sender: TObject);
- procedure actPreviewExecute(Sender: TObject);
- procedure actPrintExecute(Sender: TObject);
- procedure actPageSetExecute(Sender: TObject);
- procedure actSaveAsTextFileExecute(Sender: TObject);
- procedure actCloseExecute(Sender: TObject);
- procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure actSendFileExecute(Sender: TObject);
- procedure EditFontSetExecute(Sender: TObject);
- procedure RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure miSelAllFromIEClick(Sender: TObject);
- procedure miCopyFromIEClick(Sender: TObject);
- procedure ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure spbFaceClick(Sender: TObject);
- procedure spbFontClick(Sender: TObject);
- procedure RichEdInputerChange(Sender: TObject);
- procedure btSendClick(Sender: TObject);
- procedure lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure lblDestClick(Sender: TObject);
- procedure lblDestMouseLeave(Sender: TObject);
- procedure lblDestMouseEnter(Sender: TObject);
- procedure miSeeYourDetailInformationClick(Sender: TObject);
- procedure rndMyInfoResize(Sender: TObject);
- procedure tsMyVideoShow(Sender: TObject);
- procedure miShowMyVideoClick(Sender: TObject);
- procedure tsYourVideoShow(Sender: TObject);
- procedure miShowYourVideoClick(Sender: TObject);
- procedure tsMyCardShow(Sender: TObject);
- procedure tsMyHeadImageShow(Sender: TObject);
- procedure miShowMyCardClick(Sender: TObject);
- procedure miShowMyHeadImageClick(Sender: TObject);
- procedure tsYourCardShow(Sender: TObject);
- procedure tsYourHeadImageShow(Sender: TObject);
- procedure miShowYourCardClick(Sender: TObject);
- procedure miShowYourHeadImageClick(Sender: TObject);
- procedure SpbForYourInfoClick(Sender: TObject);
- procedure ppYourOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppMyOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure SpbForMyInfoClick(Sender: TObject);
- procedure pnlDisplayerResize(Sender: TObject);
- procedure TimerForGetUserInformationTimer(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- //procedure spbShowHideUserInformationClick(Sender: TObject);
- procedure spbSelUIColorClick(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure spbShakeWindowClick(Sender: TObject);
- procedure spbBackgroundClick(Sender: TObject);
- procedure miShowVideoFormClick(Sender: TObject);
- procedure ApplicationEventsException(Sender: TObject; E: Exception);
- procedure miVideoSetClick(Sender: TObject);
- //procedure pnlTeamCallBoardClick(Sender: TObject);
- procedure WebBrowserForTeamDiskBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- //procedure spbCopyScreen2Click(Sender: TObject);
- procedure spbUserInfoClick(Sender: TObject);
- //procedure chkEncryMessageClick(Sender: TObject);
- procedure actClearWebExecute(Sender: TObject);
- procedure actClearEditExecute(Sender: TObject);
- procedure btDownArrowClick(Sender: TObject);
- procedure ppForSnapGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppForDownGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppForMsgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppForSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure MClearWindowClick(Sender: TObject);
- procedure spbEncryMsgClick(Sender: TObject);
- procedure spbNormalMsgClick(Sender: TObject);
- procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
- procedure spbSetClick(Sender: TObject);
- procedure spbAboutClick(Sender: TObject);
- procedure btnQRClick(Sender: TObject);
- procedure pnlTalkingAreaClick(Sender: TObject);
- procedure cardYourResize(Sender: TObject);
- procedure btCloseTalkClick(Sender: TObject);
- //procedure tsMyVideoContextPopup(Sender: TObject; MousePos: TPoint;
- // var Handled: Boolean);
- private
- FVCardFrom: TVCardForm;
- FTcpClient: TBlockingTCPClient;
- FCategory: TTalkingCategory;
- FRightMouseClickedFace: TFaceInRichEdit;
- FTeamID: string;
- FTeamUpLoadFile: TUpLoadFile;
- //显示群组成员列表的ListView
- FFileTransmitters: TStringList;
- FOldWidth, FOldHeight, FOldWidthOfUserInfo, FMinWidthOfYourPanel, FMinWidthOfMyPanel: Integer;
- FSender, FReceiver: string;
- FFaceMenuAtFileName: string; //在自定义表情上弹出右键菜单时所指的图片文件的名称
- FSetFaceMenuAtFileNameTicket: Cardinal;
- FLastSendInputtingMessageTicket: Cardinal;
- FAudioMission: TAudioMission;
- FVideoMission: TVideoMission;
- FRemoteControlMission: TRemoteControlMission;
- FWindowColor: TColor;
- FUseSelfColor: Boolean;
- FBackGroundImage: string;
- FOfflinefilesAddr: string;
- FOfflinefilesPort: Integer;
- FPackageSize: Integer;
- FTransmiteFileMissions: TList;
- FUpDownFileMissions: TList;
- FNodeTransferMissions: TList;
- FSettedYourVideImageSize, FSettedMyVideImageSize: Boolean;
- FLastSendShakeWindowTicket: Cardinal;
- FLastRecvShakeWindowTicket: Cardinal;
- FLastSendMsgTicket: Cardinal;
- FRidrected: Boolean;
- FRidrectURL: string;
- FImageSize: Integer;
- FBaseURL: string;
- FMaxID: Integer;
- procedure LoadOfflinefilesConfig;
- procedure LoadWindowColor;
- procedure SaveWindowColor;
- procedure miColorClick(Sender: TObject);
- procedure LoadBackGround;
- procedure SaveBackGround;
- procedure IdHTTPOnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
- procedure IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
- procedure IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
- procedure IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
- function GetHTMLUBBCode(AHTML: string; var ABaseURL: string): string;
- function ReAlighHTMLContent(ABaseURL: string): Boolean;
- function CheckImageExists(AImageFile: string): string;
- function FindIECacheImage(ADir, AImageFile: string): string;
- procedure CheckPastedContent(ADeleteOtherObj: Boolean = False);
- procedure AddImageToInput(AFileName: string; ARichEd: TRealICQRichEdit);
- procedure ChangePopupActionBarColor(PopupActionBar: TPopupActionBar);
- function CheckNotCompletedMission: Integer;
- procedure LoadNotReadMessages;
- procedure UpdateMyInfo;
- procedure UpdateTeamMembers;
- procedure SetTeamID(Value: string);
- procedure SetReceiver(Value: string);
- procedure ShowSpbShowHideUserInformationState;
- function GetInputerLength: Integer;
- procedure InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
- procedure SetDOMStyle(Doc: IHTMLDocument2);
- procedure LoadAdvertisement;
- procedure P2PTypeChanged(Sender: TObject);
- function GetCanWriteMessage: Boolean;
- procedure CancelAllSendFile;
- procedure CloseAllMissions;
- procedure CancelAllUpDdownFile;
- procedure CancelAllUpDdownNodeFile;
- procedure CalculatedWaveInVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
- procedure CalculatedWaveOutVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
- procedure CapturedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- procedure ReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- procedure CreateTeamResult(Sender: TObject; ATeamCaption: string; ACreated: Boolean; ATeamID: string; AFailingCause: string);
- procedure AddMessageToWebBrowser(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
- procedure ShakeWindow;
- procedure SetLblSendSMSPosition(HIntMsg: string);
- procedure AddMessageToWebBrowserTop(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
- protected
- procedure CMWininichange(var Message: TWMWinIniChange); message CM_WININICHANGE;
- procedure CreateParams(var Params: TCreateParams); override;
- procedure DropFiles(var Message: TMessage); message WM_DropFiles;
- procedure OnKeyDown(var Msg: TMessage); message WM_KEYDOWN;
- procedure OnKeyUp(var Msg: TMessage); message WM_KEYUP;
- public
- FRealICQClient: TRealICQClient;
- procedure LoadHistoryMessages;
- procedure UpdateTeamMember(ARealICQUser: TRealICQUser);
- function PasteImage(AUseTemp: Boolean = True): Boolean;
- procedure LoadNotReadMessagesFromDBHistory(DBHistorySearchResult: TDBHistorySearchResult);
- procedure OpenSendFolderForm(FolderName: string);
- procedure SendFile(FileName: string);
- procedure ChangeUIColor(AColor: TColor); override;
- procedure InsertFaceToRichEdit(Face: TFace; FaceID: Integer);
- procedure ShowMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean = False);
- procedure ShowTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean = False);
- procedure SendDropFile(AFileName: string);
- procedure ShowGettedSendFileRequest(ASendFileRequestInfo: TSendFileRequestInfo);
- procedure ShowCancelSendFile(AOppositeID: Cardinal);
- procedure ShowSendOfflineFileRequest(AOppositeID: Cardinal);
- procedure ShowSendedSendFileRequest(APtoPFileTransmitter: TPtoPFileTransmitter);
- procedure ShowGettedAudioTransmiteRequest;
- procedure ShowSendedAudioTransmiteRequest;
- procedure ShowCanceledAudioTransmite;
- procedure ShowGettedAudioTransmiteResponse(AAcceptted: Boolean);
- procedure ShowStoppedAudioTransmite(AIsStopper: Boolean);
- procedure ShowGettedAudioTransmiteConnectted;
- procedure ShowGettedRemoteControlTransmiteRequest;
- procedure ShowSendedRemoteControlTransmiteRequest;
- procedure ShowCanceledRemoteControlTransmite;
- procedure ShowGettedRemoteControlTransmiteResponse(AAcceptted: Boolean);
- procedure ShowStoppedRemoteControlTransmite(AIsStopper: Boolean);
- procedure ShowGettedRemoteControlTransmiteConnectted;
- procedure ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight: Integer);
- procedure ShowGettedRemoteControlTransmiteControlRequest;
- procedure ShowSendedRemoteControlTransmiteControlRequest;
- procedure ShowCancelControlRemoteControlTransmite;
- procedure ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted: Boolean);
- procedure ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted: Boolean);
- procedure FullScreenRemoteControlPanel;
- procedure CloseRemoteControlPanel;
- procedure OpenRemoteControlPanel;
- procedure ShowGettedVideoTransmiteRequest;
- procedure ShowSendedVideoTransmiteRequest;
- procedure ShowCanceledVideoTransmite;
- procedure ShowGettedVideoTransmiteResponse(AAcceptted: Boolean);
- procedure ShowStoppedVideoTransmite(AIsStopper: Boolean);
- procedure ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp: Boolean);
- procedure ShowInputting(AInputting: Boolean);
- procedure ShowShakeWindow(AIsSource: Boolean);
- //TODO: 发送离线文件
- procedure SendOfflineFile(AFileName: string);
- //保存用户剪切屏幕的图片
- procedure SaveImageInfo(TempFaceFileName: string; iFlag: Integer);
- procedure SetBrowserBg(BackImage: string);
- function FindTransmitFileByBaseID(ABaseID: string): TTransmiteFileMission;
- function FindFileTransmitByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
- function FindUpDownFileByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
- function FindUpNodeFileByBaseID(ABaseID: string): TFileTransferWithNode;
- property TransmiteFileMissions: TList read FTransmiteFileMissions;
- property UpDownFileMissions: TList read FUpDownFileMissions;
- property FileTransmitters: TStringList read FFileTransmitters;
- property NodeTransferMissions: TList read FNodeTransferMissions;
- property SettedYourVideImageSize: Boolean read FSettedYourVideImageSize write FSettedYourVideImageSize;
- property SettedMyVideImageSize: Boolean read FSettedMyVideImageSize write FSettedMyVideImageSize;
- property AudioMission: TAudioMission read FAudioMission write FAudioMission;
- property VideoMission: TVideoMission read FVideoMission write FVideoMission;
- property RemoteControlMission: TRemoteControlMission read FRemoteControlMission write FRemoteControlMission;
- property FaceMenuAtFileName: string read FFaceMenuAtFileName write FFaceMenuAtFileName;
- property SetFaceMenuAtFileNameTicket: Cardinal read FSetFaceMenuAtFileNameTicket write FSetFaceMenuAtFileNameTicket;
- property Category: TTalkingCategory read FCategory;
- property TeamID: string read FTeamID write SetTeamID;
- property Receiver: string read FReceiver write SetReceiver;
- property CanWriteMessage: Boolean read GetCanWriteMessage;
- property WindowColor: TColor read FWindowColor;
- property LastRecvShakeWindowTicket: Cardinal read FLastRecvShakeWindowTicket write FLastRecvShakeWindowTicket;
- property OfflinefilesAddr: string read FOfflinefilesAddr write FOfflinefilesAddr;
- property OfflinefilesPort: Integer read FOfflinefilesPort write FOfflinefilesPort;
- property PackageSize: Integer read FPackageSize write FPackageSize;
- property TeamUpLoadFile: TUpLoadFile read FTeamUpLoadFile;
- public
- ImagesList: TList;
- ALoginName: string;
- function HasMobilePhone(LoginName: string): Boolean;
- procedure DownFileComplete(ASource, ADest, ARemark: string; AStatus: boolean; AFileSize: Integer; IsNeedNotify: Boolean);
- procedure TeamUpFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: string);
- property LVTeamMembers: TRealICQContacterListView read FLVTeamMembers;
- end;
- function GetTalkingFormCount: Integer;
- procedure CloseAllTalkingForm;
- procedure SetAllTakingFormEnabledState(AEnableValue: Boolean);
- procedure UpdateAllTakingFormGIFHeadImage;
- procedure UpdateAllTakingFormHotKeySet;
- procedure ChangeTalkingFormVisible(AVisible: Boolean);
- function OpenTalkingForm(AReceiver: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- function GetTalkingForm(AReceiver: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- procedure UpdateTalkingForm(ARealICQUser: TRealICQUser);
- function OpenTeamTalkingForm(ATeamID: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- function GetTeamTalkingForm(ATeamID: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- procedure UpdateTeamTalkingForm(ATeam: TRealICQTeam);
- function InTalkingFormAdvertisement(AHandle: THandle): Boolean;
- function InTalkingFormTeamDisk(AHandle: THandle): Boolean;
- procedure ChangeTalkingFormColor(AColor: TColor);
- procedure ChangeTalkingFormSkin(ASkinName: string);
- procedure UpdateTalkingFormAdversement;
- procedure ShowCopyScreenForm(ATalkingForm: TTalkingForm);
- function FindURLCache(pstrDatfile: PAnsiChar; pstrURL: PAnsiChar): PAnsiChar; stdcall external 'binary/DATReader.dll';
- implementation
- uses
- UserCardDetailView, SMSFrm, AddFriendFrm, SelFaceFrm, AddFaceFrm,
- CopyScreenFrm, TrueHiddenMainFrm, TeamOptionsFrm, AddUserFrm,
- MessagesManagerFrm, SelBackFrm, UserCardFrm, VideoFrm, RemoteControlFrm,
- SendFolderFrm, NotReadMessageBoxFrm, TeamsAdapter, LoggerImport,
- TeamShareAdapter, LimitCondition, AsynActions, FileTransmitAdapter,
- TalkFormController, UsersService, GroupConfig, ConditionConfig, UploaderTask,
- MessagesHander, RealICQUtility;
- {$R *.dfm}
- {$R TalkImg.RES}
- {TTalkingForm}
- procedure TTalkingForm.LoadBackGround;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- BackGroundImagesNode: IXMLNode;
- NodeName: string;
- begin
- XMLFile := TRealICQClient.GetUserDir + BackGroundImagesXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + BackGroundImagesXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- BackGroundImagesNode := XMLDocument.DocumentElement;
- if FCategory = tcNormal then
- NodeName := 'U' + FReceiver
- else
- NodeName := 'T' + FTeamID;
- try
- if BackGroundImagesNode.ChildNodes.FindNode(NodeName) <> nil then
- begin
- FBackGroundImage := BackGroundImagesNode.ChildNodes.FindNode(NodeName).Attributes['BackGroundImage'];
- if not FileExists(FBackGroundImage) then
- FBackGroundImage := '';
- try
- SetDomStyle(WebBrowser.Document as IHtmlDocument2);
- except
- end;
- end;
- except
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SaveBackGround;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- BackGroundImagesNode: IXMLNode;
- NodeName: string;
- begin
- XMLFile := TRealICQClient.GetUserDir + BackGroundImagesXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + BackGroundImagesXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- BackGroundImagesNode := XMLDocument.DocumentElement;
- if FCategory = tcNormal then
- NodeName := 'U' + FReceiver
- else
- NodeName := 'T' + FTeamID;
- try
- BackGroundImagesNode.ChildNodes.FindNode(NodeName).Attributes['BackGroundImage'] := FBackGroundImage;
- except
- BackGroundImagesNode.AddChild(NodeName).Attributes['BackGroundImage'] := FBackGroundImage;
- end;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.LoadWindowColor;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- WindowColorsNode: IXMLNode;
- NodeName: string;
- begin
- XMLFile := TRealICQClient.GetUserDir + WindowColorsXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + WindowColorsXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- WindowColorsNode := XMLDocument.DocumentElement;
- if FCategory = tcNormal then
- NodeName := 'U' + FReceiver
- else
- NodeName := 'T' + FTeamID;
- FWindowColor := MainForm.UIMainColor;
- FUseSelfColor := False;
- try
- if WindowColorsNode.ChildNodes.FindNode(NodeName) <> nil then
- begin
- FWindowColor := WindowColorsNode.ChildNodes.FindNode(NodeName).Attributes['WindowColor'];
- if FWindowColor <> MainForm.UIMainColor then
- FUseSelfColor := True;
- end;
- except
- end;
- ChangeUIColor(FWindowColor);
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.AddImageToInput(AFileName: string; ARichEd: TRealICQRichEdit);
- var
- gifImage: TGifImage;
- newBitmap: TBitmap;
- newJpg: TJPegImage;
- TempFaceFileName: string;
- Face: TFace;
- MD5HashValue: MD5Digest;
- MD5HashString: string;
- AOldFileName: string;
- iLoop: Integer;
- Sys32Dir: string;
- pSys32Dir: array[0..Max_Path] of char;
- begin
- try
- //判断是否为系统表情
- for iLoop := 0 to MainForm.FaceList.Count - 1 do
- begin
- Face := MainForm.FaceList.Objects[iLoop] as TFace;
- if AnsiSameText(ReplaceStr(Face.FileName, '/', '\'), ReplaceStr(AFileName, '/', '\')) then
- begin
- ARichEd.InsertImage(Face.FileName, iLoop);
- Exit;
- end;
- end;
- newJpg := TJPegImage.Create;
- newBitmap := Tbitmap.create;
- gifImage := TGifImage.Create;
- try
- if AnsiSameText(ExtractFileExt(AFileName), '.BMP') then
- begin
- newBitmap.LoadFromFile(AFileName);
- newJpg.Assign(newBitmap);
- newJpg.CompressionQuality := 90;
- newJpg.Compress;
- end
- else if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
- begin
- gifImage.LoadFromFile(AFileName);
- end
- else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
- begin
- end
- else
- begin
- newJpg.LoadFromFile(AFileName);
- end;
- if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
- begin
- AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.GIF';
- gifImage.SaveToFile(AFileName);
- end
- else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
- begin
- AOldFileName := AFileName;
- AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.PNG';
- CopyFile(PChar(AOldFileName), PChar(AFileName), False);
- end
- else
- begin
- AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.JPG';
- newJpg.SaveToFile(AFileName);
- end;
- MD5HashValue := MD5File(AFileName);
- MD5HashString := MD5.MD5Print(MD5HashValue);
- if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
- TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.GIF'
- else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
- TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.PNG'
- else
- TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.JPG';
- RenameFile(AFileName, TempFaceFileName);
- Face := TFace.Create(TempFaceFileName, '', '', MD5HashString, '');
- try
- ARichEd.InsertImage(TempFaceFileName, BaseTempFaceIndex + MainForm.TempFaceList.AddObject(MD5HashString, Face));
- except
- on e: exception do
- begin
- Log(E.Message, 'ARichEd.InsertImage');
- GetSystemDirectory(pSys32Dir, Max_Path);
- Sys32Dir := StrPas(pSys32Dir);
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ImageX2_DLL_PACH), PChar(Sys32Dir + '\ImageX2.dll'), False);
- try
- WinExec(PChar('regsvr32 /s "' + 'ImageX2.dll"'), SW_HIDE);
- except
- end;
- Sleep(500);
- ARichEd.InsertImage(TempFaceFileName, BaseTempFaceIndex + MainForm.TempFaceList.AddObject(MD5HashString, Face));
- end;
- end;
- finally
- gifImage.Free;
- newbitmap.free;
- newjpg.Free;
- end;
- except
- on E: Exception do
- begin
- Log(E.Message, 'TTalkingForm.AddImageToInput');
- raise;
- end;
- //
- end;
- end;
- //------------------------------------------------------------------
- procedure TTalkingForm.MClearWindowClick(Sender: TObject);
- begin
- actClearWeb.Execute;
- actClearEdit.Execute;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SaveWindowColor;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- WindowColorsNode: IXMLNode;
- NodeName: string;
- begin
- XMLFile := TRealICQClient.GetUserDir + WindowColorsXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + WindowColorsXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- WindowColorsNode := XMLDocument.DocumentElement;
- if FCategory = tcNormal then
- NodeName := 'U' + FReceiver
- else
- NodeName := 'T' + FTeamID;
- try
- WindowColorsNode.ChildNodes.FindNode(NodeName).Attributes['WindowColor'] := FWindowColor;
- except
- WindowColorsNode.AddChild(NodeName).Attributes['WindowColor'] := FWindowColor;
- end;
- XMLDocument.SaveToFile();
- FUseSelfColor := (FWindowColor <> MainForm.UIMainColor);
- finally
- XMLDocument.Free;
- end;
- end;
- procedure TTalkingForm.sbpSMSClick(Sender: TObject);
- begin
- if (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) or (not MainForm.RealICQClient.UserPermission.EnableSendSms) then
- begin
- Dialogs.ShowMessage('您没有手机短信群发权限! ');
- Exit;
- end;
- OpenTeamSMSForm(self.TeamID);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miColorClick(Sender: TObject);
- begin
- ChangeUIColor((Sender as TMenuItem).Tag);
- FWindowColor := (Sender as TMenuItem).Tag;
- SaveWindowColor;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miMoreColorsClick(Sender: TObject);
- begin
- MainForm.ColorDialog.Color := FWindowColor;
- if MainForm.ColorDialog.Execute then
- begin
- ChangeUIColor(MainForm.ColorDialog.Color);
- FWindowColor := MainForm.ColorDialog.Color;
- SaveWindowColor;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CapturedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- begin
- try
- if not FSettedMyVideImageSize then
- begin
- miShowMyVideo.Click;
- //ImgMyVideoBorder.Refresh;
- Application.ProcessMessages;
- if ABitmap.Width >= 320 then
- miMyVideoBigSize.Click
- else
- miMyVideoSmallSize.Click;
- FSettedMyVideImageSize := True;
- end;
- ImgMyVideo.Picture.Bitmap.Assign(ABitmap);
- except
- end;
- end;
- procedure TTalkingForm.cardYourResize(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- begin
- try
- if not FSettedYourVideImageSize then
- begin
- miShowYourVideo.Visible := True;
- miYourVideoSize.Visible := True;
- miSaveYourVideoImageAs.Visible := True;
- miShowVideoForm.Visible := True;
- miShowYourVideo.Click;
- Application.ProcessMessages;
- if ABitmap.Width >= 320 then
- miYourVideoBigSize.Click
- else
- miYourVideoSmallSize.Click;
- FSettedYourVideImageSize := True;
- end;
- if VideoForm <> nil then
- VideoForm.ImgYourVideo.Picture.Bitmap.Assign(ABitmap)
- else
- ImgYourVideo.Picture.Bitmap.Assign(ABitmap);
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ReEnabledVideoActionTimerTimer(Sender: TObject);
- begin
- ReEnabledVideoActionTimer.Enabled := False;
- actVideo.Enabled := True;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedVideoTransmiteRequest;
- begin
- try
- if FVideoMission <> nil then
- begin
- if FVideoMission.FIsSource then
- begin
- if FVideoMission.FAccepted then
- FVideoMission.ShowStopped(True)
- else
- FVideoMission.ShowCancel;
- end
- else
- begin
- if FVideoMission.FAccepted then
- FVideoMission.ShowStopped(True)
- else
- FVideoMission.ShowDeclined;
- end;
- FreeAndNil(FVideoMission);
- end;
- finally
- FVideoMission := TVideoMission.Create(Self, False);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendedVideoTransmiteRequest;
- begin
- try
- FreeAndNil(FVideoMission);
- finally
- FVideoMission := TVideoMission.Create(Self, True);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowCanceledVideoTransmite;
- begin
- try
- if FVideoMission <> nil then
- FVideoMission.ShowCancel;
- finally
- FreeAndNil(FVideoMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowStoppedVideoTransmite(AIsStopper: Boolean);
- var
- NeedEnabledVideoAction: Boolean;
- begin
- NeedEnabledVideoAction := False;
- if actVideo.Enabled then
- begin
- NeedEnabledVideoAction := True;
- actVideo.Enabled := False;
- end;
- try
- try
- if FVideoMission <> nil then
- FVideoMission.ShowStopped(AIsStopper);
- finally
- FreeAndNil(FVideoMission);
- actStopVideo.Visible := False;
- miShowYourVideo.Visible := False;
- miYourVideoSize.Visible := False;
- miSaveYourVideoImageAs.Visible := False;
- miShowVideoForm.Visible := False;
- if pgcYourInfo.ActivePage = tsYourVideo then
- miShowYourHeadImage.Click;
- miShowMyVideo.Visible := False;
- miMyVideoSize.Visible := False;
- miVideoSet.Visible := False;
- miSaveMyVideoImageAs.Visible := False;
- if pgcMyInfo.ActivePage = tsMyVideo then
- miShowMyHeadImage.Click;
- FreeAndNil(VideoForm);
- end;
- finally
- if NeedEnabledVideoAction then
- ReEnabledVideoActionTimer.Enabled := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp: Boolean);
- begin
- try
- if FVideoMission <> nil then
- begin
- FVideoMission.ShowConnectted(ASendBigBmp, ARecvBigBmp);
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedVideoTransmiteResponse(AAcceptted: Boolean);
- begin
- try
- if FVideoMission <> nil then
- begin
- if AAcceptted then
- begin
- FVideoMission.ShowAcceptted;
- TVideoTransmitter.SetVideoCapContainer(Self);
- FRealICQClient.OnCapturedVideoImage := nil;
- FRealICQClient.OnReceivedVideoImage := nil;
- FRealICQClient.OnCapturedVideoImage := CapturedVideoImage;
- FRealICQClient.OnReceivedVideoImage := ReceivedVideoImage;
- actStopVideo.Visible := True;
- try
- ImgYourVideo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + WorldCamPicture);
- except
- end;
- if FRealICQClient.InstalledCamera then
- begin
- try
- ImgMyVideo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + WorldCamPicture);
- except
- end;
- miShowMyVideo.Visible := True;
- miMyVideoSize.Visible := True;
- miVideoSet.Visible := True;
- miSaveMyVideoImageAs.Visible := True;
- miShowMyVideo.Click;
- end;
- end
- else
- FVideoMission.ShowDeclined;
- end;
- finally
- if not AAcceptted then
- FreeAndNil(FVideoMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedAudioTransmiteRequest;
- begin
- try
- if FAudioMission <> nil then
- begin
- if FAudioMission.FIsSource then
- begin
- if FAudioMission.FAccepted then
- FAudioMission.ShowStopped(True)
- else
- FAudioMission.ShowCancel;
- end
- else
- begin
- if FAudioMission.FAccepted then
- FAudioMission.ShowStopped(True)
- else
- FAudioMission.ShowDeclined;
- end;
- FreeAndNil(FAudioMission);
- end;
- finally
- FAudioMission := TAudioMission.Create(Self, False);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendedAudioTransmiteRequest;
- begin
- try
- FreeAndNil(FAudioMission);
- finally
- FAudioMission := TAudioMission.Create(Self, True);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowCanceledAudioTransmite;
- begin
- try
- if FAudioMission <> nil then
- FAudioMission.ShowCancel;
- finally
- FreeAndNil(FAudioMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowStoppedAudioTransmite(AIsStopper: Boolean);
- begin
- try
- if FAudioMission <> nil then
- FAudioMission.ShowStopped(AIsStopper);
- spbSpk.Visible := False;
- spbMic.Visible := False;
- MasterVolume.Visible := False;
- MicrophoneVolume.Visible := False;
- finally
- FreeAndNil(FAudioMission);
- end;
- end;
- procedure TTalkingForm.CalculatedWaveInVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
- begin
- try
- MicrophoneVolume.PeakValue := AVolume;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CalculatedWaveOutVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
- begin
- try
- MasterVolume.PeakValue := AVolume;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteRequest;
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- if FRemoteControlMission.FIsSource then
- begin
- if FRemoteControlMission.FAccepted then
- FRemoteControlMission.ShowStopped(True)
- else
- FRemoteControlMission.ShowCancel;
- end
- else
- begin
- if FRemoteControlMission.FAccepted then
- FRemoteControlMission.ShowStopped(True)
- else
- FRemoteControlMission.ShowDeclined;
- end;
- FreeAndNil(FRemoteControlMission);
- end;
- finally
- FRemoteControlMission := TRemoteControlMission.Create(Self, False);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendedRemoteControlTransmiteRequest;
- begin
- try
- FreeAndNil(FRemoteControlMission);
- finally
- FRemoteControlMission := TRemoteControlMission.Create(Self, True);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowCanceledRemoteControlTransmite;
- begin
- try
- if FRemoteControlMission <> nil then
- FRemoteControlMission.ShowCancel;
- finally
- FreeAndNil(FRemoteControlMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowStoppedRemoteControlTransmite(AIsStopper: Boolean);
- begin
- try
- if FRemoteControlMission <> nil then
- FRemoteControlMission.ShowStopped(AIsStopper);
- finally
- pnlRemoteControl.Visible := False;
- // pnlMyInfo.Visible := True;
- pnlYourInfo.Visible := True;
- pnlShowHideUserInfo.Visible := True;
- pnlShowHideUserInfo.Width := 10;
- if (not FRemoteControlMission.FIsSource) and (RemoteControlForm <> nil) then
- begin
- LockWindowUpdate(GetDesktopWindow);
- try
- OpenRemoteControlPanel;
- RemoteControlForm.FTalkingForm := nil;
- try
- RemoteControlForm.Close;
- finally
- FreeAndNil(RemoteControlForm);
- end;
- pnlRC.Visible := False;
- SplitterRC.Visible := False;
- pnlUserInformation.Visible := True;
- Width := FOldWidth;
- Height := FOldHeight;
- finally
- LockWindowUpdate(0);
- end;
- end;
- FreeAndNil(FRemoteControlMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FullScreenRemoteControlPanel;
- begin
- if RemoteControlForm = nil then
- Exit;
- LockWindowUpdate(GetDesktopWindow);
- try
- RemoteControlForm.Parent := nil;
- RemoteControlForm.BorderStyle := bsNone;
- RemoteControlForm.Align := alNone;
- RemoteControlForm.btUP.Caption := '浮动停靠';
- RemoteControlForm.pnlScreen.Visible := True;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := 0;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := 0;
- RemoteControlForm.pnlClient.Constraints.MaxWidth := 0;
- RemoteControlForm.pnlClient.Constraints.MaxHeight := 0;
- RemoteControlForm.Constraints.MaxWidth := 0;
- RemoteControlForm.Constraints.MaxHeight := 0;
- RemoteControlForm.Left := -3;
- RemoteControlForm.Top := -(3 + RemoteControlForm.pnlTop.Height);
- RemoteControlForm.Width := Screen.Width + 6;
- RemoteControlForm.Height := Screen.Height + 6 + RemoteControlForm.pnlTop.Height + RemoteControlForm.pnlBottom.Height;
- pnlRC.Visible := False;
- SplitterRC.Visible := False;
- pnlUserInformation.Visible := True;
- Width := FOldWidth;
- Height := FOldHeight;
- finally
- LockWindowUpdate(0);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CloseRemoteControlPanel;
- begin
- if RemoteControlForm = nil then
- Exit;
- LockWindowUpdate(GetDesktopWindow);
- try
- RemoteControlForm.Parent := nil;
- RemoteControlForm.BorderStyle := bsSizeable;
- RemoteControlForm.Align := alNone;
- RemoteControlForm.btUP.Caption := '浮动停靠';
- RemoteControlForm.pnlScreen.Visible := False;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := RemoteControlForm.imgRCScreen.Width + 4;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := RemoteControlForm.imgRCScreen.Height + 4;
- RemoteControlForm.pnlClient.Constraints.MaxWidth := RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth;
- RemoteControlForm.pnlClient.Constraints.MaxHeight := RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight + RemoteControlForm.pnlTop.Height + RemoteControlForm.pnlBottom.Height;
- RemoteControlForm.Constraints.MaxWidth := RemoteControlForm.pnlClient.Constraints.MaxWidth + (RemoteControlForm.Width - RemoteControlForm.pnlClient.Width);
- RemoteControlForm.Constraints.MaxHeight := RemoteControlForm.pnlClient.Constraints.MaxHeight + (RemoteControlForm.Height - RemoteControlForm.pnlClient.Height);
- if RemoteControlForm.Constraints.MaxWidth < Screen.WorkAreaWidth then
- RemoteControlForm.Width := RemoteControlForm.Constraints.MaxWidth
- else
- RemoteControlForm.Width := Round(Screen.WorkAreaWidth * 0.8);
- if RemoteControlForm.Constraints.MaxHeight < Screen.WorkAreaHeight then
- RemoteControlForm.Height := RemoteControlForm.Constraints.MaxHeight
- else
- RemoteControlForm.Height := Round(Screen.WorkAreaHeight * 0.8);
- RemoteControlForm.Left := (Screen.WorkAreaWidth - RemoteControlForm.Width) div 2;
- RemoteControlForm.Top := (Screen.WorkAreaHeight - RemoteControlForm.Height) div 2;
- pnlRC.Visible := False;
- SplitterRC.Visible := False;
- pnlUserInformation.Visible := True;
- Width := FOldWidth;
- Height := FOldHeight;
- finally
- LockWindowUpdate(0);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.OpenRemoteControlPanel;
- begin
- if RemoteControlForm = nil then
- Exit;
- LockWindowUpdate(GetDesktopWindow);
- try
- Left := 0;
- Top := 0;
- Width := Screen.Width;
- Height := Screen.WorkAreaHeight;
- pnlRC.Visible := True;
- SplitterRC.Visible := True;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := 0;
- RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := 0;
- RemoteControlForm.pnlClient.Constraints.MaxWidth := 0;
- RemoteControlForm.pnlClient.Constraints.MaxHeight := 0;
- RemoteControlForm.Constraints.MaxWidth := 0;
- RemoteControlForm.Constraints.MaxHeight := 0;
- RemoteControlForm.Parent := pnlRC;
- RemoteControlForm.BorderStyle := bsNone;
- RemoteControlForm.ParentWindow := pnlRC.Handle;
- RemoteControlForm.Align := alClient;
- RemoteControlForm.WindowState := wsMaximized;
- RemoteControlForm.btUP.Caption := '浮动窗口';
- RemoteControlForm.pnlScreen.Visible := False;
-
- //if Width - 258 - 50 < RemoteControlForm.imgRCScreen.Width + 20 then
- // pnlRC.Width := Width - 258 - 50
- //else
- // pnlRC.Width := RemoteControlForm.imgRCScreen.Width + 10;
- SplitterRC.Left := pnlRC.Left - 5;
- pnlUserInformation.Visible := False;
- PostMessage(RemoteControlForm.Handle, WM_SIZE, 0, 0);
- finally
- LockWindowUpdate(0);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight: Integer);
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.RecvedScreenSize;
- if (not FRemoteControlMission.FIsSource) then
- begin
- LockWindowUpdate(GetDesktopWindow);
- try
- if RemoteControlForm = nil then
- begin
- FOldWidth := Width;
- FOldHeight := Height;
- Left := 0;
- Top := 0;
- Width := Screen.Width;
- Height := Screen.WorkAreaHeight;
- pnlRC.Visible := True;
- SplitterRC.Visible := True;
- RemoteControlForm := TRemoteControlForm.Create(pnlRC);
- RemoteControlForm.FTalkingForm := Self;
- RemoteControlForm.Parent := pnlRC;
- RemoteControlForm.ParentWindow := pnlRC.Handle;
- RemoteControlForm.Align := alClient;
- RemoteControlForm.WindowState := wsMaximized;
- RemoteControlForm.ChangeUIColor(FormColor);
- RemoteControlForm.imgRCScreen.Picture.Bitmap.SetSize(AWidth, AHeight);
- RemoteControlForm.imgRCScreen.Width := AWidth;
- RemoteControlForm.imgRCScreen.Height := AHeight;
- RemoteControlForm.imgRCScreen.Cursor := crDefault;
- RemoteControlForm.lblRCState.Caption := '控制中。';
- RemoteControlForm.lblRCState2.Caption := '控制中。';
- RemoteControlForm.Show;
- if Width - 258 - 50 < RemoteControlForm.imgRCScreen.Width + 20 then
- pnlRC.Width := Width - 258 - 50
- else
- pnlRC.Width := RemoteControlForm.imgRCScreen.Width + 10;
- SplitterRC.Left := pnlRC.Left - 5;
- pnlUserInformation.Visible := False;
- end
- else
- begin
- RemoteControlForm.imgRCScreen.Picture.Bitmap.SetSize(AWidth, AHeight);
- RemoteControlForm.imgRCScreen.Width := AWidth;
- RemoteControlForm.imgRCScreen.Height := AHeight;
- end;
- PostMessage(RemoteControlForm.Handle, WM_SIZE, 0, 0);
- finally
- LockWindowUpdate(0);
- end;
- end;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted: Boolean);
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.ShowBeControlResponse(AAcceptted);
- if not FRemoteControlMission.FIsSource then
- begin
- if RemoteControlForm <> nil then
- begin
- if AAcceptted then
- begin
- RemoteControlForm.imgRCScreen.Cursor := crDefault;
- RemoteControlForm.lblRCState.Caption := '控制中。';
- RemoteControlForm.lblRCState2.Caption := '控制中。';
- end
- else
- begin
- RemoteControlForm.imgRCScreen.Cursor := crNo;
- RemoteControlForm.lblRCState.Caption := '未被控制。';
- RemoteControlForm.lblRCState2.Caption := '未被控制。';
- end;
- end;
- end
- else
- begin
- if AAcceptted then
- lblRCState.Caption := '控制中。'
- else
- lblRCState.Caption := '未被控制。';
- end;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted: Boolean);
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.ShowControlResponse(AAcceptted);
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlRequest;
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.AccepteControl;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendedRemoteControlTransmiteControlRequest;
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.ShowControlRequest;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowCancelControlRemoteControlTransmite;
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.ShowCancelControl;
- if RemoteControlForm <> nil then
- begin
- RemoteControlForm.imgRCScreen.Cursor := crNo;
- RemoteControlForm.lblRCState.Caption := '未被控制。';
- RemoteControlForm.lblRCState2.Caption := '未被控制。';
- end;
- lblRCState.Caption := '未被控制。';
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteConnectted;
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- FRemoteControlMission.AccepteSend;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedRemoteControlTransmiteResponse(AAcceptted: Boolean);
- begin
- try
- if FRemoteControlMission <> nil then
- begin
- if AAcceptted then
- begin
- FRemoteControlMission.ShowAcceptted;
- end
- else
- FRemoteControlMission.ShowDeclined;
- end;
- finally
- if not AAcceptted then
- FreeAndNil(FRemoteControlMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedAudioTransmiteConnectted;
- begin
- try
- if FAudioMission <> nil then
- begin
- FAudioMission.ShowConnectted;
- spbSpk.Visible := True;
- spbMic.Visible := True;
- MasterVolume.Visible := True;
- MicrophoneVolume.Visible := True;
- FRealICQClient.OnCalculatedWaveInVolume := CalculatedWaveInVolume;
- FRealICQClient.OnCalculatedWaveOutVolume := CalculatedWaveOutVolume;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedAudioTransmiteResponse(AAcceptted: Boolean);
- begin
- try
- if FAudioMission <> nil then
- begin
- if AAcceptted then
- begin
- FAudioMission.ShowAcceptted;
- FRealICQClient.OnCalculatedWaveInVolume := nil;
- FRealICQClient.OnCalculatedWaveOutVolume := nil;
- end
- else
- FAudioMission.ShowDeclined;
- end;
- finally
- if not AAcceptted then
- FreeAndNil(FAudioMission);
- end;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.FindUpDownFileByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
- var
- iLoop: Integer;
- AUpDownFileMissions: TUploadOrDownloadFileMission;
- begin
- Result := nil;
- for iLoop := 0 to FUpDownFileMissions.Count - 1 do
- begin
- AUpDownFileMissions := TUploadOrDownloadFileMission(FUpDownFileMissions[iLoop]);
- if AnsiSameStr(AUpDownFileMissions.BaseID, ABaseID) then
- begin
- Result := AUpDownFileMissions;
- Exit;
- end;
- end;
- end;
- function TTalkingForm.FindUpNodeFileByBaseID(ABaseID: string): TFileTransferWithNode;
- var
- iLoop: Integer;
- AUpDownFileMissions: TFileTransferWithNode;
- begin
- Result := nil;
- for iLoop := 0 to FNodeTransferMissions.Count - 1 do
- begin
- AUpDownFileMissions := TFileTransferWithNode(FNodeTransferMissions[iLoop]);
- if AnsiSameStr(AUpDownFileMissions.BaseID, ABaseID) then
- begin
- Result := AUpDownFileMissions;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.FindTransmitFileByBaseID(ABaseID: string): TTransmiteFileMission;
- var
- iLoop: Integer;
- ATransmiteFileMission: TTransmiteFileMission;
- begin
- Result := nil;
- for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
- begin
- ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
- if AnsiSameStr(ATransmiteFileMission.BaseID, ABaseID) then
- begin
- Result := ATransmiteFileMission;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.FindFileTransmitByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
- var
- iLoop: Integer;
- AUploadOrDownloadFileMission: TUploadOrDownloadFileMission;
- begin
- Result := nil;
- for iLoop := 0 to FFileTransmitters.Count - 1 do
- begin
- AUploadOrDownloadFileMission := FFileTransmitters.Objects[iLoop] as TUploadOrDownloadFileMission;
- if AnsiSameStr(AUploadOrDownloadFileMission.BaseID, ABaseID) then
- begin
- Result := AUploadOrDownloadFileMission;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowGettedSendFileRequest(ASendFileRequestInfo: TSendFileRequestInfo);
- var
- ATransmiteFileMission, ATransmiteFileMissionTemp: TTransmiteFileMission;
- iLoop, ReceivingFaceCount: Integer;
- FileExt: string;
- begin
- ATransmiteFileMission := TTransmiteFileMission.Create(Self, tdReceiver, ASendFileRequestInfo.FileName, ASendFileRequestInfo.MD5Code, ASendFileRequestInfo.FileLength, ASendFileRequestInfo.Objective, ASendFileRequestInfo.FileExtImage);
- ATransmiteFileMission.FOppositeID := ASendFileRequestInfo.OppositeID;
- if ASendFileRequestInfo.Objective = foFace then
- begin
- ReceivingFaceCount := 0;
- for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
- begin
- ATransmiteFileMissionTemp := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
- if ATransmiteFileMissionTemp = ATransmiteFileMission then
- continue;
- if ATransmiteFileMissionTemp.FObjective = foFile then
- continue;
- if (ATransmiteFileMissionTemp.FDirection = tdReceiver) and (ATransmiteFileMissionTemp.FAccepted = True) then
- begin
- Inc(ReceivingFaceCount);
- if ReceivingFaceCount >= 1 then
- Exit; //同时只允许传送1个表情
- end;
- end;
- ATransmiteFileMission.Accept(TRealICQClient.GetReceivedFaceDir + ASendFileRequestInfo.FileName);
- end
- else
- begin
- FileExt := ExtractFileExt(ASendFileRequestInfo.FileName);
- if (MainForm.RecvFileSafeLevel = fsHigh) or ((MainForm.RecvFileSafeLevel = fsMiddle) and (AnsiSameText(FileExt, '.EXE') or AnsiSameText(FileExt, '.COM'))) then
- begin
- ATransmiteFileMission.Decline;
- FreeAndNil(ATransmiteFileMission);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendOfflineFileRequest(AOppositeID: Cardinal);
- var
- iLoop: Integer;
- ATransmiteFileMission: TTransmiteFileMission;
- begin
- for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
- begin
- ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
- if ATransmiteFileMission.FOppositeID = AOppositeID then
- begin
- ATransmiteFileMission.GettedSendOfflineFileRequest;
- FreeAndNil(ATransmiteFileMission);
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowCancelSendFile(AOppositeID: Cardinal);
- var
- iLoop: Integer;
- ATransmiteFileMission: TTransmiteFileMission;
- begin
- for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
- begin
- ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
- if ATransmiteFileMission.FOppositeID = AOppositeID then
- begin
- ATransmiteFileMission.Cancel;
- FreeAndNil(ATransmiteFileMission);
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CancelAllSendFile;
- var
- iLoop: Integer;
- ATransmiteFileMission: TTransmiteFileMission;
- begin
- for iLoop := FTransmiteFileMissions.Count - 1 downto 0 do
- begin
- ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
- if not ATransmiteFileMission.FAccepted then
- begin
- if ATransmiteFileMission.FDirection = tdSender then
- ATransmiteFileMission.Cancel
- else
- ATransmiteFileMission.Decline;
- end
- else if not ATransmiteFileMission.FMovingFile then
- begin
- ATransmiteFileMission.Stop;
- end;
- FreeAndNil(ATransmiteFileMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CancelAllUpDdownFile;
- var
- iLoop: Integer;
- ATransmiteFileMission: TUploadOrDownloadFileMission;
- begin
- for iLoop := FUpDownFileMissions.Count - 1 downto 0 do
- begin
- ATransmiteFileMission := TUploadOrDownloadFileMission(FUpDownFileMissions[iLoop]);
- ATransmiteFileMission.Stop;
- FreeAndNil(ATransmiteFileMission);
- end;
- end;
- procedure TTalkingForm.CancelAllUpDdownNodeFile;
- var
- iLoop: Integer;
- ATransmiteFileMission: TFileTransferWithNode;
- begin
- for iLoop := FNodeTransferMissions.Count - 1 downto 0 do
- begin
- ATransmiteFileMission := TFileTransferWithNode(FNodeTransferMissions[iLoop]);
- FreeAndNil(ATransmiteFileMission);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSendedSendFileRequest(APtoPFileTransmitter: TPtoPFileTransmitter);
- var
- ATransmiteFileMission: TTransmiteFileMission;
- begin
- ATransmiteFileMission := TTransmiteFileMission.Create(Self, tdSender, APtoPFileTransmitter.FileName, APtoPFileTransmitter.MD5Code, APtoPFileTransmitter.StreamLength, APtoPFileTransmitter.Objective, APtoPFileTransmitter.FileExtImage);
- ATransmiteFileMission.FPtoPFileTransmitter := APtoPFileTransmitter;
- ATransmiteFileMission.FPtoPFileTransmitter.OnAcceptted := ATransmiteFileMission.FileTransmitterAcceptted;
- ATransmiteFileMission.FPtoPFileTransmitter.OnDeclined := ATransmiteFileMission.FileTransmitterDeclined;
- end;
- {将消息内容显示在WebBrowser中}
- //------------------------------------------------------------------------------
- procedure TTalkingForm.AddMessageToWebBrowser(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
- var
- MsgContent, HexString, HTML, SenderColor: string;
- TextFont: TFont;
- ID: string;
- begin
- ID := IntToStr(GetTickCount);
- TextFont := TFont.Create;
- StringToFont(FontStr, TextFont);
- MsgContent := FilterHTMLCode(SenderName, MainForm.AllowURL);
- if Category = tcTeam then
- MsgContent := MsgContent + '(<a href="OpenRightMenu,' + SenderId + '">' + Copy(SenderId, Pos('-', SenderId) + 1, Length(SenderId)) + '</a>)';
- if CompareDate(Now, SendDateTime) = EqualsValue then
- MsgContent := MsgContent + ' ' + TimeToStr(SendDateTime)
- else
- MsgContent := MsgContent + ' ' + DateTimeToStr(SendDateTime);
- if ShowSendFailed then
- MsgContent := MsgContent + '(发送消息超时)'
- else if (not AnsiSameText(SenderID, MainForm.RealICQClient.LoginName)) and (not IsHistory) then
- MsgContent := MsgContent + ' <a href="about:blankAddToWebRemark://_' + ID + '" title="添加至备忘录"><img src="' + ExtractFilePath(Application.ExeName) + Action_Paste_GIF + '" width="16" height="16" hspace="1" align="absBottom" border="0"></a><br>';
- if not IsHistory then
- begin
- if AnsiSameText(SenderID, FReceiver) then
- SenderColor := '#009900'
- else
- SenderColor := '#0000FF';
- end
- else
- SenderColor := '#686868';
- HTML := '<DIV style="padding-bottom:2px; padding-top:2px; color:' + SenderColor + '">' + MsgContent + '</DIV>';
- HTML := HTML + '<DIV style="padding-left:9px; padding-bottom:2px;';
- //设置字体
- HTML := HTML + ';font-family:' + TextFont.Name;
- HexString := IntToHex(TextFont.Color, 6); //获取颜色的16进制格式
- HTML := HTML + ';color:#' + Copy(HexString, 5, 2) + Copy(HexString, 3, 2) + Copy(HexString, 1, 2); //将BGR颜色转换为RGB颜色
- HTML := HTML + ';font-size:' + IntToStr(TextFont.Size) + 'pt';
- if fsBold in TextFont.Style then
- HTML := HTML + ';font-weight:bold';
- if fsItalic in TextFont.Style then
- HTML := HTML + ';font-style:italic';
- HTML := HTML + ';text-decoration:';
- if fsUnderline in TextFont.Style then
- HTML := HTML + ' underline ';
- if fsStrikeOut in TextFont.Style then
- HTML := HTML + ' line-through ';
- if IsEncry then
- begin
- if AnsiSameText(MainForm.RealICQClient.LoginName, SenderId) then
- MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '签收消息已发送' + '</a></span>'
- else
- MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '收到一条待签收消息' + '</a></span>'
- end
- else
- begin
- MsgContent := FilterHTMLCode(MessageStr, MainForm.AllowURL); //过滤HTML代码
- GetFaces(Self, SenderID, MsgContent, not (IsHistory or ShowSendFailed));
- end;
- //如果对方和自己的语言版本相同,则不要进行转换
- //此处的代码,应该要移到存储消息记录到数据库之前
- //if 自己是简体版 and 对方是繁体版 then MsgContent := BIG5toGB(MsgContent);
- //if 自己是繁体版 and 对方是简体版 then MsgContent := GBtoBIG5(MsgContent);
- HTML := HTML + '"><span id="' + ID + '">' + MsgContent + '</span> </DIV>';
- InsertHTML(WebBrowser, HTML);
- end;
- procedure TTalkingForm.AddMessageToWebBrowserTop(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
- var
- MsgContent, HexString, HTML, SenderColor: string;
- TextFont: TFont;
- ID: string;
- begin
- ID := IntToStr(GetTickCount);
- TextFont := TFont.Create;
- StringToFont(FontStr, TextFont);
- MsgContent := FilterHTMLCode(SenderName, MainForm.AllowURL);
- if Category = tcTeam then
- MsgContent := MsgContent + '(<a href="OpenRightMenu,' + SenderId + '">' + Copy(SenderId, Pos('-', SenderId) + 1, Length(SenderId)) + '</a>)';
- if CompareDate(Now, SendDateTime) = EqualsValue then
- MsgContent := MsgContent + ' ' + TimeToStr(SendDateTime)
- else
- MsgContent := MsgContent + ' ' + DateTimeToStr(SendDateTime);
- if ShowSendFailed then
- MsgContent := MsgContent + '(发送消息超时)'
- else if (not AnsiSameText(SenderID, MainForm.RealICQClient.LoginName)) and (not IsHistory) then
- MsgContent := MsgContent + ' <a href="about:blankAddToWebRemark://_' + ID + '" title="添加至备忘录"><img src="' + ExtractFilePath(Application.ExeName) + Action_Paste_GIF + '" width="16" height="16" hspace="1" align="absBottom" border="0"></a><br>';
- if not IsHistory then
- begin
- if AnsiSameText(SenderID, FReceiver) then
- SenderColor := '#009900'
- else
- SenderColor := '#0000FF';
- end
- else
- SenderColor := '#686868';
- HTML := '<DIV style="padding-bottom:2px; padding-top:2px; color:' + SenderColor + '">' + MsgContent + '</DIV>';
- HTML := HTML + '<DIV style="padding-left:9px; padding-bottom:2px;';
- //设置字体
- HTML := HTML + ';font-family:' + TextFont.Name;
- HexString := IntToHex(TextFont.Color, 6); //获取颜色的16进制格式
- HTML := HTML + ';color:#' + Copy(HexString, 5, 2) + Copy(HexString, 3, 2) + Copy(HexString, 1, 2); //将BGR颜色转换为RGB颜色
- HTML := HTML + ';font-size:' + IntToStr(TextFont.Size) + 'pt';
- if fsBold in TextFont.Style then
- HTML := HTML + ';font-weight:bold';
- if fsItalic in TextFont.Style then
- HTML := HTML + ';font-style:italic';
- HTML := HTML + ';text-decoration:';
- if fsUnderline in TextFont.Style then
- HTML := HTML + ' underline ';
- if fsStrikeOut in TextFont.Style then
- HTML := HTML + ' line-through ';
- if IsEncry then
- begin
- if AnsiSameText(MainForm.RealICQClient.LoginName, SenderId) then
- MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '签收消息已发送' + '</a></span>'
- else
- MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '收到一条待签收消息' + '</a></span>'
- end
- else
- begin
- MsgContent := FilterHTMLCode(MessageStr, MainForm.AllowURL); //过滤HTML代码
- GetFaces(Self, SenderID, MsgContent, not (IsHistory or ShowSendFailed));
- end;
- //如果对方和自己的语言版本相同,则不要进行转换
- //此处的代码,应该要移到存储消息记录到数据库之前
- //if 自己是简体版 and 对方是繁体版 then MsgContent := BIG5toGB(MsgContent);
- //if 自己是繁体版 and 对方是简体版 then MsgContent := GBtoBIG5(MsgContent);
- HTML := HTML + '"><span id="' + ID + '">' + MsgContent + '</span> </DIV>';
- InsertHTMLTop(WebBrowser, HTML);
- end;
- {显示群组消息}
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean = False);
- var
- AFileName, AMessageStr: string;
- SenderName: string;
- FRealICQUser: TRealICQUser;
- HTML: string;
- Alias: string;
- begin
- Alias := TTeamsAdapter.GetAlias(RealICQTeamMessage.TeamID, RealICQTeamMessage.Sender);
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(RealICQTeamMessage.Sender);
- if Alias = '' then
- begin
- if Length(Trim(FRealICQUser.DisplayName)) = 0 then
- SenderName := FRealICQUser.LoginName
- else
- SenderName := FRealICQUser.DisplayName;
- end
- else
- SenderName := Alias;
- if Copy(RealICQTeamMessage.MessageStr, 1, 11) = '<TeamShare>' then
- begin
- if Copy(RealICQTeamMessage.MessageStr, Length(RealICQTeamMessage.MessageStr) - 11, 12) = '</TeamShare>' then
- begin
- HTML := '<table width="100%" style="font-size:9pt;border:0px; padding:2px; color:#000000; margin-top:2px;margin-bottom:5px;"><tr><td>';
- HTML := HTML + '<img src="' + ExtractFilePath(Application.ExeName) + TeamSharePic + '" align="absmiddle"> ';
- HTML := HTML + '<span>';
- AFileName := ReplaceStr(ReplaceStr(RealICQTeamMessage.MessageStr, '<TeamShare>', ''), '</TeamShare>', '');
- HTML := HTML + FilterHtmlCode(SenderName, MainForm.AllowURL) + ' 共享了文件:' + AFileName + ' <a href="ShowTeamShare_' + AFileName + '" title="点击查看群共享空间" >查看</a> ';
- HTML := HTML + '</span>';
- HTML := HTML + '</td></tr></table>';
- InsertHTML(WebBrowser, HTML);
- Exit;
- end;
- end;
- if RealICQTeamMessage.IsEncryMessage then
- begin
- AMessageStr := IntToStr(RealICQTeamMessage.ID)
- end
- else
- AMessageStr := RealICQTeamMessage.MessageStr;
- AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, RealICQTeamMessage.FontStr, AMessageStr, RealICQTeamMessage.SendDateTime, RealICQTeamMessage.IsEncryMessage, ShowSendFailed);
- end;
- {显示消息}
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean = False);
- var
- SenderName, AMessageStr: string;
- FRealICQUser: TRealICQUser;
- begin
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(RealICQMessage.Sender);
- if Length(Trim(FRealICQUser.DisplayName)) = 0 then
- SenderName := FRealICQUser.LoginName
- else
- SenderName := FRealICQUser.DisplayName;
- if RealICQMessage.IsEncryMessage then
- begin
- AMessageStr := IntToStr(RealICQMessage.ID)
- end
- else
- AMessageStr := RealICQMessage.MessageStr;
- AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, RealICQMessage.FontStr, AMessageStr, RealICQMessage.SendDateTime, RealICQMessage.IsEncryMessage, ShowSendFailed);
- if AnsiSameText(RealICQMessage.Sender, Receiver) then
- begin
- ClearInputtingMessageTimerTimer(nil);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ImgHideShowUserInformationClick(Sender: TObject);
- begin
- imgHideShowUserInformation.Enabled := False;
- try
- if pnlUserInformation.Width = 0 then
- begin
- Width := Width + FOldWidthOfUserInfo;
- pnlUserInformation.Width := FOldWidthOfUserInfo;
- end
- else
- begin
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- pnlUserInformation.Width := 0;
- Width := Width - FOldWidthOfUserInfo;
- end;
- finally
- imgHideShowUserInformation.Enabled := True;
- ShowspbShowHideUserInformationState;
- if ImgHideShowUserInformation.Hint = '隐藏侧边' then
- ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'HideBmp')
- else
- ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'ShowBmp');
- ConvertBitmapToColor(ImgHideShowUserInformation.Picture.Bitmap, MainForm.UIMainColor);
- ImgHideShowUserInformation.Invalidate;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowSpbShowHideUserInformationState;
- begin
- if pnlUserInformation.Width = 0 then
- begin
- imgHideShowUserInformation.Hint := '显示侧边';
- end
- else
- begin
- imgHideShowUserInformation.Hint := '隐藏侧边';
- end;
- end;
- procedure TTalkingForm.ImgHideShowUserInformationMouseEnter(Sender: TObject);
- begin
- if ImgHideShowUserInformation.Hint = '隐藏侧边' then
- ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'HideBmp')
- else
- ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'ShowBmp');
- ConvertBitmapToColor(ImgHideShowUserInformation.Picture.Bitmap, MainForm.UIMainColor);
- ImgHideShowUserInformation.Invalidate;
- end;
- procedure TTalkingForm.ImgHideShowUserInformationMouseLeave(Sender: TObject);
- begin
- ImgHideShowUserInformation.Picture.Bitmap := nil;
- ImgHideShowUserInformation.Invalidate;
- end;
- procedure TTalkingForm.InsertFaceToRichEdit(Face: TFace; FaceID: Integer);
- var
- Sys32Dir: string;
- pSys32Dir: array[0..Max_Path] of char;
- begin
- try
- RichEdInputer.InsertImage(Face.FileName, FaceID);
- except
- on e: exception do
- begin
- GetSystemDirectory(pSys32Dir, Max_Path);
- Sys32Dir := StrPas(pSys32Dir);
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ImageX2_DLL_PACH), PChar(Sys32Dir + '\ImageX2.dll'), False);
- try
- WinExec(PChar('regsvr32 /s "' + 'ImageX2.dll"'), SW_HIDE);
- except
- end;
- Sleep(500);
- RichEdInputer.InsertImage(Face.FileName, FaceID);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ChangeUIColor(AColor: TColor);
- begin
- inherited ChangeUIColor(AColor);
- spbCloseTeamWebDisk.ChangeUIColor(AColor);
- PnlShowHideUserInfo.Color := FormColor;
- pnlClient.Color := FormColor;
- //pnlMenu.Color := FormColor;
- pnlUserInformation.Color := FormColor;
- pnlTalkingArea.Color := FormColor;
- //Splitter1.Color := ConvertColorToColor(Splitter1.Color, AColor);
- Panel5.Color := FormColor;
- ConvertBitmapToColor(ImgInputerTopLeft.Picture.Bitmap, AColor);
- ImgInputerTopLeft.Invalidate;
- ConvertBitmapToColor(ImgInputerTopRight.Picture.Bitmap, AColor);
- ImgInputerTopRight.Invalidate;
- //pnlForActionMainMenuBar.Color := FormColor;
- pnlForActionToolBar.Color := FormColor;
- pnlTeamMembers.Color := FormColor;
- pnlTeamCallBoard.Color := FormColor;
- //ActionMainMenuBar.ColorMap.Color := FormColor;
- //ActionMainMenuBar.ColorMap.SelectedColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.SelectedColor, AColor);
- //ActionMainMenuBar.ColorMap.BtnFrameColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.BtnFrameColor, AColor);
- //ActionMainMenuBar.Font.Name := '宋体';
- //ActionMainMenuBar.Font.Size := 9;
- if FVCardFrom <> nil then
- FVCardFrom.ChangeUIColor(AColor);
- spbAddUser.ChangeUIColor(AColor);
- spbSendFile.ChangeUIColor(AColor);
- spbAudio.ChangeUIColor(AColor);
- spbVideo.ChangeUIColor(AColor);
- spbSeeTeamOptions.ChangeUIColor(AColor);
- spbQuitTeam.ChangeUIColor(AColor);
- spbDisbandTeam.ChangeUIColor(AColor);
- spbUploadFile.ChangeUIColor(AColor);
- spbRemoteControl.ChangeUIColor(AColor);
- spbSendFolder.ChangeUIColor(AColor);
- spbTeamNetWorkDisk.ChangeUIColor(AColor);
- spbSendSMS.ChangeUIColor(AColor);
- spbPostSMS.ChangeUIColor(AColor);
- spbUserInfo.ChangeUIColor(AColor);
- spbSet.ChangeUIColor(AColor);
- spbAbout.ChangeUIColor(AColor);
- btnQR.ChangeUIColor(AColor);
- spbSelUIColor.ChangeUIColor(AColor);
- spbUploadTeamFile.ChangeUIColor(AColor);
- spbUploadTeamFileProcess.ChangeUIColor(AColor);
- ConvertBitmapToColor(imgToolbarBack.Picture.Bitmap, AColor);
- imgToolbarBack.Invalidate;
- ConvertBitmapToColor(ImgDisplayerTopLeft.Picture.Bitmap, AColor);
- ImgDisplayerTopLeft.Invalidate;
- ConvertBitmapToColor(ImgDisplayerTopRight.Picture.Bitmap, AColor);
- ImgDisplayerTopRight.Invalidate;
- ConvertBitmapToColor(imgTeamWebDiskToolbarBack.Picture.Bitmap, AColor);
- imgTeamWebDiskToolbarBack.Invalidate;
- ShpDisplayerTopMiddle.Pen.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Pen.Color, AColor);
- ShpDisplayerTopMiddle.Brush.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Brush.Color, AColor);
- ShpDisplayerClient.Pen.Color := ConvertColorToColor(ShpDisplayerClient.Pen.Color, AColor);
- ConvertBitmapToColor(ImgInputerTopLeft.Picture.Bitmap, AColor);
- ImgInputerTopLeft.Invalidate;
- //ConvertBitmapToColor(ImgInputerTopMiddle.Picture.Bitmap, AColor);
- //ImgInputerTopMiddle.Invalidate;
- ConvertBitmapToColor(ImgInputerTopRight.Picture.Bitmap, AColor);
- ImgInputerTopRight.Invalidate;
- //ConvertBitmapToColor(ImgInputerBottomLeft.Picture.Bitmap, AColor);
- //ImgInputerBottomLeft.Invalidate;
- //ConvertBitmapToColor(ImgInputerBottomMiddle.Picture.Bitmap, AColor);
- //ImgInputerBottomMiddle.Invalidate;
- //ConvertBitmapToColor(ImgInputerBottomRight.Picture.Bitmap, AColor);
- //ImgInputerBottomRight.Invalidate;
- //ConvertBitmapToColor(ImgMyVideoBorder.Picture.Bitmap, AColor);
- //ImgMyVideoBorder.Invalidate;
- //ConvertBitmapToColor(ImgYourVideoBorder.Picture.Bitmap, AColor);
- //ImgYourVideoBorder.Invalidate;
- ShpInputerClient.Pen.Color := ConvertColorToColor(ShpInputerClient.Pen.Color, AColor);
- //ConvertBitmapToColor(ImgHeadBorderForMyInfo.Picture.Bitmap, AColor);
- //ImgHeadBorderForMyInfo.Invalidate;
- SpbForMyInfo.ChangeUIColor(AColor);
- //rndMyInfo.ChangeUIColor(AColor);
- //pgcMyInfo.Color := rndMyInfo.BackColor;
- //ConvertBitmapToColor(ImgHeadBorderForYourInfo.Picture.Bitmap, AColor);
- //ImgHeadBorderForYourInfo.Invalidate;
- SpbForYourInfo.ChangeUIColor(AColor);
- //pgcYourInfo.Color := rndYourInfo.BackColor;
- //rndYourInfo.ChangeUIColor(AColor);
- SpbForTeamMemberInfo.ChangeUIColor(AColor);
- PnlTeamWebDisk.Color := FormColor;
- RndTeamWebDisk.ChangeUIColor(AColor);
- rndTeamMembers.ChangeUIColor(AColor);
- rndTeamCallBoard.ChangeUIColor(AColor);
- lblTeamMemberCount.Font.Color := ConvertColorToColor(lblTeamMemberCount.Font.Color, AColor);
- rndTeamMemberContainer.ChangeUIColor(AColor);
-
- //ShpHint.Pen.Color := ConvertColorToColor(ShpHint.Pen.Color, AColor);
- //CardYour.ChangeUIColor(AColor);
- //CardMine.ChangeUIColor(AColor);
- btSend.ChangeUIColor(AColor);
- btCloseTalk.ChangeUIColor(AColor);
- btDownArrow.ChangeUIColor(AColor);
- spbFont.ChangeUIColor(AColor);
- spbFace.ChangeUIColor(AColor);
- spbSendImage.ChangeUIColor(AColor);
- spbCopyScreen.ChangeUIColor(AColor);
- //spbCopyScreen2.ChangeUIColor(AColor);
- spbShakeWindow.ChangeUIColor(AColor);
- spbBackground.ChangeUIColor(AColor);
- spbHistroyMessage.ChangeUIColor(AColor);
- spbNormalMsg.ChangeUIColor(AColor);
- spbEncryMsg.ChangeUIColor(AColor);
- MicrophoneVolume.ChangeUIColor(AColor);
- //MicrophoneVolume.Color := rndMyInfo.BackColor;
- MasterVolume.ChangeUIColor(AColor);
- //MasterVolume.Color := rndYourInfo.BackColor;
- rndMyInfo.BorderColor := ConvertColorToColor(rndMyInfo.BorderColor, AColor);
- rndYourInfo.BorderColor := ConvertColorToColor(rndYourInfo.BorderColor, AColor);
- spbSpk.ChangeUIColor(AColor);
- spbMic.ChangeUIColor(AColor);
- if FLVTeamMembers <> nil then
- FLVTeamMembers.ChangeUIColor(AColor);
- if VideoForm <> nil then
- begin
- if VideoForm.TalkingForm = Self then
- VideoForm.ChangeUIColor(AColor);
- end;
- try
- FWindowColor := AColor;
- if not WebBrowser.Busy then
- SetDomStyle(WebBrowser.Document as IHtmlDocument2);
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ClearInputtingMessageTimerTimer(Sender: TObject);
- var
- RealICQUser: TRealICQUser;
- UserName: string;
- begin
- lblState.Caption := '';
- if FCategory = tcNormal then
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(RealICQUser) then
- UserName := FReceiver
- else if RealICQUser.DisplayName = '' then
- UserName := RealICQUser.LoginName
- else
- UserName := RealICQUser.DisplayName;
- Caption := UserName;
- PostMessage(Handle, WM_SIZE, 0, 0);
- end;
- end;
- procedure TTalkingForm.EditFontSetExecute(Sender: TObject);
- begin
- FontDialog.Font := RichEdInputer.Font;
- if FontDialog.Execute then
- begin
- RichEdInputer.Font := FontDialog.Font;
- MainForm.InputFont := RichEdInputer.Font;
- RichEdInputer.DisableAlign;
- try
- PostMessage(RichEdInputer.Handle, WM_SIZE, 0, 0);
- finally
- RichEdInputer.EnableAlign;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- Action := caFree;
- FreeAndNil(FTeamUpLoadFile);
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.CheckNotCompletedMission: Integer;
- begin
- Result := 0;
- //是否有音频对话任务未结束
- if FAudioMission <> nil then
- Inc(Result);
- //是否有音频对话任务未结束
- if FVideoMission <> nil then
- Inc(Result);
- //是否有文件传输任务未结束
- Inc(Result, FTransmiteFileMissions.Count);
-
- //是否有文件传输任务未结束
- Inc(Result, FUpDownFileMissions.Count);
- //是否有远程协助任务未结束
- if FRemoteControlMission <> nil then
- Inc(Result);
- //是否有离线文件传输任务未结束
- Inc(Result, FNodeTransferMissions.Count);
- end;
- procedure TTalkingForm.CloseAllMissions;
- var
- iLoop: Integer;
- WaitingFace: TWaitingFace;
- begin
- try
-
- {$region '结束音频对话'}
- try
- if FAudioMission <> nil then
- begin
- if FAudioMission.FAccepted then
- FRealICQClient.StopAudioTransmitter(Receiver)
- else if FAudioMission.FIsSource then
- FRealICQClient.CancelAudioTransmitter(Receiver)
- else
- FRealICQClient.DeclineAudioTransmitter(Receiver);
- end;
- except
- end;
- {$endregion}
- {$region '结束视频对话'}
- try
- if FVideoMission <> nil then
- begin
- if FVideoMission.FAccepted then
- FRealICQClient.StopVideoTransmitter(Receiver)
- else if FVideoMission.FIsSource then
- FRealICQClient.CancelVideoTransmitter(Receiver)
- else
- FRealICQClient.DeclineVideoTransmitter(Receiver);
- end;
- except
- end;
- {$endregion}
- {$region '结束程协助'}
- try
- if FRemoteControlMission <> nil then
- begin
- if FRemoteControlMission.FAccepted then
- FRealICQClient.StopRemoteControlTransmitter(Receiver)
- else if FRemoteControlMission.FIsSource then
- FRealICQClient.CancelRemoteControlTransmitter(Receiver)
- else
- FRealICQClient.DeclineRemoteControlTransmitter(Receiver);
- for iLoop := 0 to 10 do
- begin
- Sleep(50);
- Application.ProcessMessages;
- end;
- end;
- except
- end;
- {$endregion}
- {$region '结束文件传输'}
- try
- CancelAllSendFile;
- except
- end;
- {$endregion}
- {$region '结束离线文件传输'}
- try
- CancelAllUpDdownFile;
- except
- end;
- {$endregion}
- {$region '删除等待表情的任务'}
- for iLoop := WaitingFaces.Count - 1 downto 0 do
- begin
- WaitingFace := WaitingFaces.Objects[iLoop] as TWaitingFace;
- if WaitingFace.WebBrowser = Self.WebBrowser then
- begin
- WaitingFaces.Delete(iLoop);
- FreeAndNil(WaitingFace);
- end;
- end;
- {$endregion}
- {$region '结束Node文件传输'}
- try
- CancelAllUpDdownNodeFile;
- except
- end;
- {$endregion}
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- var
- NotCompletedMission, iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- try
- if FCategory = tcTeam then
- begin
- iIndex := FRealICQClient.Teams.IndexOf(FTeamID);
- if iIndex = -1 then
- Exit;
- ATeam := FRealICQClient.Teams.Objects[iIndex] as TRealICQTeam;
- if ATeam.IsTempTeam then
- begin
- if AnsiSameText(ATeam.TeamCreater, FRealICQClient.LoginName) then
- begin
- if MessageBox(Handle, '关闭窗口将会解散该临时群组会话,确定要关闭吗? ', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- begin
- CanClose := False;
- Exit;
- end
- else
- begin
- FRealICQClient.DisbandTeam(FTeamID);
- end;
- end
- else
- begin
- if MessageBox(Handle, '闭窗口将会解散该临时群组会话,确定要关闭吗? ', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- begin
- CanClose := False;
- Exit;
- end
- else
- begin
- FRealICQClient.QuitTeam(FTeamID);
- end;
- end;
- end;
- NotCompletedMission := CheckNotCompletedMission;
- if NotCompletedMission > 0 then
- begin
- if MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个任务未结束,确定要关闭窗口吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- begin
- CanClose := False;
- Exit;
- end;
- end;
- CloseAllMissions;
- end
- else
- begin
- NotCompletedMission := CheckNotCompletedMission;
- if NotCompletedMission > 0 then
- begin
- if MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个任务未结束,确定要关闭窗口吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- begin
- CanClose := False;
- Exit;
- end;
- end;
- CloseAllMissions;
- end;
- except
- end;
- CanClose := True;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FormCreate(Sender: TObject);
- var
- iLoop: Integer;
- begin
- FMaxID := MaxInt;
- FTeamUpLoadFile := TUpLoadFile.Create;
- FTeamUpLoadFile.OnProgress := TeamUpFileProgress;
- FTeamUpLoadFile.OnComplete := DownFileComplete;
- TalkingForms.Add(Self);
- ImagesList := TList.Create;
- DoubleBuffered := True;
- // pnlClient.DoubleBuffered := True;
- // pnlToolBar.DoubleBuffered := True;
- //pnlMenu.DoubleBuffered := True;
- for iLoop := 0 to Self.ControlCount - 1 do
- if Self.Controls[iLoop] is TWinControl then
- (Self.Controls[iLoop] as TWinControl).DoubleBuffered := True;
- // pnlUserInformation.DoubleBuffered := True;
- // pnlTalkingArea.DoubleBuffered := True;
- // pnlInputer.DoubleBuffered := True;
- // pnlDisplayer.DoubleBuffered := True;
- // pnlMyInfo.DoubleBuffered := True;
- // pnlYourInfo.DoubleBuffered := True;
- // pnlHint.DoubleBuffered := True;
- // pnlForWebBrowser.DoubleBuffered := True;
- // tsMyHeadImage.DoubleBuffered := True;
- // tsYourHeadImage.DoubleBuffered := True;
- // btSend.DoubleBuffered := True;
- // WebBrowser.DoubleBuffered := False;
- // tsYourVideo.DoubleBuffered := True;
- // tsMyVideo.DoubleBuffered := True;
- // ImgYourVideo.Parent.DoubleBuffered := True;
- //ImgYourVideoBorder.Parent.DoubleBuffered := True;
- // ImgMyVideo.Parent.DoubleBuffered := True;
- //ImgMyVideoBorder.Parent.DoubleBuffered := True;
- // pnlForActionToolBar.DoubleBuffered := True;
- // pnlInputeBack.DoubleBuffered := True;
- // RichEdInputer.DoubleBuffered := True;
- TTalkFormController.GetController.ChangeStyle(Self);
- for iLoop := 0 to RichEdInputer.ControlCount - 1 do
- begin
- if RichEdInputer.Controls[iLoop] is TWinControl then
- TWinControl(RichEdInputer.Controls[iLoop]).DoubleBuffered := True;
- end;
- // RichEdInputer.Parent.DoubleBuffered := True;
- //pnlSendButtonBack.DoubleBuffered := True;
- FLastSendMsgTicket := 0;
- FVCardFrom := TVCardForm.Create(Self);
- FReceiver := '';
- FTeamID := '';
- Left := MainForm.TalkingFormLeft;
- Top := MainForm.TalkingFormTop;
- Width := MainForm.TalkingFormWidth - pnlRC.Width - SplitterRC.Width;
- Height := MainForm.TalkingFormHeight;
- if Left < 0 then
- Left := 0;
- if Left + Width > Screen.WorkAreaWidth then
- Left := Screen.WorkAreaWidth - Width;
- if Top < 0 then
- Top := 0;
- if Top + Height > Screen.WorkAreaHeight then
- Top := Screen.WorkAreaHeight - Height;
- FLastSendInputtingMessageTicket := 0;
- FormStyle := fsNormal;
- actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage;
- actEnter.Checked := not MainForm.CtrlEnterSendMessage;
- actCopyScreenHideForm.Checked := MainForm.CopyScreenHideTalkForm;
- FAudioMission := nil;
- FTransmiteFileMissions := TList.Create;
- FUpDownFileMissions := TList.Create;
- FNodeTransferMissions := TList.Create;
- FFileTransmitters := TStringList.Create;
- RichEdInputer.MaxLength := MaxMessageLength;
- RichEdInputer.DoubleBuffered := False;
- RichEdInputer.Color := 16645629;
- RichEdInputer.Font := MainForm.InputFont;
- FSender := '';
- FReceiver := '';
- SkinName := AnsiReplaceText(MainForm.SkinName, 'MainForm', '');
- FWindowColor := MainForm.UIMainColor;
- //ChangeUIColor(FWindowColor);
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- FMinWidthOfYourPanel := 114;
- FMinWidthOfMyPanel := 114;
- FLastSendShakeWindowTicket := 0;
- ShowSpbShowHideUserInformationState;
- LoadOfflinefilesConfig;
- //Exit;
- WebBrowser.OnBeforeNavigate2 := nil;
- WebBrowser.Navigate(ExtractFilePath(paramstr(0)) + 'html\chat.html');
- FBaseURL := ExtractFilePath(paramstr(0)) + 'html\';
- FBaseURL := UpperCase(FBaseURL);
- WebBrowser.OnBeforeNavigate2 := WebBrowserBeforeNavigate2;
- DragAcceptFiles(Handle, True);
- DragAcceptFiles(RichEdInputer.Handle, True);
- DragAcceptFiles(WebBrowser.Handle, True);
- DragAcceptFiles(RichEditTemp.Handle, True);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FormDestroy(Sender: TObject);
- begin
- try
- try
- if FVCardFrom <> nil then
- FreeAndNil(FVCardFrom);
- if WindowState <> wsMaximized then
- begin
- MainForm.TalkingFormLeft := Left;
- MainForm.TalkingFormTop := Top;
- MainForm.TalkingFormWidth := Width;
- MainForm.TalkingFormHeight := Height;
- MainForm.SaveDefaultConfigs;
- end;
- CloseAllMissions;
- while (ImagesList.Count > 0) do
- begin
- dispose(ImagesList.First);
- ImagesList.Delete(0);
- end;
- ImagesList.Free;
- finally
- TalkingForms.Remove(Self);
- FreeAndNil(FTransmiteFileMissions);
- FreeAndNil(FUpDownFileMissions);
- FreeAndNil(FNodeTransferMissions);
- FreeAndNil(FFileTransmitters);
- end;
- FLVTeamMembers.Items.Clear;
- //if FLVTeamMembers <> nil then FreeAndNil(FLVTeamMembers);
- except
- end;
- end;
- procedure TTalkingForm.FormResize(Sender: TObject);
- begin
- ImgHideShowUserInformation.Top := (PnlShowHideUserInfo.Height - ImgHideShowUserInformation.Height) div 2 - 20;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.FormShow(Sender: TObject);
- var
- iWaitTimes: Integer;
- begin
- if TConditionConfig.GetConfig.GradeSystem and (FCategory = tcNormal) then
- begin
- btCloseTalk.Caption := '邀请评分';
- btCloseTalk.Width := 96;
- btCloseTalk.Left := 233;
- end;
- pnlRC.Visible := False;
- SplitterRC.Visible := False;
- pnlTalkingArea.Align := alLeft;
- pnlTalkingArea.Align := alClient;
- Left := MainForm.TalkingFormLeft;
- Top := MainForm.TalkingFormTop;
- Width := MainForm.TalkingFormWidth;
- Height := MainForm.TalkingFormHeight;
- if Left < 0 then
- Left := 0;
- if Left + Width > Screen.WorkAreaWidth then
- Left := Screen.WorkAreaWidth - Width;
- if Top < 0 then
- Top := 0;
- if Top + Height > Screen.WorkAreaHeight then
- Top := Screen.WorkAreaHeight - Height;
- Application.ProcessMessages;
- iWaitTimes := 0;
- while not CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- try
- LoadNotReadMessages;
- except
- end;
- LoadAdvertisement;
- FreeAndNil(UserCardForm);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.lblDestClick(Sender: TObject);
- begin
- if FCategory = tcNormal then
- miSeeYourDetailInformationClick(nil)
- else
- miSeeTeamDetailInformationClick(nil);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- lblDest.Left := lblDest.Left + 1;
- lblDest.Top := lblDest.Top + 1;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.lblDestMouseEnter(Sender: TObject);
- begin
- lblDest.Cursor := crHandPoint;
- lblDest.Font.Style := [fsUnderline]
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.lblDestMouseLeave(Sender: TObject);
- begin
- lblDest.Cursor := crDefault;
- lblDest.Font.Style := []
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- lblDest.Left := lblDest.Left - 1;
- lblDest.Top := lblDest.Top - 1;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ChangePopupActionBarColor(PopupActionBar: TPopupActionBar);
- begin
- PopupActionBar.PopupMenu.ColorMap.Color := FormColor;
- PopupActionBar.PopupMenu.ColorMap.SelectedColor := ConvertColorToColor(PopupActionBar.PopupMenu.ColorMap.SelectedColor, FWindowColor);
- PopupActionBar.PopupMenu.ColorMap.BtnFrameColor := ConvertColorToColor(PopupActionBar.PopupMenu.ColorMap.BtnFrameColor, FWindowColor);
- PopupActionBar.PopupMenu.Font.Name := '宋体';
- PopupActionBar.PopupMenu.Font.Size := 9;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppAudioSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppAudioSet);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppColors);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppColorsPopup(Sender: TObject);
- var
- iLoop: Integer;
- ColorStr: string;
- MenuItem: TMenuItem;
- Bitmap: TBitmap;
- begin
- MainForm.ImgLstColors.Clear;
- while ppColors.Items.Count > 2 do
- ppColors.Items.Delete(0);
- Bitmap := TBitmap.Create;
- Bitmap.SetSize(16, 16);
- try
- for iLoop := MainForm.ColorDialog.CustomColors.Count - 1 downto 0 do
- begin
- ColorStr := Copy(MainForm.ColorDialog.CustomColors[iLoop], 8, 6);
- if ColorStr = 'FFFFFF' then
- continue;
- ColorStr := '$00' + ColorStr;
- Bitmap.Canvas.Pen.Color := clGray;
- Bitmap.Canvas.Pen.Style := psSolid;
- Bitmap.Canvas.Brush.Color := StrToInt(ColorStr);
- Bitmap.Canvas.Brush.Style := bsSolid;
- Bitmap.Canvas.Rectangle(0, 0, Width, Height);
- MainForm.ImgLstColors.Add(Bitmap, nil);
- MenuItem := TMenuItem.Create(ppColors);
- MenuItem.Caption := '颜色' + IntToStr(iLoop);
- MenuItem.Tag := StrToInt(ColorStr);
- MenuItem.ImageIndex := MainForm.ImgLstColors.Count - 1;
- MenuItem.OnClick := miColorClick;
- MenuItem.Enabled := MenuItem.Tag <> FWindowColor;
- MenuItem.Checked := MenuItem.Tag = FWindowColor;
- if MenuItem.Checked then
- MenuItem.ImageIndex := -1;
- ppColors.Items.Insert(0, MenuItem);
- end;
- finally
- Bitmap.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppForDownGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForDown);
- end;
- procedure TTalkingForm.ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForInputer);
- end;
- procedure TTalkingForm.ppForInputerImgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForInputerImg);
- end;
- procedure TTalkingForm.ppForInputerImgPopup(Sender: TObject);
- begin
- ppForInputerImg.Tag := 1;
- end;
- procedure TTalkingForm.ppForMsgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForMsg);
- end;
- procedure TTalkingForm.ppForSnapGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForSnap);
- end;
- procedure TTalkingForm.ppForTeamMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForTeamMenu);
- end;
- procedure TTalkingForm.ppForTeamMenuPopup(Sender: TObject);
- begin
- ppForTeamMenu.Items[1].Enabled := HasMobilePhone(ALoginName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForWebBrowser);
- if WebBrowser.OleObject.Document.queryCommandEnabled('Copy') then
- miCopyFromIE.Enabled := True
- else
- miCopyFromIE.Enabled := False;
- miSaveToWeb.Enabled := miCopyFromIE.Enabled;
- if not miCopyFromIE.Enabled then
- miCopyFromIE.Enabled := actSaveImgAs.Enabled;
- end;
- procedure TTalkingForm.ppForWebBrowserPopup(Sender: TObject);
- begin
- ppForInputerImg.Tag := 0;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppMyOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppMyOptions);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppUserItemRightMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppUserItemRightMenuPopup(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- miSendMessage.Visible := FLVTeamMembers.SelCount = 1;
- miSeeUserInformation.Visible := FLVTeamMembers.SelCount = 1;
- for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do
- begin
- ListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- ALoginName := ListItem.LoginName;
- ppUserItemRightMenu.Items[1].Enabled := HasMobilePhone(ALoginName);
- Break;
- end;
- end;
- if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
- begin
- ppUserItemRightMenu.Items[4].Enabled := True;
- end
- else
- ppUserItemRightMenu.Items[4].Enabled := False;
- if MainForm.RealICQClient.LoginName = ALoginName then
- ppUserItemRightMenu.Items[4].Enabled := True;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ppYourOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppYourOptions);
- end;
- procedure TTalkingForm.ppForSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePopupActionBarColor(ppForSet);
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.GetInputerLength: Integer;
- var
- Face: TFace;
- iLoop, InputerLength: Integer;
- FaceInRichEdit: TFaceInRichEdit;
- FaceIndexes: TIndexes;
- begin
- InputerLength := Length(Trim(RichEdInputer.Text));
- FaceIndexes := RichEdInputer.GetFaceIndexes;
- for iLoop := 0 to Length(FaceIndexes) - 1 do
- begin
- FaceInRichEdit := FaceIndexes[iLoop];
- if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
- Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
- else
- Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
- if FaceInRichEdit.FaceIndex < MainForm.SystemFaceCount then
- Inc(InputerLength, Length(Face.ShortCut))
- else
- Inc(InputerLength, 38);
- end;
- Result := InputerLength;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CreateTeamResult(Sender: TObject; ATeamCaption: string; ACreated: Boolean; ATeamID: string; AFailingCause: string);
- begin
- if ACreated then
- begin
- tsYourCardShow(nil);
- FCategory := tcTeam;
- TeamID := ATeamID;
- end;
- end;
- procedure TTalkingForm.actSaveImgAsExecute(Sender: TObject);
- var
- Face: TFace;
- begin
- if ppForInputerImg.Tag = 1 then
- begin
- if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
- Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace
- else
- Face := MainForm.FaceList.Objects[FRightMouseClickedFace.FaceIndex] as TFace;
- SaveDialog.FileName := AnsiReplaceText(Face.FileName, ExtractFilePath(Face.FileName), '');
- if SaveDialog.Execute then
- begin
- CopyFile(PChar(Face.FileName), PChar(SaveDialog.FileName), False);
- end;
- end
- else
- begin
- SaveDialog.FileName := AnsiReplaceText(FFaceMenuAtFileName, ExtractFilePath(FFaceMenuAtFileName), '');
- if SaveDialog.Execute then
- begin
- CopyFile(PChar(FFaceMenuAtFileName), PChar(SaveDialog.FileName), False);
- end;
- end;
- end;
- procedure TTalkingForm.actAddImageToCustomFacesExecute(Sender: TObject);
- var
- Face: TFace;
- begin
- if ppForInputerImg.Tag = 1 then
- begin
- if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
- begin
- Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace;
- end
- else
- begin
- MessageBox(Handle, '图片已在表情库中! ', '提示', MB_OK);
- Exit;
- end;
- if AddFaceForm <> nil then
- Exit;
- AddFaceForm := TAddFaceForm.Create(Self);
- with AddFaceForm do
- try
- OpenPictureDialog.FileName := Face.FileName;
- edFileNames.Text := Face.FileName;
- SelectedFileCount := 1;
- edName.Text := ReplaceStr(ExtractFileName(edFileNames.Text), ExtractFileExt(edFileNames.Text), '');
- edShortCut.Text := Copy(edName.Text, 1, 8);
- btBrowse.Enabled := False;
- if ShowModal = mrOK then
- begin
- Face := AddFaceForm.AddedFaces[0] as TFace;
- if Face = nil then
- Exit;
- if MainForm.FaceCategory.IndexOf(Face.Category) < 0 then
- begin
- if not AnsiSameText(Face.Category, NOFaceCategory) then
- begin
- MainForm.FaceCategory.Add(Face.Category);
- end
- else
- begin
- MainForm.FaceCategory.Insert(0, Face.Category);
- end;
- end;
- MainForm.SaveCustomFaceConfig;
- MessageBox(Handle, '表情添加成功! ', '提示', MB_ICONINFORMATION);
- end;
- finally
- FreeAndNil(AddFaceForm);
- end;
- end
- else
- begin
- if AddFaceForm <> nil then
- Exit;
- AddFaceForm := TAddFaceForm.Create(Self);
- with AddFaceForm do
- try
- OpenPictureDialog.FileName := FFaceMenuAtFileName;
- edFileNames.Text := FFaceMenuAtFileName;
- SelectedFileCount := 1;
- edName.Text := ReplaceStr(ExtractFileName(edFileNames.Text), ExtractFileExt(edFileNames.Text), '');
- edShortCut.Text := Copy(edName.Text, 1, 8);
- btBrowse.Enabled := False;
- if ShowModal = mrOK then
- begin
- Face := AddFaceForm.AddedFaces[0] as TFace;
- if Face = nil then
- Exit;
- if MainForm.FaceCategory.IndexOf(Face.Category) < 0 then
- begin
- if not AnsiSameText(Face.Category, NOFaceCategory) then
- begin
- MainForm.FaceCategory.Add(Face.Category);
- end
- else
- begin
- MainForm.FaceCategory.Insert(0, Face.Category);
- end;
- end;
- MainForm.SaveCustomFaceConfig;
- MessageBox(Handle, '表情添加成功! ', '提示', MB_ICONINFORMATION);
- end;
- finally
- FreeAndNil(AddFaceForm);
- end;
- end;
- end;
- procedure TTalkingForm.actAddUserExecute(Sender: TObject);
- var
- AddUserForm: TAddUserForm;
- AddedUsers: TStringList;
- iIndex, iLoop: Integer;
- LoginName: string;
- NotCompletedMission: Integer;
- begin
- if FCategory <> tcNormal then
- begin
- if not TTeamsAdapter.IsTeamManager(FTeamID, FRealICQClient.LoginName) then
- begin
- MessageBox(Handle, PChar('没有添加群组成员的权限!'), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- end;
- NotCompletedMission := CheckNotCompletedMission;
- if NotCompletedMission > 0 then
- begin
- MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个未结束的任务! '), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- AddUserForm := TAddUserForm.Create(Self);
- try
- if AddUserForm.ShowModal = mrOk then
- begin
- AddedUsers := AddUserForm.AddedUsers;
- try
- if AddedUsers.Count = 0 then
- Exit;
- if FCategory = tcNormal then
- begin
- AddedUsers.Insert(0, FRealICQClient.LoginName);
- if AddedUsers.IndexOf(FReceiver) = -1 then
- AddedUsers.Insert(1, FReceiver);
- if AddedUsers.Count > MaxTeamMemberCount then
- begin
- MessageBox(Handle, PChar('该群组成员人数不能超过 ' + IntToStr(MaxTeamMemberCount) + ' 人! '), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FRealICQClient.OnCreateTeamResult := CreateTeamResult;
- FRealICQClient.CreateTeam('多人对话', '', '', AddedUsers, True, tvAllCanJoinTeam);
- end
- else
- begin
- for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
- begin
- LoginName := FLVTeamMembers.Items[iLoop];
- if AddedUsers.IndexOf(LoginName) = -1 then
- AddedUsers.Insert(0, LoginName);
- end;
- if AddedUsers.Count > MaxTeamMemberCount then
- begin
- MessageBox(Handle, PChar('该群组成员人数不能超过 ' + IntToStr(MaxTeamMemberCount) + ' 人! '), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- TTeamsAdapter.AddTeamMembers(FTeamID, AddedUsers);
- end;
- finally
- FreeAndNil(AddedUsers);
- end;
- end;
- finally
- FreeAndNil(AddUserForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actEmptyWebExecute(Sender: TObject);
- begin
- ClearHTML(self.WebBrowser);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actAlwayOnTopExecute(Sender: TObject);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- // actAlwayOnTop.Checked := not actAlwayOnTop.Checked;
- // MainForm.TalkingFormAlwaysOnTop := actAlwayOnTop.Checked;
- //
- // for iLoop := TalkingForms.Count - 1 downto 0 do
- // begin
- // AForm := TalkingForms[iLoop];
- // AForm.actAlwayOnTop.Checked := actAlwayOnTop.Checked;
- // if actAlwayOnTop.Checked then
- // AForm.FormStyle := fsStayOnTop
- // else
- // AForm.FormStyle := fsStayOnTop;
- // end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actAudioExecute(Sender: TObject);
- begin
- if FAudioMission <> nil then
- begin
- MessageBox(Handle, '请先结束已连接的语音对话任务! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FRealICQClient.CreateAudioTransmitter(Receiver);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actVideoExecute(Sender: TObject);
- begin
- if FVideoMission <> nil then
- begin
- MessageBox(Handle, '请先结束已连接的视频对话任务! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FRealICQClient.CreateVideoTransmitter(Receiver);
- end;
- procedure TTalkingForm.actCloseExecute(Sender: TObject);
- begin
- Close;
- end;
- procedure TTalkingForm.actCopyScreenHideFormExecute(Sender: TObject);
- begin
- actCopyScreenHideForm.Checked := not actCopyScreenHideForm.Checked;
- MainForm.CopyScreenHideTalkForm := actCopyScreenHideForm.Checked;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actCtrlEnterExecute(Sender: TObject);
- begin
- actCtrlEnter.Checked := True;
- MainForm.CtrlEnterSendMessage := True;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actEnterExecute(Sender: TObject);
- begin
- actEnter.Checked := True;
- MainForm.CtrlEnterSendMessage := False;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actPageSetExecute(Sender: TObject);
- begin
- WebBrowser.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actPreviewExecute(Sender: TObject);
- begin
- if WebBrowser.QueryStatusWB(OLECMDID_PRINTPREVIEW) = 3 then
- WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actPrintExecute(Sender: TObject);
- begin
- WebBrowser.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actQuitTeamExecute(Sender: TObject);
- begin
- if MessageBox(Handle, PChar('确定要退出“' + Caption + '”吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) = ID_OK then
- begin
- TTeamsAdapter.QuitTeam(FTeamID);
- FCategory := tcNormal;
- Close;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actDisbandTeamExecute(Sender: TObject);
- begin
- if MessageBox(Handle, PChar('确定要解散“' + Caption + '”吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) = ID_OK then
- begin
- TTeamsAdapter.DisbandTeam(FTeamID);
- FCategory := tcNormal;
- Close;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actSaveAsHTMLFileExecute(Sender: TObject);
- var
- StringList: TStringList;
- begin
- SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd', Now()) + '.Html';
- if SaveDialog.Execute then
- begin
- StringList := TStringList.Create;
- try
- StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.innerHTML);
- StringList.SaveToFile(SaveDialog.FileName);
- finally
- StringList.Free;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actSaveAsTextFileExecute(Sender: TObject);
- var
- StringList: TStringList;
- begin
- SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd', Now()) + '.txt';
- if SaveDialog.Execute then
- begin
- StringList := TStringList.Create;
- try
- StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.OuterText);
- StringList.SaveToFile(SaveDialog.FileName);
- finally
- StringList.Free;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actSeeTeamOptionsExecute(Sender: TObject);
- begin
- miSeeTeamDetailInformation.Click;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actSendFileExecute(Sender: TObject);
- begin
- if not FRealICQClient.Connected or not FRealICQClient.Logined then
- Exit;
- OpenDialog.Title := '传输在线文件';
- if OpenDialog.Execute then
- begin
- SendFile(OpenDialog.FileName);
- end;
- end;
- //----发送文件-----------------------------------------------------------------
- procedure TTalkingForm.SendFile(FileName: string);
- //var
- // AFileStream: TFileStream;
- begin
- try
- {try
- AFileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
- if AFileStream.Size>=Int64(1024*1024*1024)*2 then
- begin
- MessageBox(0, PChar('在线发送文件大小不允许超过2G !'), '发送文件时出错', MB_ICONINFORMATION);
- PostMessage(Handle, WM_SETFOCUS, 0, 0);
- Exit;
- end;
- finally
- FreeAndNil(AFileStream);
- end;}
- FRealICQClient.SendFile(MainForm.UseCacheDir, MainForm.CacheDir, Receiver, FileName, foFile);
- except
- on E: Exception do
- MessageBox(0, PChar(E.Message), '传输文件时出错', MB_ICONINFORMATION);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actShowHistoryExecute(Sender: TObject);
- begin
- MainForm.OpenMessagesManagerForm;
- Application.ProcessMessages;
- if FCategory = tcNormal then
- MessagesManagerForm.ShowUsersMessages(FReceiver)
- else
- MessagesManagerForm.ShowTeamsMessages(FTeamID);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actStopVideoExecute(Sender: TObject);
- begin
- if FVideoMission <> nil then
- FVideoMission.Stop;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ApplicationEventsException(Sender: TObject; E: Exception);
- begin
- //
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbSendImageClick(Sender: TObject);
- var
- AFileName: string;
- begin
- try
- if OpenPictureDialog.Execute then
- begin
- AFileName := OpenPictureDialog.FileName;
- AddImageToInput(AFileName, RichEdInputer);
- end;
- except
- on E: Exception do
- MessageBox(Handle, PChar('发送图片出错:' + E.Message), PChar('错误'), MB_ICONERROR);
- end;
- end;
- procedure TTalkingForm.spbSendSMSClick(Sender: TObject);
- begin
- if (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) or (not MainForm.RealICQClient.UserPermission.EnableSendSms) then
- begin
- Dialogs.ShowMessage('您没有群发手机短信的权限! ');
- Exit;
- end;
- OpenTeamSMSForm(self.TeamID);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
- var
- vaIn, vaOut: Olevariant;
- begin
- if IsChild(Webbrowser.Handle, Msg.hwnd) or (IsChild(Self.WebBrowserForTeamDisk.Handle, Msg.hwnd)) then
- begin
- if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then
- begin
- if msg.wParam = VK_F5 then
- begin
- Handled := True;
- end;
- end;
- if (msg.wParam = ord('N')) and (GetKeyState(VK_CONTROL) < 0) then
- begin
- Handled := True;
- end;
- if (msg.wParam = ord('C')) and (GetKeyState(VK_CONTROL) < 0) then
- begin
- InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
- Handled := True;
- end;
- end;
- if RichEdInputer.Handle = Msg.hwnd then
- begin
- if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then
- begin
- if (msg.wParam = 13) then
- begin
- if (not MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) < 0) then
- Exit;
- if (MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) >= 0) then
- Exit;
- btSendClick(nil);
- Handled := True;
- end;
- //Ctrl + V
- if (msg.wParam = 86) and (GetKeyState(VK_CONTROL) < 0) then
- begin
- LockWindowUpdate(GetDesktopWindow);
- try
- if not PasteImage then
- RichEdInputer.PasteFromClipboard;
- CheckPastedContent;
- finally
- LockWindowUpdate(0);
- end;
- Handled := True;
- end;
- end;
- end;
- end;
- procedure TTalkingForm.EditPasteExecute(Sender: TObject);
- //var handle:HWND;
- begin
- // handle:=GetFocus;
- // SendMessage(handle, WM_SetText, 255, Integer(Pchar(Clipboard.AsText)));
- // if (RichEdInputer.Handle<>handle) then Exit;
- LockWindowUpdate(GetDesktopWindow);
- try
- try
- if not PasteImage then
- RichEdInputer.PasteFromClipboard;
- except
- RichEdInputer.PasteFromClipboard;
- end;
- CheckPastedContent;
- finally
- LockWindowUpdate(0);
- end;
- end;
- procedure TTalkingForm.EditPasteUpdate(Sender: TObject);
- var
- CF_HTML: DWORD;
- begin
- CF_HTML := RegisterClipboardFormat('HTML Format');
- EditPaste.Enabled := Clipboard.HasFormat(CF_HTML) or Clipboard.HasFormat(CF_HDROP) or Clipboard.HasFormat(CF_METAFILEPICT) or Clipboard.HasFormat(CF_PICTURE) or (Length(Clipboard.AsText) > 0);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CheckPastedContent(ADeleteOtherObj: Boolean = False);
- var
- AIndexes: TIndexes;
- AFaceInRichEdit: TFaceInRichEdit;
- AOldSelStart: Integer;
- iLoop: Integer;
- APastedToTemp: Boolean;
- begin
- RichEditTemp.Clear;
- APastedToTemp := False;
- AOldSelStart := RichEdInputer.SelStart;
- AIndexes := RichEdInputer.GetFaceIndexes;
- try
- for iLoop := 0 to High(AIndexes) do
- begin
- AFaceInRichEdit := AIndexes[iLoop];
- if AFaceInRichEdit.FaceIndex < 0 then
- begin
- if ADeleteOtherObj then
- begin
- RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
- RichEdInputer.SelLength := 1;
- RichEdInputer.SelText := '';
- end
- else
- begin
- if not APastedToTemp then
- begin
- RichEditTemp.PasteFromClipboard;
- APastedToTemp := True;
- end;
- RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
- RichEdInputer.SelLength := 1;
- RichEdInputer.CutToClipboard;
- PasteImage(False);
- end;
- end;
- end;
- finally
- if not ADeleteOtherObj then
- begin
- RichEdInputer.SelStart := AOldSelStart;
- RichEdInputer.SelLength := 0;
- RichEdInputer.Font.Color := RichEdInputer.Font.Color - 1;
- RichEdInputer.Font.Color := RichEdInputer.Font.Color + 1;
- RichEdInputer.DisableAlign;
- try
- PostMessage(RichEdInputer.Handle, WM_SIZE, 0, 0);
- finally
- RichEdInputer.EnableAlign;
- end;
- if APastedToTemp then
- begin
- RichEditTemp.SelectAll;
- RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
- RichEditTemp.CutToClipboard;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.FindIECacheImage(ADir, AImageFile: string): string;
- var
- DSearchRec: TSearchRec;
- FindResult: Integer;
- AFileName: string;
- AFileTime, AFileTimeTemp: TDateTime;
- begin
- AFileTime := 0.0;
- Result := '';
- FindResult := FindFirst(ADir + '\' + Format('%s[*]%s', [ReplaceText(AImageFile, ExtractFileExt(AImageFile), ''), ExtractFileExt(AImageFile)]), faAnyFile, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- AFileName := ADir + '\' + ExtractFileName(DSearchRec.Name);
- //找出最新的文件
- AFileTimeTemp := RealICQUtils.GetFileTime(AFileName, 3);
- if AFileTimeTemp > AFileTime then
- begin
- AFileTime := AFileTimeTemp;
- Result := AFileName;
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- if Result <> '' then
- Exit;
- FindResult := FindFirst(ADir + '\*.*', $00002016, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- if DirectoryExists(ADir + '\' + ExtractFileName(DSearchRec.Name)) then
- begin
- Result := FindIECacheImage(ADir + '\' + ExtractFileName(DSearchRec.Name), AImageFile);
- if Result <> '' then
- Exit;
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- end;
- function TTalkingForm.CheckImageExists(AImageFile: string): string;
- var
- dwCacheEntryInfoBufferSize: DWORD;
- lpCacheEntryInfo: PInternetCacheEntryInfoA;
- ALocalFile, ALocalFileTemp: string;
- ASplitString: TStringList;
- iIndex: Integer;
- begin
- Result := '';
- dwCacheEntryInfoBufferSize := 0;
- lpCacheEntryInfo := nil;
- GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0);
- GetMem(lpCacheEntryInfo, dwCacheEntryInfoBufferSize);
- try
- if GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0) then
- begin
- Result := StrPas(lpCacheEntryInfo.lpszLocalFileName);
- Exit;
- end;
- finally
- FreeMem(lpCacheEntryInfo);
- end;
- ALocalFileTemp := ReplaceStr(AImageFile, '\', '/');
- while Pos('/', ALocalFileTemp) > 0 do
- begin
- ALocalFileTemp := Copy(ALocalFileTemp, Pos('/', ALocalFileTemp) + 1, Length(ALocalFileTemp));
- end;
- ALocalFile := FindURLCache(PAnsiChar(GetIETempDir + '\Low\Content.IE5\index.dat'), PAnsiChar(AImageFile));
- if Length(ALocalFile) > 0 then
- begin
- ASplitString := SplitString(ALocalFile, Chr(10));
- AImageFile := GetIETempDir + '\Low\Content.IE5\' + ReplaceStr(ASplitString.Strings[0], '?', '') + '\';
- iIndex := 2;
- repeat
- ALocalFile := AImageFile + LeftStr(ALocalFileTemp, 1) + Copy(ASplitString.Strings[iIndex], 3, Length(ASplitString.Strings[iIndex]) - 2);
- Inc(iIndex);
- until (FileExists(ALocalFile)) or (iIndex >= 4);
- if FileExists(ALocalFile) then
- begin
- Result := ALocalFile;
- end;
- end;
- {
- ALocalFile := ReplaceStr(AImageFile, '\', '/');
- while Pos('/', ALocalFile) > 0 do
- begin
- ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
- end;
- Result := FindIECacheImage(GetIETempDir + '\Low\Content.IE5', ALocalFile); }
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.RichEdInputerChange(Sender: TObject);
- var
- iLoop, iLength, InputerLength, iStart: Integer;
- Face: TFace;
- FRealICQUser: TRealICQUser;
- begin
- if Length(Trim(Receiver)) = 0 then
- Exit;
- iLength := Length(RichEdInputer.Text);
- //发送“正在输入消息”字样
- if FCategory = tcNormal then
- begin
- if (iLength = 0) or (GetTickCount - FLastSendInputtingMessageTicket > 5000) then
- begin
- if (FRealICQClient.Me <> nil) and (FRealICQClient.Me.LoginState <> stHidden) then
- begin
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if Assigned(FRealICQUser) then
- begin
- ((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox) as TRealICQPtoPBox).SendInputting(iLength > 0);
- FLastSendInputtingMessageTicket := GetTickCount;
- end;
- end;
- end;
- end;
- if iLength = 0 then
- Exit;
- RichEdInputer.OnChange := nil;
- try
- for iLoop := 0 to MainForm.FaceList.Count - 1 do
- begin
- Face := MainForm.FaceList.Objects[iLoop] as TFace;
- if Face.ShortCut = '' then
- continue;
- iStart := TRxRichEdit(Sender).FindText(Face.ShortCut, 0, iLength, []);
- while iStart >= 0 do
- begin
- RichEdInputer.SelStart := iStart;
- RichEdInputer.SelLength := Length(Face.ShortCut);
- RichEdInputer.InsertImage(Face.FileName, iLoop);
- RichEdInputer.SelStart := TRxRichEdit(Sender).SelStart;
- RichEdInputer.SelLength := 0;
- iStart := RichEdInputer.FindText(Face.ShortCut, RichEdInputer.SelStart, iLength, []);
- end;
- end;
- finally
- RichEdInputer.OnChange := RichEdInputerChange;
- end;
- RichEdInputer.MaxLength := Length(Trim(RichEdInputer.Text));
- InputerLength := GetInputerLength;
- if MaxMessageLength - InputerLength > 0 then
- RichEdInputer.MaxLength := RichEdInputer.MaxLength + (MaxMessageLength - InputerLength);
- end;
- procedure TTalkingForm.IdHTTPOnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
- begin
- FRidrected := True;
- FRidrectURL := dest;
- end;
- procedure TTalkingForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
- begin
- end;
- procedure TTalkingForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
- begin
- FImageSize := AWorkCountMax;
- //如果重定向或文件大于200k,断开连接(重新从缓存中查找)
- //if (FRidrected) or (FImageSize > 1024 * 300) then
- (ASender as TIdHTTP).Disconnect;
- end;
- procedure TTalkingForm.IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
- begin
- end;
- procedure TTalkingForm.spbUploadTeamFileClick(Sender: TObject);
- var
- UpUrl: string;
- AFileSize: int64;
- begin
- if (FRealICQClient.Connected) and (FRealICQClient.Logined) then
- if OpenDialog.Execute then
- begin
- TTeamShareAdapter.UploadFile(TeamID, OpenDialog.FileName, Self, FRealICQClient, False);
- end;
- end;
- function TTalkingForm.ReAlighHTMLContent(ABaseURL: string): Boolean;
- var
- StrContent, imgBBURL, imgURL, ALocalFile, ALocalFile1, AFileExt, ABaseURLTop, AHttpStart: string;
- iIndex1, iIndex2: Integer;
- PngObject: TPngObject;
- BMP: TBitmap;
- AFinded: Boolean;
- FIdHTTP: TIdHTTP;
- FileStream: TFileStream;
- begin
- Result := False;
- StrContent := RichEditTemp.Text;
- iIndex1 := Pos('[img]', StrContent);
- iIndex2 := Pos('[/img]', StrContent);
- while (iIndex1 > 0) and (iIndex2 > 0) and (iIndex2 > iIndex1) do
- begin
- imgBBURL := Copy(StrContent, iIndex1, iIndex2 - iIndex1 + 6);
- imgURL := Copy(imgBBURL, 6, iIndex2 - iIndex1 - 5);
- RichEditTemp.SelStart := RichEditTemp.FindText(imgBBURL, 0, Length(StrContent), []);
- RichEditTemp.SelLength := Length(WideString(imgBBURL));
- ;
- RichEditTemp.SelText := '';
- ImgURL := ReplaceStr(ImgURL, '\', '/');
- if Pos('http://', ImgURL) = 1 then
- begin
- end
- else if Pos('https://', ImgURL) = 1 then
- begin
- end
- else if Pos('/', ImgURL) = 1 then
- begin
- AHttpStart := Copy(ABaseURL, 1, Pos('://', ABaseURL) + 2);
- ABaseURLTop := Copy(ABaseURL, Length(AHttpStart) + 1, Length(ABaseURL));
- ABaseURLTop := Copy(ABaseURLTop, 1, Pos('/', ABaseURLTop) - 1);
- ImgURL := AHttpStart + ABaseURLTop + ImgURL;
- end
- else
- begin
- ALocalFile := ReplaceStr(ABaseURL, '\', '/');
- while Pos('/', ALocalFile) > 0 do
- begin
- ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
- end;
- ImgURL := ReplaceStr(ABaseURL, ALocalFile, '') + ImgURL;
- end;
- ALocalFile := ReplaceStr(ImgURL, '\', '/');
- while Pos('/', ALocalFile) > 0 do
- begin
- ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
- end;
- AFileExt := ExtractFileExt(ALocalFile);
- if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
- begin
- AFinded := False;
- if AnsiSameText(Copy(ImgURL, 1, 8), 'file:///') then
- begin
- ImgURL := Copy(ImgURL, 9, Length(ImgURL) - 8);
- AFinded := FileExists(ImgURL);
- ALocalFile := ImgURL;
- end
- else
- begin
- ALocalFile1 := CheckImageExists(ImgURL);
- if FileExists(ALocalFile1) then
- begin
- ALocalFile := ALocalFile1;
- AFinded := True;
- end
- else
- begin
- {$region '检查是否有重定向'}
- FRidrected := False;
- FRidrectURL := '';
- FImageSize := 0;
- ALocalFile1 := MainForm.RealICQClient.GetCacheFaceDir + IntToStr(GetTickCount) + '_' + ALocalFile;
- FIdHTTP := TIdHTTP.Create(nil);
- try
- FIdHTTP.ConnectTimeout := 1500;
- FIdHTTP.ReadTimeout := 2000;
- FIdHTTP.OnWork := IdHTTPWork;
- FIdHTTP.OnWorkBegin := IdHTTPWorkBegin;
- FIdHTTP.OnWorkEnd := IdHTTPWorkEnd;
- FIdHTTP.OnRedirect := IdHTTPOnRedirect;
- try
- FileStream := TFileStream.Create(ALocalFile1, fmCreate, fmShareDenyNone);
- try
- FIdHTTP.Get(FIdHTTP.URL.URLEncode(ImgURL), FileStream);
- ALocalFile := ALocalFile1;
- AFinded := True;
- finally
- FileStream.Free;
- end;
- except
- on E: Exception do
- begin
- DeleteFile(ALocalFile1);
- end;
- end;
- finally
- FreeAndNil(FIdHTTP);
- end;
- if FRidrected then
- begin
- FRidrectURL := ReplaceStr(FRidrectURL, '\', '/');
- ImgURL := ReplaceStr(ImgURL, '\', '/');
- if Pos('http://', FRidrectURL) = 1 then
- ImgURL := FRidrectURL
- else if Pos('https://', FRidrectURL) = 1 then
- ImgURL := FRidrectURL
- else if Pos('/', FRidrectURL) = 1 then
- begin
- AHttpStart := Copy(ImgURL, 1, Pos('://', ImgURL) + 2);
- ImgURL := Copy(ImgURL, Length(AHttpStart) + 1, Length(ImgURL));
- ImgURL := Copy(ImgURL, 1, Pos('/', ImgURL) - 1);
- ImgURL := AHttpStart + ImgURL + FRidrectURL;
- end
- else
- begin
- ImgURL := ReplaceStr(ImgURL, ALocalFile, '') + FRidrectURL;
- end;
- ALocalFile := ReplaceStr(ImgURL, '\', '/');
- while Pos('/', ALocalFile) > 0 do
- begin
- ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
- end;
- AFileExt := ExtractFileExt(ALocalFile);
- if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
- begin
- ALocalFile1 := CheckImageExists(ImgURL);
- if FileExists(ALocalFile1) then
- begin
- ALocalFile := ALocalFile1;
- AFinded := True;
- end;
- end;
- end;
- {$endregion }
- end;
- end;
- if AFinded then
- begin
- try
- AddImageToInput(ALocalFile, RichEditTemp);
- Result := True;
- except
- on E: Exception do
- begin
- if Pos('JPEG error #53', E.Message) > 0 then
- begin
- MoveFile(PChar(ALocalFile), PChar(ALocalFile + '.gif'));
- try
- AddImageToInput(ALocalFile + '.gif', RichEditTemp);
- Result := True;
- except
- Result := False;
- end;
- end
- else
- begin
- Result := False;
- end;
- end;
- end;
- end;
- end;
- StrContent := RichEditTemp.Text;
- iIndex1 := Pos('[img]', StrContent);
- iIndex2 := Pos('[/img]', StrContent);
- end;
- Application.ProcessMessages;
- Sleep(10);
- Application.ProcessMessages;
- RichEditTemp.SelectAll;
- RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
- RichEditTemp.CopyToClipboard;
- RichEdInputer.PasteFromClipboard;
- RichEditTemp.Clear;
- end;
- function TTalkingForm.GetHTMLUBBCode(AHTML: string; var ABaseURL: string): string;
- var
- iIndex1: Integer;
- StrStartFragment, StrEndFragment: string;
- iStartFragment, iEndFragment: Integer;
- reg: TPerlRegEx;
- ws: string;
- begin
- Result := '';
- iIndex1 := Pos('SourceURL:', AHTML);
- if iIndex1 > 0 then
- begin
- ABaseURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), 100);
- iIndex1 := Pos(#$D, ABaseURL);
- if iIndex1 > 0 then
- begin
- ABaseURL := Copy(ABaseURL, 1, iIndex1 - 1);
- end;
- end;
- iIndex1 := Pos('StartFragment:', AHTML);
- if iIndex1 = 0 then
- Exit;
- StrStartFragment := Copy(AHTML, iIndex1 + Length('StartFragment:'), 12);
- iIndex1 := Pos(#$D, StrStartFragment);
- if iIndex1 = 0 then
- Exit;
- StrStartFragment := Copy(StrStartFragment, 1, iIndex1 - 1);
- iIndex1 := Pos('EndFragment:', AHTML);
- if iIndex1 = 0 then
- Exit;
- StrEndFragment := Copy(AHTML, iIndex1 + Length('EndFragment:'), 12);
- iIndex1 := Pos(#$D, StrEndFragment);
- if iIndex1 = 0 then
- Exit;
- StrEndFragment := Copy(StrEndFragment, 1, iIndex1 - 1);
- iStartFragment := StrToInt(StrStartFragment);
- iEndFragment := StrToInt(StrEndFragment);
- Result := Copy(AHTML, iStartFragment + 1, iEndFragment - iStartFragment);
- {iIndex1 := Pos('SourceURL:', AHTML);
- if iIndex1 = 0 then Exit;
- StrSourceURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), Length(AHTML));
- StrSourceURL := Copy(StrSourceURL, 1, Pos(#$D#$A, StrSourceURL)); }
- reg := TPerlRegEx.Create;
- reg.Subject := LowerCase(Result);
- reg.RegEx := '聽'; //???????????????????????????????????????
- reg.Replacement := ' ';
- reg.ReplaceAll;
- reg.RegEx := #$D#$A;
- reg.Replacement := '';
- reg.ReplaceAll;
- reg.RegEx := '</p>';
- reg.Replacement := #$D#$A;
- reg.ReplaceAll;
- reg.RegEx := '</div>';
- reg.Replacement := #$D#$A;
- reg.ReplaceAll;
- reg.RegEx := '<br>';
- reg.Replacement := #$D#$A;
- reg.ReplaceAll;
- reg.RegEx := '<script[^>]*?>([\w\W]*?)<\/script>';
- reg.Replacement := '';
- reg.ReplaceAll;
- reg.RegEx := '<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>';
- reg.Replacement := '$2';
- reg.ReplaceAll;
- reg.RegEx := '<img[^>]+src="([^"]+)"[^>]*>';
- reg.Replacement := '[img]$1[/img]';
- reg.ReplaceAll;
- reg.RegEx := '<[^>]*?>';
- reg.Replacement := '';
- reg.ReplaceAll;
- reg.RegEx := '&';
- reg.Replacement := '&';
- reg.ReplaceAll;
- reg.RegEx := '<';
- reg.Replacement := '<';
- reg.ReplaceAll;
- reg.RegEx := '>';
- reg.Replacement := '>';
- reg.ReplaceAll;
- reg.RegEx := ' ';
- reg.Replacement := ' ';
- reg.ReplaceAll;
- reg.RegEx := '"';
- reg.Replacement := '"';
- reg.ReplaceAll;
- Result := reg.Subject;
- FreeAndNil(reg);
- ws := UTF8Decode(Result);
- while (ws[Length(ws)] = #$A) or (ws[Length(ws)] = #$D) do
- ws := Copy(ws, 1, Length(ws) - 1);
- Result := ws;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.PasteImage(AUseTemp: Boolean = True): Boolean;
- var
- //vMetafile: TMetafile;
- Picture: TPicture;
- Bitmap: TBitmap;
- GIF: TGIFImage;
- AFileName: string;
- AFindedImage: Boolean;
- PFileName: PChar;
- DataHandle: Thandle;
- FilesCount: Integer;
- ClipboardText: string;
- iLoop, tabCount, returnCount: Integer;
- AIndexes: TIndexes;
- AFaceInRichEdit: TFaceInRichEdit;
- CF_HTML: DWORD;
- hMem: DWORD;
- pHTML: PChar;
- StrHTML, ABaseURL: string;
- APasted: Boolean;
- begin
- Result := False;
- ClipboardText := Clipboard.AsText;
- if Clipboard.HasFormat(CF_HDROP) and ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
- begin
- // if FCategory = tcTeam then
- // begin
- // Result := True;
- // Exit;
- // end;
- GetMem(PFileName, MAX_PATH + 1);
- DataHandle := Clipboard.GetAsHandle(CF_HDROP);
- FilesCount := DragQueryFile(DataHandle, MAXDWORD, PFileName, MAX_PATH);
- for iLoop := 0 to FilesCount - 1 do
- begin
- if DragQueryFile(DataHandle, iLoop, PFileName, MAX_PATH) > 0 then
- begin
- if DirectoryExists(PFileName) then
- OpenSendFolderForm(PFileName)
- else
- SendDropFile(PFileName);
- end;
- if iLoop > 20 then
- break;
- end;
- FreeMem(PFileName);
- Result := True;
- Exit;
- end;
- tabCount := 0;
- returnCount := 0;
- for iLoop := 1 to Length(ClipboardText) do
- begin
- if ClipboardText[iLoop] = #9 then
- Inc(tabCount);
- if ClipboardText[iLoop] = #13 then
- Inc(returnCount);
- end;
- //粘贴HTML数据
- CF_HTML := RegisterClipboardFormat('HTML Format');
- if Clipboard.HasFormat(CF_HTML) and not ((Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) and (Clipboard.HasFormat(CF_METAFILEPICT))) then
- begin
- Screen.Cursor := crHourGlass;
- try
- hMem := Clipboard.GetAsHandle(CF_HTML);
- pHTML := GlobalLock(hMem);
- StrHTML := StrPas(pHTML);
- GlobalUnlock(hMem);
- ABaseURL := '';
- StrHTML := GetHTMLUBBCode(StrHTML, ABaseURL);
- RichEditTemp.Clear;
- RichEditTemp.Lines.Add(StrHTML);
- APasted := ReAlighHTMLContent(ABaseURL);
- finally
- Screen.Cursor := crDefault;
- end;
- if (not APasted) and (Clipboard.HasFormat(CF_METAFILEPICT) or Clipboard.HasFormat(CF_PICTURE)) then
- begin
- end
- else
- begin
- Result := True;
- Exit;
- end;
- end;
- {$region '先在临时RichEdit中粘贴'}
- if AUseTemp and (Length(ClipboardText) = 0) then
- begin
- RichEditTemp.Clear;
- RichEditTemp.PasteFromClipboard;
- AIndexes := RichEditTemp.GetFaceIndexes;
- if High(AIndexes) = 0 then //只有一个对象
- begin
- AFaceInRichEdit := AIndexes[0];
- if AFaceInRichEdit.FaceIndex > 0 then //已经是表情对象
- begin
- Result := False;
- RichEditTemp.Clear;
- Exit;
- end
- else if ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
- begin
- Result := True;
- RichEditTemp.Clear;
- Exit;
- end;
- end;
- end;
- {$endregion}
- try
- if Clipboard.HasFormat(CF_METAFILEPICT) then
- begin
- if (Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) then
- begin
- AFindedImage := False;
- Bitmap := TBitmap.Create;
- try
- try
- Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
- AFindedImage := True;
- except
- end;
- if AFindedImage then
- begin
- AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
- Bitmap.SaveToFile(AFileName);
- end;
- finally
- Bitmap.Free;
- end;
- if AFindedImage then
- begin
- AddImageToInput(AFileName, RichEdInputer);
- DeleteFile(AFileName);
- Result := True;
- Exit;
- end;
- end;
- end;
- if Clipboard.HasFormat(CF_PICTURE) and (Length(Trim(Clipboard.AsText)) = 0) then
- begin
- Picture := TPicture.Create;
- Bitmap := TBitmap.Create;
- try
- Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
- AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
- Bitmap.SaveToFile(AFileName);
- finally
- Bitmap.Free;
- Picture.Free;
- end;
- AddImageToInput(AFileName, RichEdInputer);
- DeleteFile(AFileName);
- Result := True;
- Exit;
- end;
- except
- on E: Exception do
- Error(E.Message, 'TTalkingForm.PasteImage');
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.btCloseClick(Sender: TObject);
- begin
- if Assigned(FRemoteControlMission) then
- FRemoteControlMission.Stop;
- end;
- procedure TTalkingForm.btCloseTalkClick(Sender: TObject);
- var
- source, target: string;
- AUser: TRealICQUser;
- begin
- if TConditionConfig.GetConfig.GradeSystem and (FCategory = tcNormal) then
- begin
- AUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(AUser) then
- Exit;
- source := TUsersService.ClearServerID(FSender);
- target := TUsersService.ClearServerID(FReceiver);
- (AUser.RealICQPtoPBox as TRealICQPtoPBox).SendMessage((spbEncryMsg.Tag = 1), FontToString(RichEdInputer.Font), '[grade-src="http://111.113.17.86:8088/Home/Rating?fromName=' + source + '&toName=' + target + '"]');
- end
- else
- Close;
- end;
- procedure TTalkingForm.btDownArrowClick(Sender: TObject);
- var
- Point1: TPoint;
- begin
- Point1.X := 0;
- Point1.Y := (Sender as TRealICQButton).Height + 1;
- Point1 := (Sender as TRealICQButton).ClientToScreen(Point1);
- ppForDown.Popup(Point1.X + 6, Point1.Y);
- end;
- procedure TTalkingForm.btnQRClick(Sender: TObject);
- var
- data: string;
- RealICQUser: TRealICQUser;
- Form: TVCardForm;
- begin
- Form := GetVCardForm(FReceiver);
- Form.Top := (Screen.Height - Form.Height) div 2;
- Form.Left := (Screen.Width - Form.Width) div 2;
- Form.Show;
- end;
- procedure TTalkingForm.btReleaseControlClick(Sender: TObject);
- begin
- if Assigned(FRemoteControlMission) then
- FRemoteControlMission.CancelControl;
- end;
- procedure TTalkingForm.btSendClick(Sender: TObject);
- var
- Face: TFace;
- FaceMD5String, MessageStr: string;
- BaseSelStart, iCount, iLoop: Integer;
- FaceInRichEdit: TFaceInRichEdit;
- FaceIndexes: TIndexes;
- FRealICQUser: TRealICQUser;
- saystr, AError: string;
- AFaces: TStringList;
- ATask: TFacesUploaderTask;
- begin
- if (GetTickCount - FLastSendMsgTicket) < 200 then
- begin
- ShowSendMessageTooQuickly(WebBrowser);
- Exit;
- end;
- FRealICQUser := nil;
- if FCategory = tcNormal then
- begin
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(FRealICQUser) then
- Exit;
- if AnsiSameText(RichEdInputer.Text, '/P2PType') then
- begin
- P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
- ClearInputtingMessageTimer.Enabled := False;
- ClearInputtingMessageTimer.Enabled := True;
- RichEdInputer.Lines.Clear;
- Exit;
- end;
- end;
- if GetInputerLength > MaxMessageLength + 64 then
- begin
- MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
- RichEdInputer.SetFocus;
- Exit;
- end;
- MessageStr := '';
- AFaces := TStringList.Create;
- FaceIndexes := RichEdInputer.GetFaceIndexes;
- BaseSelStart := 0;
- RichEdInputer.OnChange := nil;
- RichEdInputer.Visible := False;
- try
- iCount := 0;
- for iLoop := 0 to Length(FaceIndexes) - 1 do
- begin
- FaceInRichEdit := FaceIndexes[iLoop];
- if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
- Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
- else
- Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
- if TLimitCondition.GreaterThanFaceMaxSize(Face.FileName, AError) then
- begin
- MessageBox(Handle, PChar(AError), '提示', MB_ICONINFORMATION);
- Error(AError, 'TLimitCondition.GreaterThanFaceMaxSize');
- RichEdInputer.SetFocus;
- Exit;
- end;
- end;
- for iLoop := 0 to Length(FaceIndexes) - 1 do
- begin
- FaceInRichEdit := FaceIndexes[iLoop];
- if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
- Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
- else
- Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
- if FaceInRichEdit.FaceIndex < MainForm.SystemFaceCount then
- FaceMD5String := Face.ShortCut
- else
- begin
- FaceMD5String := '[image-src="' + Face.MD5Code + '"]';
- Inc(iCount);
- AFaces.addObject(Face.FileName, Face);
- end;
- RichEdInputer.SelStart := BaseSelStart + FaceInRichEdit.FacePosition;
- RichEdInputer.SelLength := 1;
- RichEdInputer.SelText := FaceMD5String;
- Inc(BaseSelStart, Length(FaceMD5String) - 1);
- end;
- MessageStr := Trim(RichEdInputer.Text);
- if Length(MessageStr) = 0 then
- begin
- MessageBox(Handle, '不能发送空消息! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- if GetInputerLength > 4096 then
- begin
- MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
- RichEdInputer.SetFocus;
- Exit;
- end;
- finally
- RichEdInputer.Visible := True;
- RichEdInputer.SetFocus;
- end;
- RichEdInputer.MaxLength := MaxMessageLength;
- RichEdInputer.Lines.Clear;
- RichEdInputer.Clear;
- RichEdInputer.OnChange := RichEdInputerChange;
- RichEdInputer.Visible := True;
- RichEdInputer.SetFocus;
- while (ImagesList.Count > 0) do
- begin
- dispose(ImagesList.First);
- ImagesList.Delete(0);
- end;
- if FCategory = tcNormal then
- (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SyncSendMessage((spbEncryMsg.Tag = 1), FontToString(RichEdInputer.Font), MessageStr, AFaces)
- else
- TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, AFaces, '');
- FLastSendMsgTicket := GetTickCount;
- end;
- procedure TTalkingForm.btSetControlClick(Sender: TObject);
- begin
- if Assigned(FRemoteControlMission) then
- FRemoteControlMission.ControlReAccept;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- chrPoint, vPoint, pt: TPoint;
- FaceInRichEdit: TFaceInRichEdit;
- FaceIndexes: TIndexes;
- iLoop, iPos: integer;
- face: TFace;
- begin
- if Button = mbRight then
- begin
- vPoint.X := X;
- vPoint.Y := Y;
- vPoint := RichEdInputer.ClientToScreen(vPoint);
- chrPoint := Point(X, Y);
- iPos := SendMessage(TRealICQRichEdit(Sender).Handle, EM_CHARFROMPOS, 0, Integer(@chrPoint)) and $0000FFFF; // 得到鼠标点击字符位置
- pt := TRealICQRichEdit(Sender).GetCharPos(iPos);
- if (RichEdInputer.SelLength <= 0) then
- begin
- if pt.x < chrPoint.X then
- RichEdInputer.SetSelection(iPos, iPos + 1, false)
- else
- RichEdInputer.SetSelection(iPos - 1, iPos, true);
- if TRealICQRichEdit(Sender).SelectionType <> [stObject] then
- begin
- RichEdInputer.SelLength := 0;
- RichEdInputer.SelStart := iPos;
- end;
- end;
- //判断
- if TRealICQRichEdit(Sender).SelectionType = [stObject] then
- begin
- FaceIndexes := TRealICQRichEdit(Sender).GetFaceIndexes;
- for iLoop := 0 to Length(FaceIndexes) - 1 do
- begin
- FaceInRichEdit := FaceIndexes[iLoop];
- if FaceInRichEdit.FacePosition = TRealICQRichEdit(Sender).SelStart then
- begin
- FRightMouseClickedFace := FaceInRichEdit;
- miCopyImage.Visible := True;
- actSaveImgAs.Visible := True;
- actAddImageToCustomFaces.Visible := True;
- ppForInputerImg.Popup(vPoint.X, vPoint.Y);
- break;
- end;
- end;
- RichEdInputer.SelLength := 0;
- RichEdInputer.SelStart := iPos;
- end
- else
- ppForInputer.Popup(vPoint.X, vPoint.Y);
- end;
- end;
- procedure TTalkingForm.RichEdInputerSelectionChange(Sender: TObject);
- begin
- //Dialogs.ShowMessage('RichEdInputerSelectionChange');
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.rndMyInfoResize(Sender: TObject);
- begin
- //Application.ProcessMessages;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbSelUIColorClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- ppColors.Popup(Point.X, Point.Y);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.LblSendSMSClick(Sender: TObject);
- var
- FRealICQUser: TRealICQUser;
- begin
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if Length(FRealICQUser.Mobile) > 0 then
- OpenSMSForm(Receiver, True)
- else
- OpenSMSForm('', True);
- end;
- procedure TTalkingForm.LblSendSMSMouseEnter(Sender: TObject);
- begin
- LblSendSMS.Font.Style := [fsUnderLine];
- LblSendSMS1.Font.Style := [fsUnderLine];
- end;
- procedure TTalkingForm.LblSendSMSMouseLeave(Sender: TObject);
- begin
- LblSendSMS.Font.Style := [];
- LblSendSMS1.Font.Style := [];
- end;
- procedure TTalkingForm.LoadAdvertisement;
- begin
- if (not FRealICQClient.TalkingFormAdversement.Visible) then
- begin
- if pnlForWebBrowserAdvertisement.Width > 0 then
- pnlAdvertisement.Width := 0;
- end
- else
- begin
- WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
- pnlForHideWebBrowserAdvertisement.Visible := True;
- WebBrowserForAdvertisement.OnDocumentComplete := WebBrowserForAdvertisementDocumentComplete;
- WebBrowserForAdvertisement.Navigate(FRealICQClient.TalkingFormAdversement.URL);
- WebBrowserForAdvertisement.OnBeforeNavigate2 := WebBrowserForAdvertisementBeforeNavigate2;
- pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.LoadNotReadMessagesFromDBHistory(DBHistorySearchResult: TDBHistorySearchResult);
- var
- iLoop: Integer;
- MessageSearchResult: TMessageSearchResult;
- SenderName, SplitHTML, FontStr, AMessageStr: string;
- FRealICQUser: TRealICQUser;
- TextFont: TFont;
- iIndex: Integer;
- MessageList: TList;
- NotReadMessageCount: Integer;
- OldAllowURL: Boolean;
- begin
- ClearHTML(self.WebBrowser);
- for iLoop := DBHistorySearchResult.Messages.Count - 1 downto 0 do
- begin
- MessageSearchResult := DBHistorySearchResult.Messages[iLoop];
- if MessageSearchResult.TeamID = '-5' then
- begin
- Continue;
- end;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
- if Length(Trim(FRealICQUser.DisplayName)) = 0 then
- SenderName := FRealICQUser.LoginName
- else
- SenderName := FRealICQUser.DisplayName;
- // TextFont := TFont.Create;
- // OldAllowURL := MainForm.AllowURL;
- try
- // MainForm.AllowURL := False;
- // StringToFont(MessageSearchResult.Font, TextFont);
- // TextFont.Color := $00686868;
- // FontStr := FontToString(TextFont);
- if MessageSearchResult.IsEncryMessage then
- AMessageStr := IntToStr(MessageSearchResult.ID)
- else
- AMessageStr := MessageSearchResult.MessageStr;
- AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
- finally
- // MainForm.AllowURL := OldAllowURL;
- // TextFont.Free;
- end;
- end;
- end;
- procedure TTalkingForm.LoadOfflinefilesConfig;
- var
- XMLDocument: TXMLDocument;
- ServerConfigNode: IXMLNode;
- begin
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if csDesigning in ComponentState then
- exit;
- XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName) + ConfigXMLFilePath + 'OfflinefilesServerConfig.xml');
- ServerConfigNode := XMLDocument.DocumentElement;
- FOfflinefilesAddr := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Address'];
- FOfflinefilesPort := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Port'];
- FPackageSize := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['PackageSize'];
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.LoadHistoryMessages;
- var
- iLoop: Integer;
- MessageSearchResult: TMessageSearchResult;
- SenderName, SplitHTML, FontStr, AMessageStr: string;
- FRealICQUser: TRealICQUser;
- iIndex: Integer;
- MessageList: TList;
- Alias: string;
- begin
- if FCategory = tcNormal then
- MessageList := MainForm.DBHistory.GetMessage('-1', FReceiver, FRealICQClient.LoginName, FMaxID, 8)
- else
- MessageList := MainForm.DBHistory.GetMessage(FTeamID, FReceiver, FRealICQClient.LoginName, FMaxID, 8);
- for iLoop := 0 to MessageList.Count - 1 do
- begin
- MessageSearchResult := MessageList[iLoop];
- if MessageSearchResult.TeamID = '-5' then
- begin
- Continue;
- end;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
- Alias := TTeamsAdapter.GetAlias(FTeamID, FRealICQUser.LoginName);
- if trim(Alias) = '' then
- begin
- if Length(Trim(FRealICQUser.DisplayName)) = 0 then
- SenderName := FRealICQUser.LoginName
- else
- SenderName := FRealICQUser.DisplayName;
- end
- else
- SenderName := Alias;
- if MessageSearchResult.IsEncryMessage then
- AMessageStr := IntToStr(MessageSearchResult.ID)
- else
- AMessageStr := MessageSearchResult.MessageStr;
- AddMessageToWebBrowserTop(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
- end;
- if MessageList.Count > 0 then
- FMaxID := TMessageSearchResult(MessageList[MessageList.Count - 1]).ID;
- TRealICQUtility.FreeList(MessageList);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.LoadNotReadMessages;
- var
- iIndex: Integer;
- MessageList: TList;
- NotReadMessage: TNotReadMessage;
- NotReadTeamMessage: TNotReadTeamMessage;
- begin
- try
- Application.ProcessMessages;
- LoadHistoryMessages;
- except
- end;
- GoBottom(Webbrowser);
- if FCategory = tcNormal then
- begin
- iIndex := MainForm.NotReadMessages.IndexOf(Receiver);
- if iIndex < 0 then
- Exit;
- MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
- MainForm.NotReadMessages.Delete(iIndex);
- try
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- except
- end;
- // MainForm.DBHistory.SetReadFlag('-1', Receiver);
- //
- // while MessageList.Count > 0 do
- // begin
- // NotReadMessage := TNotReadMessage(MessageList[0]);
- // ShowMessage(NotReadMessage.RealICQMessage, NotReadMessage.ShowSendFailed);
- // MessageList.Delete(0);
- // FreeAndNil(NotReadMessage);
- // end;
- // FreeAndNil(MessageList);
- TRealICQUtility.FreeList(MessageList);
- MainForm.StopFlash(Receiver);
- end
- else
- begin
- iIndex := MainForm.NotReadMessages.IndexOf(TeamMessageID + FTeamID);
- if iIndex < 0 then
- Exit;
- MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
- MainForm.NotReadMessages.Delete(iIndex);
- MainForm.DBHistory.SetReadFlag(FTeamID, '');
- try
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- except
- end;
- // while MessageList.Count > 0 do
- // begin
- // NotReadTeamMessage := TNotReadTeamMessage(MessageList[0]);
- //
- // ShowTeamMessage(NotReadTeamMessage.RealICQTeamMessage, NotReadTeamMessage.ShowSendFailed);
- // MessageList.Delete(0);
- // FreeAndNil(NotReadTeamMessage);
- // end;
- // FreeAndNil(MessageList);
- TRealICQUtility.FreeList(MessageList);
- MainForm.StopFlashTeam(FTeamID);
- end;
- end;
- {设置WebBrowser的样式}
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SetDOMStyle(Doc: IHTMLDocument2);
- var
- v: Variant;
- CurrentColor, CssColor: string;
- AHtmlFile: TFileStream;
- AStrStream: TStringStream;
- begin
- // if pnlForHideWebBrowser.Visible then
- // begin
- // try
- // AHtmlFile := TFileStream.Create('E:\\DelphiProjects\\IMClient-Root-CMG\\html\\chat.html', fmOpenRead);
- // AStrStream := TStringStream.Create('');
- // AStrStream.CopyFrom(AHtmlFile, AHtmlFile.Size);
- // v := VarArrayCreate([0, 0], varVariant);
- // v[0] := AStrStream.DataString;
- // // v[0] := '<html dir="ltr" lang="zh">'
- // // + '<head>'
- // // + '<META http-equiv="Content-Type" content="text/html; charset=gb2312">'
- // // + '<body link="#0000FF" vlink="#0000FF" alink="#0000FF" hlink="#0000FF" bgcolor="#fdfdfd" oncontextmenu="location.href=''PopMenu'';return false;">'
- // // + '</body>'
- // // + '</head>'; //????????????????????????
- // doc.write(PSafeArray(TVarData(v).VArray));
- // finally
- // AHtmlFile.Free;
- // AStrStream.Free;
- // end;
- // end;
- try
- CurrentColor := IntToHex(ConvertColorToColor($00CDCDCD, FWindowColor), 6);
- CssColor := '#' + Copy(CurrentColor, 5, 2) + Copy(CurrentColor, 3, 2) + Copy(CurrentColor, 1, 2);
- except
- end;
- Doc.body.language := 'gb2312';
- Doc.body.style.cssText := 'SCROLLBAR-FACE-COLOR:' + CssColor + ';' + 'SCROLLBAR-HIGHLIGHT-COLOR: ButtonHighLight;' + 'SCROLLBAR-SHADOW-COLOR: ButtonShadow;' + 'SCROLLBAR-ARROW-COLOR: #333333;' + 'SCROLLBAR-3DLIGHT-COLOR:' + CssColor + ';' + 'SCROLLBAR-TRACK-COLOR:' + CssColor + ';' + 'SCROLLBAR-DARKSHADOW-COLOR:' + CssColor + ';' + 'word-break: break-all;' + 'background-attachment: fixed;' + 'background-repeat: no-repeat;' + 'background-position: left top;' + '.ChatPic{width:10px;}';
- Doc.body.style.overflow := 'auto';
- Doc.body.style.border := '0px solid';
- Doc.body.style.margin := '2px';
- Doc.body.style.fontFamily := '宋体';
- Doc.body.style.fontSize := '9pt';
- Doc.body.style.backgroundImage := 'url(' + FBackGroundImage + ')';
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- begin
- // Dialogs.ShowMessage(IntToStr(Pos(FBaseURL, UpperCase(String(URL)))));
- // Dialogs.ShowMessage(IntToStr(Pos('about:blank', UpperCase(String(URL)))));
- if (Pos(FBaseURL, UpperCase(string(URL))) >= 1) or (Pos('about:blank', string(URL)) >= 1) then
- begin
- URL := Trim(AnsiReplaceText(string(URL), FBaseURL, ''));
- if TFileTransmitAdapter.HandleMessage(Self, URL, Cancel) then
- Exit;
- IEBeforeNavigate2(Self, ASender, pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel);
- end
- else
- begin
- if Category = tcNormal then
- begin
- if FileExists(string(URL)) then
- begin
- if FRealICQClient.Connected and FRealICQClient.Logined then
- begin
- SendDropFile(string(URL));
- Cancel := True;
- end;
- end;
- if DirectoryExists(string(URL)) then
- begin
- if FRealICQClient.Connected and FRealICQClient.Logined then
- begin
- OpenSendFolderForm(string(URL));
- Cancel := True;
- end;
- end;
- end
- else
- begin
- if FileExists(string(URL)) then
- begin
- if FRealICQClient.Connected and FRealICQClient.Logined then
- begin
- SendDropFile(string(URL));
- Cancel := True;
- end;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function TTalkingForm.GetCanWriteMessage: Boolean;
- begin
- Result := not pnlForHideWebBrowser.Visible;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- try
- Log('WebBrowserDocumentComplete', 'WebBrowser');
- WebBrowser.OnDocumentComplete := nil;
- try
- SetDomStyle(WebBrowser.Document as IHtmlDocument2);
- finally
- pnlForHideWebBrowser.Visible := False;
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- begin
- if not AnsiSameText(URL, FRealICQClient.TalkingFormAdversement.URL) then
- begin
- ShellExecute(handle, 'open', PChar(MainForm.GetDefaultBrowser), PChar('"' + string(URL) + '"'), nil, SW_SHOWNORMAL);
- Cancel := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- try
- WebBrowserForAdvertisement.OnDocumentComplete := nil;
- MainForm.SetDomStyle(WebBrowserForAdvertisement.Document as IHtmlDocument2);
- except
- end;
- Application.ProcessMessages;
- pnlForHideWebBrowserAdvertisement.Visible := False;
- pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
- Constraints.MinWidth := 288 + pnlAdvertisement.Width;
- ClearMemory;
- end;
- procedure TTalkingForm.WebBrowserForTeamDiskBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- begin
- if FileExists(string(URL)) then
- TTeamShareAdapter.UploadFile(TeamID, string(URL), Self, Self.FRealICQClient, False);
- end;
- procedure TTalkingForm.WebBrowserForTeamDiskoldBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- var
- strMissionID, strFileName, js: string;
- begin
- if FileExists(string(URL)) then
- begin
- if FRealICQClient.Connected and Self.FRealICQClient.Logined then
- begin
- try
- strMissionID := '1|' + IntToStr(GetTickCount) + ',' + TeamID + ',' + MainForm.RealICQClient.LoginName;
- strFileName := string(URL);
- js := format('ReadyToUpload("%s", "%s", %d)', [strMissionID, ReplaceStr(strFileName, '\', '\\'), GetTheFileSize(strFileName)]);
- try
- WebBrowserForTeamDisk.OleObject.Document.parentWindow.execScript(js, 'JavaScript');
- except
- end;
- except
- on E: Exception do
- MessageBox(0, PChar(E.Message), '上传文件出错! ', MB_ICONINFORMATION);
- end;
- end;
- Cancel := True;
- end;
- end;
- procedure TTalkingForm.WebBrowserForTeamDiskoldDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- pnlForHideTeamDisk.Visible := False;
- WebBrowserForTeamDisk.OnDocumentComplete := nil;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.OnKeyDown(var Msg: TMessage);
- begin
- if RemoteControlForm = nil then
- Exit;
- if RemoteControlForm.Parent <> pnlRC then
- Exit;
- if FRemoteControlMission <> nil then
- FRemoteControlMission.SendMessage(Msg);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.OnKeyUp(var Msg: TMessage);
- begin
- if RemoteControlForm = nil then
- Exit;
- if RemoteControlForm.Parent <> pnlRC then
- Exit;
- if FRemoteControlMission <> nil then
- FRemoteControlMission.SendMessage(Msg);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CMWininichange(var Message: TWMWinIniChange);
- begin
- ChangeUIColor(MainForm.UIMainColor);
- DisableAlign;
- try
- PostMessage(Handle, WM_SIZE, 0, 0);
- finally
- EnableAlign;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- with Params do
- begin
- Params.WndParent := 0;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SendDropFile(AFileName: string);
- var
- FRealICQUser: TRealICQUser;
- AFileStream: TFileStream;
- AModalResult: Integer;
- UpUrl: string;
- AFileSize: int64;
- AError: string;
- begin
- if not FRealICQClient.Connected or not FRealICQClient.Logined then
- Exit;
- //Success('1', 'TTalkingForm.SendDropFile');
- try
- if FCategory = tcTeam then
- begin
- if DirectoryExists(AFileName) then
- begin
- MessageBox(0, PChar('不支持直接上传目录,请压缩后上传! '), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- if FileExists(AFileName) then
- TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
- Exit;
- end;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(FRealICQUser) then
- Exit;
- //Success('2', 'TTalkingForm.SendDropFile');
- if not (FRealICQUser.LoginState = stOffline) and not (FRealICQUser.LoginState = stHidden) then
- begin
- SendFile(AFileName);
- Exit;
- end;
- //Success('3', 'TTalkingForm.SendDropFile');
- if TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient) then
- begin
- MessageBox(0, PChar(AError), '提示', MB_ICONINFORMATION);
- PostMessage(Handle, WM_SETFOCUS, 0, 0);
- Exit;
- end;
- //Success('3', 'TTalkingForm.SendDropFile');
- TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
- except
- on E: Exception do
- Error(E.Message, 'TTalkingForm.SendDropFile(' + AFileName + ')');
- end;
- end;
- procedure TTalkingForm.RichEdInputerDropFiles(Sender: TObject; AFiles: TStringList);
- var
- iLoop: Integer;
- iTimes: Integer;
- UpUrl: string;
- AFileSize: int64;
- begin
- iTimes := 0;
- for iLoop := 0 to AFiles.Count - 1 do
- begin
- try
- if FileExists(AFiles[iLoop]) and (RichEdInputer.InsertDIB) then
- begin
- if (AFiles.Count = 1) then
- begin
- AddImageToInput(AFiles[iLoop], RichEdInputer);
- Break;
- end;
- end;
- except
- on E: Exception do
- Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles-RichEdInputer.InsertDIB');
- end;
- try
- if FCategory = tcTeam then
- begin
- if TGroupConfig.GetConfig.GroupVersion = gvIntegration then
- begin
- if not (MessageBox(0, '确定要群发该文件吗? ', '提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK) then
- Exit;
- TFileTransmitAdapter.Send(Self, tdSender, AFiles[iLoop], 1, FTeamID, '', Now, FRealICQClient);
- end
- else
- TTeamShareAdapter.UploadFile(TeamID, AFiles[iLoop], Self, FRealICQClient, True);
- end
- else
- begin
- if DirectoryExists(AFiles[iLoop]) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
- begin
- OpenSendFolderForm(AFiles[iLoop]);
- Exit;
- end;
- if (iTimes < 10) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
- begin
- SendDropFile(AFiles[iLoop]);
- Inc(iTimes);
- end;
- end;
- except
- on E: Exception do
- Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles');
- end;
- end;
- end;
- procedure TTalkingForm.RichEdInputerInsertObject(Sender: TObject);
- begin
- TimerForCheckPastedContent.Enabled := False;
- TimerForCheckPastedContent.Tag := 0;
- TimerForCheckPastedContent.Enabled := True;
- end;
- { TODO -olqq -c : 群共享文件发送完成后,通知群成员 2014/12/18 14:45:09 }
- procedure TTalkingForm.DownFileComplete(ASource, ADest, ARemark: string; AStatus: boolean; AFileSize: Integer; IsNeedNotify: Boolean);
- var
- MessageStr: string;
- FaceFileName: TStringList;
- IsAdmin: string;
- begin
- if not AStatus then
- begin
- spbUploadTeamFileProcess.Visible := False;
- Messagebox(handle, PAnsiChar(ARemark), '提示', MB_OK);
- Exit;
- end;
- if IsNeedNotify then
- TTeamShareAdapter.UploadedNotifyToMembers(FRealICQClient.LoginName, TTeamsAdapter.GetTeam(FTeamID).TeamMembers, ARemark, ExtractFileName(ADest), AFileSize, FRealICQClient);
- if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
- IsAdmin := '1'
- else
- IsAdmin := '0';
- spbUploadTeamFileProcess.Visible := False;
- spbUploadTeamFileProcess.Caption := '%0';
- FaceFileName := TStringList.Create;
- try
- MessageStr := '<TeamShare>' + ExtractFileName(ADest) + '</TeamShare>';
- TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, FaceFileName, '');
- finally
- FaceFileName.Free;
- end;
- WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
- end;
- procedure TTalkingForm.DropFiles(var Message: TMessage);
- var
- i: Integer;
- p: array[0..254] of Char;
- ALocalFile, AFileExt, ALocalPath, ALocalFilePath: string;
- iTimes: Integer;
- UpUrl: string;
- AFileSize: Int64;
- begin
- iTimes := 0;
- try
- i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
- for i := 0 to i - 1 do
- begin
- DragQueryFile(Message.wParam, i, p, 255);
- if FileExists(StrPas(p)) then
- begin
- ALocalFile := StrPas(p);
- //Success(ALocalFile, 'TTalkingForm.DropFiles');
- AFileExt := ExtractFileExt(ALocalFile);
- if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
- begin
- ALocalPath := ExtractFilePath(Application.ExeName);
- ALocalFilePath := ExtractFilePath(ALocalFile);
- ALocalFilePath := Copy(ALocalFilePath, 1, Length(ALocalPath));
- if AnsiSameText(ALocalPath, ALocalFilePath) then
- begin
- Continue;
- end;
- end;
- if FCategory = tcTeam then
- begin
- TTeamShareAdapter.UploadFile(TeamID, StrPas(p), Self, FRealICQClient, False);
- end
- else if FCategory = tcNormal then
- begin
- if DirectoryExists(StrPas(p)) then
- begin
- if MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
- OpenSendFolderForm(StrPas(p));
- end;
- end;
- end;
- end;
- except
- on E: Exception do
- begin
- Error(E.Message, 'TTalkingForm.DropFiles');
- DragFinish(Message.wParam);
- Message.Result := 1;
- end;
- end;
- DragFinish(Message.wParam);
- Message.Result := 1;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowInputting(AInputting: Boolean);
- var
- UserName: string;
- RealICQUser: TRealICQUser;
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(RealICQUser) then
- UserName := FReceiver
- else if RealICQUser.DisplayName = '' then
- UserName := RealICQUser.LoginName
- else
- UserName := RealICQUser.DisplayName;
- if AInputting then
- begin
- lblState.Caption := UserName + ' 正在输入消息...';
- Caption := UserName + ' 正在输入';
- ClearInputtingMessageTimer.Enabled := False;
- ClearInputtingMessageTimer.Enabled := True;
- end
- else
- begin
- lblState.Caption := '';
- Caption := UserName;
- ClearInputtingMessageTimer.Enabled := False;
- end;
- PostMessage(Handle, WM_SIZE, 0, 0);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.P2PTypeChanged(Sender: TObject);
- var
- RealICQPtoPBox: TRealICQPtoPBox;
- begin
- if not (Sender is TRealICQPtoPBox) then
- Exit;
- try
- RealICQPtoPBox := Sender as TRealICQPtoPBox;
- case RealICQPtoPBox.P2PType of
- ppTransByServerTCP:
- lblState.Caption := '连接方式: 服务器中转';
- ppPtoPByTCPServer:
- lblState.Caption := '连接方式: TCP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ' -> 本机)';
- ppPtoPByTCPClient:
- lblState.Caption := '连接方式: TCP直连(本机 -> ' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
- ppPtoPByUDP:
- lblState.Caption := '连接方式: UDP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
- end;
- except
- end;
- end;
- procedure TTalkingForm.OpenSendFolderForm(FolderName: string);
- var
- SendFolderForm: TSendFolderForm;
- RealICQUser: TRealICQUser;
- iLoop: Integer;
- ReceiverName: string;
- begin
- if not MainForm.RealICQClient.Connected or not MainForm.RealICQClient.Logined then
- Exit;
- SendFolderForm := TSendFolderForm.Create(MainForm);
- if Category = tcNormal then
- begin
- if AnsiSameText(Receiver, MainForm.RealICQClient.LoginName) then
- Exit;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(RealICQUser) then
- Exit;
- with SendFolderForm.lvUsers.Items.Add do
- begin
- Caption := RealICQUser.LoginName;
- SubItems.Add(RealICQUser.DisplayName);
- end;
- end
- else
- begin
- Exit;
- end;
- SendFolderForm.Show;
- // SendFolderForm.BringToFront;
- if DirectoryExists(FolderName) then
- begin
- SendFolderForm.AddFolderMission(FolderName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbSendFolderClick(Sender: TObject);
- begin
- OpenSendFolderForm('');
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbAboutClick(Sender: TObject);
- begin
- MainForm.actAbout.Execute;
- end;
- procedure TTalkingForm.spbBackgroundClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- if SelBackForm = nil then
- begin
- SelBackForm := TSelBackForm.Create(MainForm);
- end;
- SelBackForm.ParentForm := Self;
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- Point.X := Point.X - (SelBackForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
- if Point.X <= 0 then
- SelBackForm.Left := 1
- else if Screen.WorkAreaWidth - Point.X >= SelBackForm.Width then
- SelBackForm.Left := Point.X
- else
- SelBackForm.Left := Screen.WorkAreaWidth - SelBackForm.Width - 1;
- if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelBackForm.Height) then
- SelBackForm.Top := Point.Y - SelBackForm.Height - (Sender as TRealICQSpeedButton).Height
- else
- SelBackForm.Top := Point.Y;
- SelBackForm.Show;
- end;
- procedure ShowCopyScreenForm(ATalkingForm: TTalkingForm);
- begin
- if Assigned(CopyScreenForm) then
- Exit;
- if ATalkingForm <> nil then
- CopyScreenForm := TCopyScreenForm.Create(ATalkingForm)
- else
- CopyScreenForm := TCopyScreenForm.Create(MainForm);
- try
- CopyScreenForm.TalkingForm := ATalkingForm;
- CopyScreenForm.WindowState := wsMaximized;
- CopyScreenForm.ShowModal; //显示窗口
- finally
- FreeAndNil(CopyScreenForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbFaceClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- if SelFaceForm = nil then
- begin
- SelFaceForm := TSelFaceForm.Create(MainForm);
- end;
- SelFaceForm.TalkingForm := Self;
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- Point.X := Point.X - (SelFaceForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
- if Point.X <= 0 then
- SelFaceForm.Left := 1
- else if Screen.WorkAreaWidth - Point.X >= SelFaceForm.Width then
- SelFaceForm.Left := Point.X
- else
- SelFaceForm.Left := Screen.WorkAreaWidth - SelFaceForm.Width - 1;
- if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelFaceForm.Height) then
- SelFaceForm.Top := Point.Y - SelFaceForm.Height - (Sender as TRealICQSpeedButton).Height
- else
- SelFaceForm.Top := Point.Y;
- SelFaceForm.Show;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbFontClick(Sender: TObject);
- begin
- EditFontSet.Execute;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SpbForMyInfoClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- if FRealICQClient = MainForm.RealICQClient then
- ppMyOptions.Popup(Point.X, Point.Y)
- else
- MainForm.ppChangeCustomerState.Popup(Point.X, Point.Y);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SpbForYourInfoClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- ppYourOptions.Popup(Point.X, Point.Y);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShakeWindow;
- var
- iLoop: Integer;
- OldLeft: Integer;
- begin
- PlayEventSound(ExtractFilePath(Application.ExeName) + '\' + ShakeWindowSound);
- OldLeft := Left;
- try
- for iLoop := 12 downto 0 do
- begin
- if iLoop mod 2 = 0 then
- Left := OldLeft + iLoop * 1
- else
- Left := OldLeft - iLoop * 1;
- Sleep(10);
- Application.ProcessMessages;
- Sleep(10);
- end;
- finally
- Left := OldLeft;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbShakeWindowClick(Sender: TObject);
- var
- FRealICQUser: TRealICQUser;
- begin
- if GetTickCount - FLastSendShakeWindowTicket < 150000 then
- begin
- MessageBox(Handle, '请勿频繁发送窗口抖动! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if Assigned(FRealICQUser) then
- begin
- if (FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden) then
- begin
- MessageBox(Handle, '对方离线或隐身,无法接收窗口抖动! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FLastSendShakeWindowTicket := GetTickCount;
- ShowShakeWindow(True);
- (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SendShakeWindow;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SetBrowserBg(BackImage: string);
- begin
- FBackGroundImage := BackImage;
- try
- SetDomStyle(WebBrowser.Document as IHtmlDocument2);
- except
- end;
- SaveBackGround;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.ShowShakeWindow(AIsSource: Boolean);
- var
- HTML: string;
- UserName: string;
- RealICQUser: TRealICQUser;
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
- if not Assigned(RealICQUser) then
- UserName := FReceiver
- else if RealICQUser.DisplayName = '' then
- UserName := RealICQUser.LoginName
- else
- UserName := RealICQUser.DisplayName;
- HTML := '<table width="100%" style="font-size:9pt;border:0px; padding:2px; color:#0000ff; margin-top:2px;margin-bottom:5px;"><tr><td>';
- HTML := HTML + '<img src="' + ExtractFilePath(Application.ExeName) + InfomationPicture + '" align="absBottom"> ';
- HTML := HTML + '<span>';
- if AIsSource then
- HTML := HTML + '您抖动了 ' + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 的对话窗口。'
- else
- HTML := HTML + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 抖动了您的对话窗口。';
- HTML := HTML + '</span>';
- HTML := HTML + '</td></tr></table>';
- InsertHTML(WebBrowser, HTML);
- Application.ProcessMessages;
- ShakeWindow;
- Sleep(450);
- ShakeWindow;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbSpkClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- miOpenMic.Visible := False;
- miCloseMic.Visible := False;
- miOpenSpeak.Visible := True;
- miCloseSpeak.Visible := True;
- miOpenSpeak.Enabled := not TAudioTransmitter.GetRecvAudio;
- miCloseSpeak.Enabled := TAudioTransmitter.GetRecvAudio;
- ppAudioSet.Popup(Point.X, Point.Y);
- end;
- procedure TTalkingForm.spbTeamNetWorkDiskClick(Sender: TObject);
- var
- STR: string;
- IsAdmin: string;
- begin
- if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
- IsAdmin := '1'
- else
- IsAdmin := '0';
- LockWindowUpdate(GetDesktopWindow);
- try
- Width := 800;
- PnlTeamCallBoard.Visible := False;
- rndTeamMembers.Visible := False;
- pnlUserInformation.Width := 450;
- pnlTeamWebDisk.Visible := True;
- WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
- //WebBrowserForTeamDisk.OnDocumentComplete := WebBrowserForTeamDiskDocumentComplete;
- //STR := 'http://192.168.16.202:8083/home/index?loginname='+MainForm.RealICQClient.LoginName+'&teamid='+TeamID+'&displayname='+HttpEncode(Ansitoutf8(MainForm.RealICQClient.Me.DisplayName)+'&isAdmin='+IsAdmin);
- // STR := MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount);
- // WebBrowserForTeamDisk.Navigate(MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
- //WebBrowserForTeamDisk.Navigate('http://172.28.1.76/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
- finally
- LockWindowUpdate(0);
- end;
- end;
- procedure TTalkingForm.spbCloseTeamWebDiskClick(Sender: TObject);
- var
- iLoop: Integer;
- AFileMission: TUploadOrDownloadFileMission;
- AFinded: Boolean;
- begin
- AFinded := False;
- if FUpDownFileMissions.Count > 0 then
- begin
- {for iLoop := UpDownFileMissions.Count - 1 downto 0 do
- begin
- AFileMission := UpDownFileMissions[iLoop];
- if AFileMission.Category = 3 then
- begin
- AFinded := True;
- Break;
- end;
- end;
-
- if MessageBox(Handle, '有文件正在上传,确定要关闭吗?',
- '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- begin
- Exit;
- end; }
- for iLoop := UpDownFileMissions.Count - 1 downto 0 do
- begin
- AFileMission := UpDownFileMissions[iLoop];
- if AFileMission.Category = 3 then
- begin
- try
- try
- AFileMission.Stop;
- finally
- FreeAndNil(AFileMission);
- end;
- except
- end;
- end;
- end;
- end;
- LockWindowUpdate(GetDesktopWindow);
- try
- PnlTeamCallBoard.Visible := True;
- pnlTeamMembers.Visible := True;
- rndTeamMembers.Visible := True;
- pnlUserInformation.Width := 200;
- pnlTeamWebDisk.Visible := False;
- WindowState := wsNormal;
- Width := 580;
- finally
- LockWindowUpdate(0);
- end;
- end;
- procedure TTalkingForm.SendOfflineFile(AFileName: string);
- var
- //FRealICQUser: TRealICQUser;
- AFileStream: TFileStream;
- ALoginName: string;
- RealICQUser: TRealICQUser;
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- AError: string;
- begin
- try
- if (TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient)) then
- raise Exception.Create(AError);
- if FCategory = tcNormal then
- begin
- if not (MessageBox(Handle, PChar('确定要发送“' + AFileName + '”吗? '), '提示', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = IDYES) then
- Exit;
- TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
- {$region '更新“最近联系人列表”中的数据'}
- ALoginName := FReceiver;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- if RealICQUser <> nil then
- begin
- ItemIndex := MainForm.ListViewLatests.Items.IndexOf(ALoginName);
- if ItemIndex = -1 then
- ItemIndex := MainForm.ListViewLatests.Items.Add(ALoginName);
- RealICQContacterListItem := MainForm.ListViewLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- MainForm.BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- RealICQContacterListItem.MoveToTop;
- end;
- {$endregion}
- end
- else
- begin
- TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
- end;
- except
- on E: Exception do
- MessageBox(0, PChar(E.Message), '发送文件出错', MB_ICONINFORMATION);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbUploadFileClick(Sender: TObject);
- var
- //FRealICQUser: TRealICQUser;
- AFileStream: TFileStream;
- ALoginName, AFileName: string;
- RealICQUser: TRealICQUser;
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- begin
- if not FRealICQClient.Connected or not FRealICQClient.Logined then
- Exit;
- OpenDialog.Title := '传输离线文件';
- if OpenDialog.Execute then
- begin
- SendOfflineFile(OpenDialog.FileName);
- end;
- end;
- //------------------------------------------------------------------------------
- //procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
- //begin
- // if FCategory = tcTeam then
- // begin
- // MainForm.actMsgManagerExecute(nil);
- // Application.ProcessMessages;
- // MessagesManagerForm.ShowTeamsMessages(FTeamID);
- // end
- // else
- // if FCategory = tcNormal then
- // begin
- // if FReceiver <> '' then
- // begin
- // MainForm.actMsgManagerExecute(nil);
- // Application.ProcessMessages;
- // MessagesManagerForm.ShowUsersMessages(FReceiver);
- // end;
- // end;
- //end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
- var
- Point1, Point2: TPoint;
- begin
- point1 := Point(0, 0);
- point2 := Point(0, 0);
- Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
- GetCursorPos(point2);
- if (point2.X - point1.X) <= 17 then
- begin
- if FCategory = tcTeam then
- begin
- MainForm.actMsgManagerExecute(nil);
- Application.ProcessMessages;
- MessagesManagerForm.ShowTeamsMessages(FTeamID);
- end
- else if FCategory = tcNormal then
- begin
- if FReceiver <> '' then
- begin
- MainForm.actMsgManagerExecute(nil);
- Application.ProcessMessages;
- MessagesManagerForm.ShowUsersMessages(FReceiver);
- end
- end
- end
- else
- begin
- Point1.X := 0;
- Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
- ppForMsg.Popup(Point1.X, Point1.Y);
- end;
- end;
- procedure TTalkingForm.spbMicClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- miOpenMic.Visible := True;
- miCloseMic.Visible := True;
- miOpenMic.Enabled := not TAudioTransmitter.GetSendAudio;
- miCloseMic.Enabled := TAudioTransmitter.GetSendAudio;
- miOpenSpeak.Visible := False;
- miCloseSpeak.Visible := False;
- ppAudioSet.Popup(Point.X, Point.Y);
- end;
- procedure TTalkingForm.spbRemoteControlClick(Sender: TObject);
- begin
- if FRemoteControlMission <> nil then
- begin
- MessageBox(Handle, '请先结束已存在的远程协助任务! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FRealICQClient.CreateRemoteControlTransmitter(Receiver);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.TeamUpFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: string);
- var
- Completed: Integer;
- begin
- if ulProgressMax = 0 then
- Exit;
- Completed := ulProgress * 100 div ulProgressMax;
- spbUploadTeamFileProcess.Caption := IntToStr(Completed) + '%';
- end;
- procedure TTalkingForm.TimerForCheckPastedContentTimer(Sender: TObject);
- begin
- TimerForCheckPastedContent.Tag := TimerForCheckPastedContent.Tag + 1;
- if TimerForCheckPastedContent.Tag >= 2 then
- TimerForCheckPastedContent.Enabled := False;
- CheckPastedContent(False);
- end;
- procedure TTalkingForm.TimerForGetUserInformationTimer(Sender: TObject);
- var
- FRealICQUser: TRealICQUser;
- begin
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(FRealICQUser) then
- Exit;
- TimerForGetUserInformation.Enabled := False;
- if FRealICQUser.DisplayName = '' then
- TUsersService.GetUsersService.GetOrRequestUser(FRealICQUser.LoginName, FRealICQClient);
- if not FRealICQUser.GettedOffliceAutoResponseSet then
- FRealICQClient.GetOffliceAutoResponseSet(FRealICQUser.LoginName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.tsMyHeadImageShow(Sender: TObject);
- begin
- if FMinWidthOfYourPanel < pnlUserInformation.Width then
- pnlUserInformation.Width := FMinWidthOfYourPanel;
- if (FMinWidthOfYourPanel <= 114) then
- begin
- pnlUserInformation.Width := 114;
- end;
- FMinWidthOfMyPanel := 114;
- lblMyInfo.Caption := '我的头像';
- pnlMyInfo.Constraints.MinHeight := 146;
- pnlMyInfo.Height := 146;
- rndMyInfo.Top := 0;
- rndMyInfo.Height := 140;
- rndMy.Height := 100;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.tsMyCardShow(Sender: TObject);
- begin
- if (FMinWidthOfYourPanel <= 200) then
- begin
- pnlUserInformation.Width := 200;
- end;
- FMinWidthOfMyPanel := 200;
- lblMyInfo.Caption := '我的名片';
- pnlMyInfo.Constraints.MinHeight := 174;
- pnlMyInfo.Height := 174;
- rndMyInfo.Top := 0;
- rndMyInfo.Height := 168;
- rndMy.Height := 128;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.tsMyVideoShow(Sender: TObject);
- begin
- lblMyInfo.Caption := '我的视频';
- if miMyVideoBigSize.Checked then
- begin
- if (FMinWidthOfYourPanel <= 180 + 160) then
- begin
- pnlUserInformation.Width := 180 + 160;
- end;
- FMinWidthOfMyPanel := 180 + 160;
- pnlMyInfo.Constraints.MinHeight := 40 + 6 + 244;
- pnlMyInfo.Height := 40 + 6 + 244;
- rndMyInfo.Top := 0;
- rndMyInfo.Height := 284;
- rndMy.Height := 244;
- imgMyVideo.Width := 320;
- imgMyVideo.Height := 240;
- end
- else if miMyVideoMiddleSize.Checked then
- begin
- if (FMinWidthOfYourPanel <= 180 + 80) then
- begin
- pnlUserInformation.Width := 180 + 80;
- end;
- FMinWidthOfMyPanel := 180 + 80;
- pnlMyInfo.Constraints.MinHeight := 40 + 6 + 184;
- pnlMyInfo.Height := 40 + 6 + 184;
- rndMyInfo.Top := 0;
- rndMyInfo.Height := 224;
- rndMy.Height := 184;
- imgMyVideo.Width := 240;
- imgMyVideo.Height := 180;
- end
- else
- begin
- if (FMinWidthOfYourPanel <= 180) then
- begin
- pnlUserInformation.Width := 180;
- end;
- FMinWidthOfMyPanel := 180;
- pnlMyInfo.Constraints.MinHeight := 40 + 6 + 124;
- pnlMyInfo.Height := 40 + 6 + 124;
- rndMyInfo.Top := 0;
- rndMyInfo.Height := 164;
- rndMy.Height := 124;
- imgMyVideo.Width := 160;
- imgMyVideo.Height := 120;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.tsYourHeadImageShow(Sender: TObject);
- begin
- if FMinWidthOfMyPanel < pnlUserInformation.Width then
- pnlUserInformation.Width := FMinWidthOfMyPanel;
- if (FMinWidthOfMyPanel <= 114) then
- begin
- pnlUserInformation.Width := 114;
- end;
- FMinWidthOfYourPanel := 114;
- lblYourInfo.Caption := '他的头像';
- pnlYourInfo.Constraints.MinHeight := 146;
- pnlYourInfo.Height := 146;
- rndYourInfo.Top := 0;
- rndYourInfo.Height := 140;
- rndYour.Height := 100;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.tsYourCardShow(Sender: TObject);
- begin
- if (FMinWidthOfMyPanel <= 200) then
- begin
- pnlUserInformation.Width := 200;
- end;
- FMinWidthOfYourPanel := 200;
- lblYourInfo.Caption := '他的名片';
- pnlYourInfo.Constraints.MinHeight := 174;
- pnlYourInfo.Height := 174;
- rndYourInfo.Top := 0;
- rndYourInfo.Height := 168;
- rndYour.Height := 128;
- end;
- procedure TTalkingForm.tsYourVideoShow(Sender: TObject);
- begin
- lblMyInfo.Caption := '他的视频';
- if miYourVideoBigSize.Checked then
- begin
- if (FMinWidthOfMyPanel <= 180 + 160) then
- begin
- pnlUserInformation.Width := 180 + 160;
- end;
- FMinWidthOfYourPanel := 180 + 160;
- pnlYourInfo.Constraints.MinHeight := 40 + 6 + 244;
- pnlYourInfo.Height := 40 + 6 + 244;
- rndYourInfo.Top := 0;
- rndYourInfo.Height := 284;
- rndYour.Height := 244;
- imgYourVideo.Width := 320;
- imgYourVideo.Height := 240;
- end
- else if miYourVideoMiddleSize.Checked then
- begin
- if (FMinWidthOfMyPanel <= 180 + 80) then
- begin
- pnlUserInformation.Width := 180 + 80;
- end;
- FMinWidthOfYourPanel := 180 + 80;
- pnlYourInfo.Constraints.MinHeight := 40 + 6 + 184;
- pnlYourInfo.Height := 40 + 6 + 184;
- rndYourInfo.Top := 0;
- rndYourInfo.Height := 224;
- rndYour.Height := 184;
- imgYourVideo.Width := 240;
- imgYourVideo.Height := 180;
- end
- else
- begin
- if (FMinWidthOfMyPanel <= 180) then
- begin
- pnlUserInformation.Width := 180;
- end;
- FMinWidthOfYourPanel := 180;
- pnlYourInfo.Constraints.MinHeight := 40 + 6 + 124;
- pnlYourInfo.Height := 40 + 6 + 124;
- rndYourInfo.Top := 0;
- rndYourInfo.Height := 164;
- rndYour.Height := 124;
- imgYourVideo.Width := 160;
- imgYourVideo.Height := 120;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miShowYourCardClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcYourInfo.ActivePageIndex := 1;
- Application.ProcessMessages;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miShowYourHeadImageClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcYourInfo.ActivePageIndex := 0;
- Application.ProcessMessages;
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- end;
- procedure TTalkingForm.miShowYourVideoClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcYourInfo.ActivePageIndex := 2;
- Application.ProcessMessages;
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miStopAudioTransmiteClick(Sender: TObject);
- begin
- if FAudioMission <> nil then
- FAudioMission.Stop;
- end;
- procedure TTalkingForm.miTeamAddFriendClick(Sender: TObject);
- begin
- miAddFriendClick(nil);
- end;
- procedure TTalkingForm.miTeamSeeUserInfoClick(Sender: TObject);
- begin
- SeeUserInformation(ALoginName);
- end;
- procedure TTalkingForm.miTeamSendMessageClick(Sender: TObject);
- begin
- if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
- begin
- //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- OpenTalkingForm(ALoginName);
- end;
- procedure TTalkingForm.miTeamSMSClick(Sender: TObject);
- begin
- OpenSMSForm(ALoginName);
- end;
- procedure TTalkingForm.miVideoSetClick(Sender: TObject);
- var
- SysDev: TSysDevEnum;
- begin
- SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
- try
- try
- VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(FRealICQClient.VideoDeviceID);
- except
- VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(0);
- end;
- CaptureGraph.Active := True;
- ShowFilterPropertyPage(Self.Handle, VideoSourceFilter as IBaseFilter);
- finally
- FreeAndNil(SysDev);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miYourVideoSmallSizeClick(Sender: TObject);
- begin
- if pgcYourInfo.ActivePage = tsYourVideo then
- begin
- Application.ProcessMessages;
- Sleep(200);
- tsYourVideoShow(tsYourVideo);
- Application.ProcessMessages;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miMyVideoSmallSizeClick(Sender: TObject);
- begin
- if pgcMyInfo.ActivePage = tsMyVideo then
- begin
- Application.ProcessMessages;
- Sleep(200);
- tsMyVideoShow(tsMyVideo);
- Application.ProcessMessages;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
- const
- CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
- var
- CmdTarget: IOleCommandTarget;
- PtrGUID: PGUID;
- begin
- New(PtrGUID);
- if InvokeIE then
- PtrGUID^ := CLSID_WebBrowser
- else
- PtrGuid := PGUID(nil);
- if WebBrowser.Document <> nil then
- try
- WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget);
- if CmdTarget <> nil then
- try
- CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
- finally
- CmdTarget._Release;
- end;
- except
- end;
- Dispose(PtrGUID);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miAddFriendClick(Sender: TObject);
- var
- iIndex: Integer;
- ListItem: TRealICQContacterListItem;
- ADisplayName: string;
- begin
- ADisplayName := '';
- if AnsiSameText(FRealICQClient.LoginName, ALoginName) then
- begin
- //MessageBox(Handle, '不能添加自己为好友! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- iIndex := FLVTeamMembers.Items.IndexOf(ALoginName);
- if iIndex > -1 then
- begin
- ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
- ADisplayName := ListItem.DisplayName;
- end;
- ShowAddFriendWindow(Self, ALoginName, ADisplayName);
- end;
- //------------------------------------------------------------------------------
- //添加聊天内容到工单系统
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miAddWorkOrderClick(Sender: TObject);
- begin
- miCopyFromIEClick(nil);
- MainForm.WebBrowserForPostWorkOrder.Navigate('about:blank');
- // TThreadPost.Create(FRealICQClient.WebAppBaseURL+'/PostWordOrder.aspx',ClipBoard.AsText);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miCloseMicClick(Sender: TObject);
- begin
- ImgLstForAudio.GetIcon(1, spbMic.Icon);
- TAudioTransmitter.SetSendAudio(False);
- MicrophoneVolume.PeakValue := 0;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miOpenMicClick(Sender: TObject);
- begin
- ImgLstForAudio.GetIcon(0, spbMic.Icon);
- TAudioTransmitter.SetSendAudio(True);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miCloseSpeakClick(Sender: TObject);
- begin
- ImgLstForAudio.GetIcon(3, spbSpk.Icon);
- TAudioTransmitter.SetRecvAudio(False);
- MasterVolume.PeakValue := 0;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miOpenSpeakClick(Sender: TObject);
- begin
- ImgLstForAudio.GetIcon(2, spbSpk.Icon);
- TAudioTransmitter.SetRecvAudio(True);
- end;
- procedure TTalkingForm.miPasteImgClick(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miCopyFromIEClick(Sender: TObject);
- var
- vaIn, vaOut: Olevariant;
- begin
- if actSaveImgAs.Enabled then
- begin
- CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + FFaceMenuAtFileName + '">'));
- end
- else
- begin
- InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
- end;
- end;
- //----------复制图片到剪贴版------------------------------
- procedure TTalkingForm.miCopyImageClick(Sender: TObject);
- var
- Face: TFace;
- begin
- if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
- Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace
- else
- Face := MainForm.FaceList.Objects[FRightMouseClickedFace.FaceIndex] as TFace;
- CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + Face.FileName + '">'));
- //CopyFilesToClipboard(Face.FileName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSelAllFromIEClick(Sender: TObject);
- var
- vaIn, vaOut: Olevariant;
- begin
- InvokeCmd(FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
- end;
- procedure TTalkingForm.miSendMessageClick(Sender: TObject);
- begin
- if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
- begin
- //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- OpenTalkingForm(ALoginName);
- end;
- procedure TTalkingForm.miSendSmsClick(Sender: TObject);
- begin
- OpenSmsForm(ALoginName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSaveMyVideoImageAsClick(Sender: TObject);
- begin
- SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
- if SaveDialog.Execute then
- begin
- ImgMyVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
- end;
- end;
- procedure TTalkingForm.miSaveToWebClick(Sender: TObject);
- begin
- miCopyFromIEClick(nil);
- Application.ProcessMessages;
- Sleep(100);
- Application.ProcessMessages;
- MainForm.RealICQClient.CallServerDBProcedure('YJ_AddTempRemark', ClipBoard.AsText);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSaveYourVideoImageAsClick(Sender: TObject);
- begin
- SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
- if SaveDialog.Execute then
- begin
- ImgYourVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSeeTeamDetailInformationClick(Sender: TObject);
- var
- iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- ATeam := TTeamsAdapter.GetTeam(FTeamID);
- if ATeam <> nil then
- OpenTeamOptionsForm(ATeam);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSeeUserInformationClick(Sender: TObject);
- begin
- SeeUserInformation(ALoginName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miSeeYourDetailInformationClick(Sender: TObject);
- begin
- SeeUserInformation(Receiver);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miShowMyCardClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcMyInfo.ActivePageIndex := 1;
- Application.ProcessMessages;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miShowMyHeadImageClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcMyInfo.ActivePageIndex := 0;
- Application.ProcessMessages;
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- end;
- procedure TTalkingForm.miShowMyVideoClick(Sender: TObject);
- begin
- Application.ProcessMessages;
- Sleep(200);
- (Sender as TMenuItem).Checked := True;
- pgcMyInfo.ActivePageIndex := 2;
- Application.ProcessMessages;
- FOldWidthOfUserInfo := pnlUserInformation.Width;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.miShowVideoFormClick(Sender: TObject);
- begin
- miShowVideoForm.Checked := not miShowVideoForm.Checked;
- if miShowVideoForm.Checked then
- begin
- miShowYourHeadImageClick(miShowYourHeadImage);
- if VideoForm = nil then
- VideoForm := TVideoForm.Create(Self);
- VideoForm.TalkingForm := Self;
- VideoForm.Show;
- miShowYourVideo.Enabled := False;
- end
- else
- begin
- miShowYourVideoClick(miShowYourVideo);
- FreeAndNil(VideoForm);
- miShowYourVideo.Enabled := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.UpdateMyInfo;
- var
- GIFImage: TGIFImage;
- begin
- if FRealICQClient.Me = nil then
- Exit;
- Application.ProcessMessages;
- if FileExists(FRealICQClient.Me.HeadImageFile) then
- begin
- try
- if (FRealICQClient.Me.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
- try
- GIFImage.LoadFromFile(FRealICQClient.Me.HeadImageFile);
- if GIFImage.Animate then
- ImgHeadForMyInfo.Picture.Assign(GIFImage)
- else
- ImgHeadForMyInfo.Picture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- ImgHeadForMyInfo.Picture.LoadFromFile(FRealICQClient.Me.HeadImageFile);
- except
- ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
- end;
- end
- else
- begin
- ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
- end;
- cardMine.IsSeeRight := True;
- cardMine.RealICQUser := FRealICQClient.Me;
- // FRealICQClient.GetUserExInformation(cardMine.RealICQUser.LoginName);
- PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
- end;
- procedure TTalkingForm.UpdateAliasClick(Sender: TObject);
- var
- AliasName: string;
- begin
- AliasName := ShowMyInputBox('更改别名', '请输入您喜欢的别名', '', 20);
- if AliasName <> '' then
- TTeamsAdapter.SetAlias(FTeamID, ALoginName, AliasName);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.UpdateTeamMember(ARealICQUser: TRealICQUser);
- var
- ItemIndex: Integer;
- AListItem: TRealICQContacterListItem;
- AAlias: string;
- begin
- ItemIndex := FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName);
- if ItemIndex = -1 then
- Exit;
- AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- // MainForm.BindUserDataToItem(AListItem, ARealICQUser);
- //TODO 解决第一次都是LoginName的问题
- AAlias := TTeamsAdapter.GetAlias(FTeamID, AListItem.LoginName);
- if AAlias = '' then
- AAlias := ARealICQUser.DisplayName;
- MainForm.BindUserDataToItemForGroup(AListItem, ARealICQUser, AAlias);
- lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
- //FLVTeamMembers.Invalidate;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.UpdateTeamMembers;
- var
- iIndex, ItemIndex, iLoop: Integer;
- LoginName: string;
- MemberList: TStringList;
- // ATeam: TRealICQTeam;
- ATeam: TRealICQTeam;
- RealICQUser: TRealICQUser;
- AListItem: TRealICQContacterListItem;
- TeamName, AGroupAlias: string;
- ActionGetMembers: TAsynGetTeamMembers;
- begin
- { iIndex := FRealICQClient.Teams.IndexOf(FTeamID);
- if iIndex = -1 then Exit;
- ATeam := FRealICQClient.Teams.Objects[iIndex] as TRealICQTeam; }
- ATeam := TTeamsAdapter.GetTeam(FTeamID);
- MemberList := SplitString(ATeam.TeamMembers, Chr(10));
- ActionGetMembers := TAsynGetTeamMembers.Create(Self, MemberList);
- { try
- for iLoop := 0 to MemberList.Count - 1 do
- begin
- LoginName := Trim(MemberList[iLoop]);
- if Length(LoginName) = 0 then continue;
- AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
- RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
- if not Assigned(RealICQUser) then continue;
- //TODO: 获取手机信息和用户状态
- // if Trim(RealICQUser.DisplayName)='' then
- // MainForm.RealICQClient.GetUserInformation(LoginName,True)
- // else
- // MainForm.RealICQClient.GetUserLoginState(LoginName);
- // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
- // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
- ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
- if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
- AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- if Trim(AGroupAlias)='' then
- MainForm.BindUserDataToItem(AListItem, RealICQUser)
- else
- MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
- end;
- ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
- for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
- begin
- LoginName := FLVTeamMembers.Items[iLoop];
- if MemberList.IndexOf(LoginName) = -1 then
- begin
- FLVTeamMembers.Items.Delete(iLoop);
- end;
- end;
- finally
- MemberList.Free;
- end; }
- // try
- // for iLoop := 0 to MemberList.Count - 1 do
- // begin
- // LoginName := Trim(MemberList[iLoop]);
- // if Length(LoginName) = 0 then continue;
- // AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
- //
- // RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
- // if not Assigned(RealICQUser) then continue;
- // //TODO: 获取手机信息和用户状态
- // if Trim(RealICQUser.DisplayName)='' then
- // MainForm.RealICQClient.GetUserInformation(LoginName,True)
- // else
- // MainForm.RealICQClient.GetUserLoginState(LoginName);
- // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
- // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
- //
- // ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
- // if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
- // AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- // if Trim(AGroupAlias)='' then
- // MainForm.BindUserDataToItem(AListItem, RealICQUser)
- // else
- // MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
- // end;
- // //ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
- // for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
- // begin
- // LoginName := FLVTeamMembers.Items[iLoop];
- // if MemberList.IndexOf(LoginName) = -1 then
- // begin
- // FLVTeamMembers.Items.Delete(iLoop);
- // end;
- // end;
- // finally
- // MemberList.Free;
- // end;
- if ATeam.TeamCaption = '' then
- TeamName := ATeam.TeamID
- else
- TeamName := ATeam.TeamCaption;
- if ATeam.IsTempTeam then
- TeamName := '多人会话'
- else
- TeamName := TeamName + ' - 群组会话';
- Caption := TeamName;
- lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.SetTeamID(Value: string);
- var
- iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- //SpbEncryMessage.Visible := False;
- //chkEncryMessage.Visible := False;
- spbEncryMsg.Visible := False;
- spbNormalMsg.Visible := False;
- //spbUploadFile.Caption:='群发文件';
- spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
- //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
- miSeeTeamDetailInformation.Visible := True;
- miSeeYourDetailInformation.Visible := False;
- miShowYourHeadImage.Visible := False;
- miShowYourCard.Visible := False;
- actSendFile.Visible := False;
- actAudio.Visible := False;
- actVideo.Visible := False;
- actSeeTeamOptions.Visible := True;
- actQuitTeam.Visible := False;
- actDisbandTeam.Visible := False;
- spbSendFile.Visible := False;
- spbAudio.Visible := False;
- spbVideo.Visible := False;
- spbRemoteControl.Visible := False;
- spbSendFolder.Visible := False;
- spbUserInfo.Visible := False;
- spbPostSMS.Visible := False;
- spbSeeTeamOptions.Visible := True;
- spbAddUser.Visible := True;
- spbQuitTeam.Visible := False;
- spbDisbandTeam.Visible := False;
- spbSendSMS.Visible := True;
- pnlYourInfo.Visible := False;
- // pnlMyInfo.Visible := False;
- pnlTeamCallBoard.Visible := True;
- pnlTeamMembers.Visible := True;
- spbShakeWindow.Visible := False;
- spbCopyScreen.left := spbShakeWindow.left;
- //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
- btnQR.Visible := False;
- spbSet.left := spbQuitTeam.left + spbQuitTeam.Width + 3;
- spbAbout.left := spbSet.left + spbSet.Width;
- if PnlTeamWebDisk.Visible then
- begin
- pnlTeamCallBoard.Visible := False;
- pnlTeamMembers.Visible := False;
- end
- else
- PnlTeamWebDisk.Visible := False;
- //spbUploadFile.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
- spbUploadFile.Visible := False;
- //spbTeamNetWorkDisk.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
- spbTeamNetWorkDisk.Caption := '群文件';
- FTeamID := Value;
- ATeam := TTeamsAdapter.GetTeam(FTeamID);
- if ATeam = nil then
- begin
- Caption := FTeamID + ' - 群组对话';
- Log(Format('找不到群ID为%s的群', [FTeamID]), 'SetTeamID');
- Exit;
- end;
- spbTeamNetWorkDisk.Visible := not ATeam.IsTempTeam;
- if FLVTeamMembers.Tag = 0 then
- begin
- {$region '生成显示群组成员列表的ListView'}
- if (FMinWidthOfMyPanel <= 200) then
- pnlTeamMembers.Width := 200;
- FMinWidthOfYourPanel := 200;
- MainForm.UpdateContacterListView(FLVTeamMembers);
- FLVTeamMembers.OnItemOnline := nil;
- FLVTeamMembers.OnItemOffline := nil;
- FLVTeamMembers.PopupMenu := ppUserItemRightMenu;
- FLVTeamMembers.Style := lsSmallHeadImage;
- FLVTeamMembers.CaptionStyle := csDisplayName;
- FLVTeamMembers.OnItemMouseEnter := nil;
- FLVTeamMembers.OnItemMouseLeave := nil;
- FLVTeamMembers.OnItemIconButtonClick := nil;
- //FLVTeamMembers.OnItemIconButtonDblClick := nil;
- FLVTeamMembers.ShowHeadImageButton := True;
- FLVTeamMembers.ChangeUIColor(FWindowColor);
- FLVTeamMembers.Tag := 1;
- {$endregion}
- end;
- UpdateTeamMembers;
- actDisbandTeam.Visible := AnsiSameText(ATeam.TeamCreater, FRealICQClient.LoginName);
- actQuitTeam.Visible := not actDisbandTeam.Visible;
- spbQuitTeam.Visible := actQuitTeam.Visible;
- spbDisbandTeam.Visible := actDisbandTeam.Visible;
- mmTeamCallBoard.Text := Trim(ATeam.TeamCallBoard);
- //spbSendImage.Left := spbShakeWindow.Left;
- //spbCopyScreen.Left := spbSendImage.Left + spbSendImage.Width + 3;
- //spbCopyScreen2.Left := spbCopyScreen.Left + spbCopyScreen.Width + 3;
- PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
- PostMessage(Handle, WM_SIZE, 0, 0);
- end;
- procedure TTalkingForm.SetReceiver(Value: string);
- var
- UserName: WideString;
- FRealICQUser: TRealICQUser;
- GIFImage: TGIFImage;
- ServerId: string;
- iPos: Integer;
- begin
- //SpbEncryMessage.Visible := True;
- //chkEncryMessage.Visible := True;
- spbEncryMsg.Visible := False;
- spbNormalMsg.Visible := True;
- //spbUploadFile.Caption:='离线文件';
- // MainForm.RealICQClient.GetUserExInformation(Value);
- spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
- //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
- FReceiver := Value;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
- if not Assigned(FRealICQUser) then
- Exit;
- if FRealICQUser.LoginAtWeb then
- begin
- miSeeTeamDetailInformation.Visible := False;
- miSeeYourDetailInformation.Visible := True;
- miShowYourHeadImage.Visible := True;
- miShowYourCard.Visible := True;
- actSendFile.Enabled := False;
- actAudio.Enabled := False;
- actVideo.Enabled := False;
- actSeeTeamOptions.Visible := False;
- actQuitTeam.Visible := False;
- actDisbandTeam.Visible := False;
- spbSendFile.Enabled := False;
- spbAudio.Enabled := False;
- spbVideo.Enabled := False;
- spbUploadFile.Enabled := False;
- spbRemoteControl.Enabled := False;
- spbSendFolder.Enabled := False;
- spbSendImage.Visible := False;
- spbCopyScreen.Visible := False;
- //spbCopyScreen2.Visible := False;
- spbSeeTeamOptions.Visible := False;
- spbAddUser.Visible := False;
- spbQuitTeam.Visible := False;
- spbDisbandTeam.Visible := False;
- pnlYourInfo.Visible := True;
- // pnlMyInfo.Visible := True;
- pnlTeamCallBoard.Visible := False;
- pnlTeamMembers.Visible := False;
- spbShakeWindow.Visible := True;
- btnQR.Visible := True;
- spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
- //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
- spbSet.left := spbAudio.left + spbAudio.Width;
- btnQR.left := spbSet.left + spbSet.Width + 2;
- spbAbout.left := btnQR.left + btnQR.Width + 2;
- end
- else
- begin
- miSeeTeamDetailInformation.Visible := False;
- miSeeYourDetailInformation.Visible := True;
- miShowYourHeadImage.Visible := True;
- miShowYourCard.Visible := True;
- actSendFile.Visible := True;
- actAudio.Visible := True;
- actVideo.Visible := True;
- actSeeTeamOptions.Visible := False;
- actQuitTeam.Visible := False;
- actDisbandTeam.Visible := False;
- spbSendFile.Visible := True;
- spbAudio.Visible := True;
- spbVideo.Visible := True;
- spbRemoteControl.Visible := True;
- spbSendFolder.Visible := True;
- spbUserInfo.Visible := True;
- spbPostSMS.Visible := True;
- spbSeeTeamOptions.Visible := False;
- spbAddUser.Visible := False;
- spbQuitTeam.Visible := False;
- spbDisbandTeam.Visible := False;
- pnlYourInfo.Visible := True;
- // pnlMyInfo.Visible := True;
- pnlTeamCallBoard.Visible := False;
- pnlTeamMembers.Visible := False;
- spbShakeWindow.Visible := True;
- btnQR.Visible := True;
- spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
- //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
- spbSet.left := spbAudio.left + spbAudio.Width;
- btnQR.left := spbSet.left + spbSet.Width + 2;
- spbAbout.left := btnQR.left + btnQR.Width + 2;
- end;
- PnlTeamWebDisk.Visible := False;
- spbTeamNetWorkDisk.Visible := False;
- if FileExists(FRealICQUser.HeadImageFile) then
- begin
- try
- if (FRealICQUser.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
- try
- GIFImage.LoadFromFile(FRealICQUser.HeadImageFile);
- if GIFImage.Animate then
- ImgHeadForYourInfo.Picture.Assign(GIFImage)
- else
- ImgHeadForYourInfo.Picture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- ImgHeadForYourInfo.Picture.LoadFromFile(FRealICQUser.HeadImageFile);
- except
- ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
- end;
- end
- else
- begin
- ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
- end;
- TimerForGetUserInformation.Enabled := True;
- if FRealICQUser.DisplayName = '' then
- begin
- UserName := FRealICQUser.LoginName;
- end
- else
- UserName := FRealICQUser.DisplayName;
- Caption := UserName;
- iPos := AnsiPos('-', FRealICQUser.LoginName);
- ServerId := Copy(FRealICQUser.LoginName, 1, iPos - 1);
- if AnsiPos('+', ServerId) > 0 then
- begin
- ServerId := Copy(ServerId, AnsiPos('+', ServerId) + 1, Length(ServerId));
- end;
- cardYour.CompanyName := FRealICQUser.Company;
- cardYour.BranchName := FRealICQUser.Branch;
- // if Trim(FRealICQUser.Company)='' then cardYour.CompanyName:=MainForm.GetCompany;
- // if Trim(FRealICQUser.Branch)='' then cardYour.BranchName:=MainForm.GetBranchName(FRealICQUser.LoginName);
- if TConditionConfig.GetConfig.UserInfoController then
- begin
- cardYour.IsSeeRight := (ServerId = MainForm.RealICQClient.ServerID);
- if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slAllCannotSee) then
- begin
- cardYour.IsSeeRight := False;
- end;
- if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slOnlyFriendCanSee) and not (TUsersService.GetUsersService.IsWorkmateOrFriend(FRealICQUser.LoginName)) then
- begin
- cardYour.IsSeeRight := False;
- end;
- end
- else
- cardYour.IsSeeRight := True;
- cardYour.RealICQUser := FRealICQUser;
- //FRealICQClient.GetUserExInformation(cardYour.RealICQUser.LoginName);
- if FRealICQClient.Logined and FRealICQClient.Connected then
- begin
- (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := nil;
- //(FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := P2PTypeChanged;
- //P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
- end
- else
- begin
- //lblState.Caption := '连接方式: 服务器中转';
- end;
- PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
- PostMessage(Handle, WM_SIZE, 0, 0);
- if FVCardFrom.pb1.Parent = FVCardFrom then
- begin
- FVCardFrom.pb1.Parent := Self.pnlUserInformation;
- FVCardFrom.pb1.Align := alTop;
- FVCardFrom.pb1.Height := Self.pnlUserInformation.Width;
- pnlYourInfo.Top := 0;
- end;
- FVCardFrom.LoginName := FReceiver;
- end;
- function RoundEx(R: Real): Integer;
- begin
- Result := Trunc(R);
- if Frac(R) >= 0.5 then
- Result := Result + 1;
- end;
- //-----设置LblSendSMS的位置----------------------------------
- procedure TTalkingForm.SetLblSendSMSPosition(HIntMsg: string);
- var
- iPos, TextWidth, Rows: integer;
- SubStr: string;
- chrWidth: Integer;
- begin
- iPos := AnsiPos('手机短信', HIntMsg);
- chrWidth := LblHint.Canvas.TextWidth('发');
- SubStr := Copy(HIntMsg, 1, iPos);
- TextWidth := LblHint.Canvas.TextWidth(SubStr + '手机短信');
- if TextWidth <= LblHint.Width then
- begin
- LblSendSMS.Caption := '手机短信';
- LblSendSMS.Left := LblHint.Left + LblHint.Canvas.TextWidth(SubStr) - 5;
- LblSendSMS.Top := LblHint.Top - 1;
- LblSendSMS1.Visible := false;
- end
- else
- begin
- Rows := TextWidth div LblHint.Width;
- iPos := LblHint.Width * Rows - LblHint.Canvas.TextWidth(SubStr);
- if iPos < (chrWidth div 2) then
- begin
- LblSendSMS.Caption := '手机短信';
- if abs(iPos) < (chrWidth div 2) then
- LblSendSMS.Left := lblHint.Left
- else
- begin
- iPos := RoundEx(abs(iPos) / chrWidth);
- LblSendSMS.Left := lblHint.Left + iPos * chrWidth;
- end;
- LblSendSMS.Top := LblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * (Rows);
- LblSendSMS1.Visible := false;
- end
- else
- begin
- iPos := RoundEx(iPos / chrWidth);
- LblSendSMS.Caption := Copy('手机短信', 1, iPos * 2);
- LblSendSMS.Left := lblHint.Left + lblHint.Canvas.TextWidth(SubStr) - 5;
- LblSendSMS.Top := lblHint.Top - 1;
- LblSendSMS1.Caption := Copy('手机短信', iPos * 2 + 1, Length('手机短信') - iPos * 2);
- LblSendSMS1.Left := lblHint.Left;
- LblSendSMS1.Top := lblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * Rows;
- LblSendSMS1.BringToFront;
- LblSendSMS1.Visible := True;
- end;
- end;
- LblSendSMS.BringToFront;
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.pnlDisplayerResize(Sender: TObject);
- var
- UserName, TeamName, AStateMsg, HIntMsg, HDestIntMsg: WideString;
- FRealICQUser: TRealICQUser;
- iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- FRealICQUser := nil;
- if FRealICQClient = nil then
- Exit;
- if FCategory = tcNormal then
- begin
- {$region '一对一的对话窗口'}
- if Length(FReceiver) = 0 then
- Exit;
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
- if Assigned(FRealICQUser) then
- begin
- if FRealICQUser.DisplayName = '' then
- UserName := FRealICQUser.LoginName
- else
- UserName := FRealICQUser.DisplayName;
- if (FRealICQUser.LoginState = stLeave) or (FRealICQUser.LoginState = stBusy) then
- AStateMsg := FRealICQUser.LeaveMessage
- else
- AStateMsg := StateValues[Integer(FRealICQUser.LoginState) mod 5];
- if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
- HDestIntMsg := '发送至: ' + UserName + '(出差)'
- else if FRealICQUser.Watchword = '' then
- HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ')'
- else
- HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ') - ' + FRealICQUser.Watchword;
- end
- else //这种情况是与服务器的连接已断开了
- begin
- HDestIntMsg := LblDest.Hint;
- end;
- {$endregion}
- end
- else
- begin
- {$region '群组模式对话窗体'}
- if Length(Trim(FTeamID)) <= 0 then
- Exit;
- ATeam := TTeamsAdapter.GetTeam(FTeamID);
- if ATeam = nil then //这种情况是与服务器的连接已断开了,或不再是这个群的成员了
- begin
- HDestIntMsg := LblDest.Hint;
- Log('与服务器的连接已断开了,或不再是这个群的成员', 'TTalkingForm.pnlDisplayerResize');
- end
- else
- begin
- if ATeam.TeamCaption = '' then
- TeamName := ATeam.TeamID
- else
- TeamName := ATeam.TeamCaption;
- if ATeam.IsTempTeam then
- TeamName := '多人对话'
- else
- TeamName := TeamName + '(群组对话)';
- if ATeam.TeamIntro = '' then
- HDestIntMsg := '参与群组: ' + TeamName
- else
- HDestIntMsg := '参与群组: ' + TeamName + ' - ' + AnsiReplaceStr(ATeam.TeamIntro, #$D#$A, ' ');
- end;
- {$endregion}
- end;
- {$region '相关提示信息'}
- pnlClient.Enabled := True;
- if (FRealICQClient.Me = nil) then
- begin
- AStateMsg := StateValues[Integer(stOffline)];
- HIntMsg := '您当前处于“' + AStateMsg + '”状态,不能发送任何消息!';
- LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
- // pnlHint.Visible := True;
- pnlClient.Enabled := False;
- end
- else if FCategory = tcNormal then
- begin
- if FRealICQClient.Blacklists.IndexOf(FRealICQUser.LoginName) >= 0 then
- begin
- //检查是否在黑名单列表中
- HIntMsg := '该用户已列入黑名单,将无法收到任何消息!';
- LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
- // pnlHint.Visible := True;
- end
- else if FRealICQUser.LoginState <> stOnline then
- begin
- if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
- HIntMsg := '对方处于“出差”状态,您可以发送手机短信联系他 - ' + FRealICQUser.OfflineAutoResponseText
- else
- HIntMsg := '对方处于“' + AStateMsg + '”状态,' + '您可以发送手机短信联系他。';
- LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
- // pnlHint.Visible := True;
- SetLblSendSMSPosition(HIntMsg);
- end
- else
- pnlHint.Visible := False;
- end
- else if FCategory = tcTeam then
- begin
- if TTeamsAdapter.GetTeam(FTeamID) = nil then
- begin
- HIntMsg := '您已不是群组“' + Caption + '”的成员,不能收发任何消息!';
- LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
- LblHint.Caption := HIntMsg;
- pnlHint.Height := LblHint.Height + 10;
- // pnlHint.Visible := True;
- pnlClient.Enabled := False;
- end
- else
- pnlHint.Visible := False;
- end
- else
- pnlHint.Visible := False;
- if (pnlHint.Visible = False) and (FRealICQClient.Me.LoginState <> stOnline) then
- begin
- if (FRealICQClient.Me.LoginState = stLeave) or (FRealICQClient.Me.LoginState = stBusy) then
- AStateMsg := FRealICQClient.Me.LeaveMessage
- else
- AStateMsg := StateValues[Integer(FRealICQClient.Me.LoginState)];
- HIntMsg := '您的当前状态为:' + AStateMsg;
- LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
- // pnlHint.Visible := True;
- end;
- LblHint.Caption := HIntMsg;
- pnlHint.Height := LblHint.Height + 10;
- {$endregion}
- {$region '消息接收方信息'}
- LblDest.Hint := HDestIntMsg;
- LblDest.ShowHint := False;
- //字符串长度过长时,截短字符串并在后面显示“...”
- while LblDest.Canvas.TextWidth(HDestIntMsg) > LblDest.Width do
- begin
- if Length(HDestIntMsg) > 3 then
- begin
- if Copy(HDestIntMsg, Length(HDestIntMsg) - 2, Length(HDestIntMsg)) = '...' then
- HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 3);
- HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 1) + '...';
- end
- else
- break;
- LblDest.ShowHint := True;
- end;
- LblDest.Caption := HDestIntMsg;
- {$endregion}
- end;
- procedure TTalkingForm.pnlTalkingAreaClick(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- function GetTalkingFormCount: Integer;
- begin
- Result := TalkingForms.Count;
- end;
- //------------------------------------------------------------------------------
- procedure CloseAllTalkingForm;
- var
- AForm: TTalkingForm;
- begin
- while TalkingForms.Count > 0 do
- begin
- AForm := TalkingForms[0];
- FreeAndNil(AForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure UpdateAllTakingFormGIFHeadImage;
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- FRealICQUser: TRealICQUser;
- begin
- for iLoop := TalkingForms.Count - 1 downto 0 do
- begin
- AForm := TalkingForms[iLoop];
- FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(AForm.FReceiver);
- if Assigned(FRealICQUser) then
- begin
- if FRealICQUser.HeadImageFileType = htGIF then
- AForm.SetReceiver(AForm.FReceiver);
- end;
- if AForm.FRealICQClient.Me.HeadImageFileType = htGIF then
- begin
- AForm.UpdateMyInfo;
- end;
- end;
- end;
- procedure UpdateAllTakingFormHotKeySet;
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := TalkingForms.Count - 1 downto 0 do
- begin
- AForm := TalkingForms[iLoop];
- AForm.actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage;
- AForm.actEnter.Checked := not MainForm.CtrlEnterSendMessage;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure SetAllTakingFormEnabledState(AEnableValue: Boolean);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := TalkingForms.Count - 1 downto 0 do
- begin
- AForm := TalkingForms[iLoop];
- if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
- begin
- FreeAndNil(AForm);
- continue;
- end;
- PostMessage(AForm.pnlDisplayer.Handle, WM_SIZE, 0, 0);
- AForm.pnlClient.Enabled := AEnableValue;
- if not AEnableValue then
- AForm.CancelAllSendFile;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure SetTalkingFormPosition(APrevForm, ATalkingForm: TTalkingForm; AShowActive: Boolean);
- begin
- if APrevForm <> nil then
- begin
- ATalkingForm.Left := APrevForm.Left + 20;
- ATalkingForm.Top := APrevForm.Top + 20;
- if (ATalkingForm.Left + ATalkingForm.Width > Screen.WorkAreaWidth) or (ATalkingForm.Top + ATalkingForm.Height > Screen.WorkAreaHeight) then
- begin
- ATalkingForm.Left := 0;
- ATalkingForm.Top := 0;
- end;
- end
- else
- begin
- //TalkingForm.Left := (Screen.WorkAreaWidth - TalkingForm.Width) div 2;
- //TalkingForm.Top := (Screen.WorkAreaHeight - TalkingForm.Height) div 2;
- end;
- if AShowActive then
- ATalkingForm.WindowState := wsNormal
- else
- ATalkingForm.WindowState := wsMinimized;
- ATalkingForm.Show;
- if AShowActive then
- begin
- ShowWindow(ATalkingForm.Handle, SW_SHOW);
- ForceForeGroundWindow(ATalkingForm.Handle);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure UpdateTalkingForm(ARealICQUser: TRealICQUser);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := TalkingForms.Count - 1 downto 0 do
- begin
- AForm := TalkingForms[iLoop];
- if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
- FreeAndNil(AForm)
- else
- AForm.UpdateMyInfo;
- if AForm.FCategory = tcNormal then
- begin
- if (AForm.FReceiver = ARealICQUser.LoginName) then
- begin
- AForm.SetReceiver(ARealICQUser.LoginName);
- end;
- end
- else
- begin
- if AForm.FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName) >= 0 then
- begin
- AForm.UpdateTeamMember(ARealICQUser);
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function GetTalkingForm(AReceiver: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- var
- iLoop: Integer;
- TalkingForm: TTalkingForm;
- RealICQClient: TRealICQClient;
- begin
- Result := nil;
- if ARealICQClient = nil then
- RealICQClient := MainForm.RealICQClient
- else
- RealICQClient := ARealICQClient;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- TalkingForm := TalkingForms[iLoop];
- if TalkingForm.FCategory <> tcNormal then
- Continue;
- if AnsiSameText(TalkingForm.Receiver, AReceiver) and (TalkingForm.FRealICQClient = RealICQClient) then
- begin
- Result := TalkingForm;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure ChangeTalkingFormVisible(AVisible: Boolean);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- AForm.Visible := AVisible;
- if AVisible then
- end;
- end;
- //------------------------------------------------------------------------------
- function OpenTalkingForm(AReceiver: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- var
- iLoop: Integer;
- AForm, TalkingForm: TTalkingForm;
- begin
- // if MainForm.RealICQClient.Friends.IndexOf(AReceiver)<0 then
- MainForm.RealICQClient.GetUserLoginState(AReceiver);
- AForm := nil;
- Result := nil;
- if OpenningTalkingForm then
- Exit;
- try
- OpenningTalkingForm := True;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if AForm.FCategory <> tcNormal then
- Continue;
- if AnsiSameText(AForm.Receiver, AReceiver) then
- begin
- if AShowActive then
- ForceForeGroundWindow(AForm.Handle);
- Result := AForm;
- Exit;
- end;
- end;
- TalkingForm := TTalkingForm.Create(MainForm);
- TalkingForm.FCategory := tcNormal;
- if ARealICQClient = nil then
- TalkingForm.FRealICQClient := MainForm.RealICQClient
- else
- TalkingForm.FRealICQClient := ARealICQClient;
- TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
- TalkingForm.Receiver := AReceiver;
- TalkingForm.UpdateMyInfo;
- TalkingForm.LoadWindowColor;
- TalkingForm.LoadBackGround;
- SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
- Result := TalkingForm;
- finally
- OpenningTalkingForm := False;
- end;
- MainForm.HideMainForm;
- end;
- //------------------------------------------------------------------------------
- function OpenTeamTalkingForm(ATeamID: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- var
- iLoop: Integer;
- AForm, TalkingForm: TTalkingForm;
- begin
- AForm := nil;
- Result := nil;
- if OpenningTalkingForm then
- Exit;
- try
- OpenningTalkingForm := True;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if AForm.FCategory <> tcTeam then
- Continue;
- if AForm.FTeamID = ATeamID then
- begin
- if AShowActive then
- ForceForeGroundWindow(AForm.Handle);
- Result := AForm;
- Exit;
- end;
- end;
- //Dialogs.ShowMessage('TTalkingForm.Create');
- TalkingForm := TTalkingForm.Create(MainForm);
- //Dialogs.ShowMessage('TTalkingForm.Created');
- TalkingForm.FCategory := tcTeam;
- if ARealICQClient = nil then
- TalkingForm.FRealICQClient := MainForm.RealICQClient
- else
- TalkingForm.FRealICQClient := ARealICQClient;
- TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
- TalkingForm.TeamID := ATeamID;
- TalkingForm.UpdateMyInfo;
- TalkingForm.LoadWindowColor;
- TalkingForm.LoadBackGround;
- SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
- Result := TalkingForm;
- finally
- OpenningTalkingForm := False;
- TTeamsAdapter.MessageMiscMust(ATeamID);
- end;
- MainForm.HideMainForm;
- end;
- //------------------------------------------------------------------------------
- function GetTeamTalkingForm(ATeamID: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
- var
- iLoop: Integer;
- TalkingForm: TTalkingForm;
- RealICQClient: TRealICQClient;
- begin
- Result := nil;
- if ARealICQClient = nil then
- RealICQClient := MainForm.RealICQClient
- else
- RealICQClient := ARealICQClient;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- TalkingForm := TalkingForms[iLoop];
- if TalkingForm.FCategory <> tcTeam then
- Continue;
- if (AnsiSameText(TalkingForm.FTeamID, ATeamID)) and (TalkingForm.FRealICQClient = RealICQClient) then
- begin
- Result := TalkingForm;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure UpdateTeamTalkingForm(ATeam: TRealICQTeam);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := TalkingForms.Count - 1 downto 0 do
- begin
- AForm := TalkingForms[iLoop];
- if AForm.FCategory <> tcTeam then
- Continue;
- if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
- FreeAndNil(AForm)
- else
- AForm.UpdateMyInfo;
- if (AForm.FTeamID = ATeam.TeamID) then
- begin
- AForm.SetTeamID(ATeam.TeamID);
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function InTalkingFormAdvertisement(AHandle: THandle): Boolean;
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- Result := False;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if IsChild(AForm.WebBrowserForAdvertisement.Handle, AHandle) then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function InTalkingFormTeamDisk(AHandle: THandle): Boolean;
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- Result := False;
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if IsChild(AForm.WebBrowserForTeamDisk.Handle, AHandle) then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure ChangeTalkingFormColor(AColor: TColor);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if not AForm.FUseSelfColor then
- AForm.ChangeUIColor(AColor);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure UpdateTalkingFormAdversement;
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- AForm.LoadAdvertisement;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure ChangeTalkingFormSkin(ASkinName: string);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- OldSkin: string;
- begin
- ASkinName := AnsiReplaceText(ASkinName, 'MainForm', '');
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- OldSkin := AForm.SkinName;
- try
- AForm.SkinName := ASkinName;
- except
- AForm.SkinName := OldSkin;
- end;
- if not AForm.FUseSelfColor then
- AForm.ChangeUIColor(MainForm.UIMainColor)
- else
- AForm.ChangeUIColor(AForm.FWindowColor);
- end;
- end;
- procedure TTalkingForm.SaveImageInfo(TempFaceFileName: string; iFlag: Integer);
- var
- tempImgInfo: PImageInfo;
- begin
- tempImgInfo := new(PImageInfo);
- tempImgInfo.Name := TempFaceFileName;
- tempImgInfo.iFlag := iFlag;
- ImagesList.Add(tempImgInfo);
- end;
- //------------
- function TTalkingForm.HasMobilePhone(LoginName: string): Boolean;
- var
- iIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- Result := False;
- iIndex := FLVTeamMembers.Items.IndexOf(LoginName);
- if iIndex > -1 then
- begin
- ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
- Result := ListItem.HasSMS;
- end;
- end;
- procedure TTalkingForm.spbUserInfoClick(Sender: TObject);
- begin
- miSeeYourDetailInformationClick(nil);
- end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.spbCopyScreenClick(Sender: TObject);
- var
- Point1, Point2: TPoint;
- begin
- point1 := Point(0, 0);
- point2 := Point(0, 0);
- Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
- GetCursorPos(point2);
- if (point2.X - point1.X) <= 17 then
- begin
- if MainForm.CopyScreenHideTalkForm then
- begin
- WindowState := wsMinimized;
- MainForm.Close;
- end;
- try
- ShowCopyScreenForm(Self);
- finally
- if MainForm.CopyScreenHideTalkForm then
- Self.WindowState := wsNormal;
- self.RichEdInputer.SetFocus;
- end;
- end
- else
- begin
- Point1.X := 0;
- Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
- ppForSnap.Popup(Point1.X, Point1.Y);
- end;
- end;
- procedure TTalkingForm.spbEncryMsgClick(Sender: TObject);
- begin
- spbEncryMsg.Tag := 0;
- spbEncryMsg.Visible := false;
- spbNormalMsg.Visible := true;
- end;
- procedure TTalkingForm.spbNormalMsgClick(Sender: TObject);
- begin
- spbEncryMsg.Tag := 1;
- spbEncryMsg.Visible := true;
- spbNormalMsg.Visible := false;
- end;
- //procedure TTalkingForm.chkEncryMessageClick(Sender: TObject);
- //begin
- // SpbEncryMessage.Enabled:= chkEncryMessage.Checked;
- //end;
- //------------------------------------------------------------------------------
- procedure TTalkingForm.actClearEditExecute(Sender: TObject);
- begin
- RichEdInputer.Clear;
- RichEditTemp.Clear;
- end;
- procedure TTalkingForm.actClearWebExecute(Sender: TObject);
- begin
- ClearHTML(self.WebBrowser);
- end;
- procedure TTalkingForm.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
- begin
- Accept := (NewSize >= 1) and ((self.ClientHeight - NewSize) >= 250);
- end;
- procedure TTalkingForm.spbSetClick(Sender: TObject);
- var
- Point1: TPoint;
- begin
- point1 := Point(0, 0);
- Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
- ppForSet.Popup(Point1.X, Point1.Y);
- end;
- initialization
- CoInitialize(nil);
- OleInitialize(nil);
- finalization
- try
- OleUninitialize;
- CoUninitialize;
- except
- end;
- end.
|