TalkingFrm.pas 256 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156
  1. unit TalkingFrm;
  2. interface
  3. uses
  4. IdBaseComponent, RealICQDBHistory, IdComponent, IdTCPConnection, IdTCPClient,
  5. IdHTTP, VideoTransmitter, MD5_32, AudioTransmitter, WinInet,
  6. PtoPFileTransmitter, PerlRegEx, TransmitDirection, FileTransmitterObjective,
  7. MD5, RealICQUtils, cvcode, ClipBrd, ShareUtils, DSUtil, DirectShow9,
  8. RealICQModel, MainFrm, GIFImage, pngimage, xFonts, MSHTML, DateUtils, Types,
  9. MyUtils, ShellAPI, RealICQSkinFrm, RealICQUIColor, RealICQColors,
  10. RealICQClient, RealICQContacterListView, Windows, Messages, SysUtils, Variants,
  11. Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ToolWin, ActnMan,
  12. ActnCtrls, ActnMenus, StdActns, ActnList, XPStyleActnCtrls, RealICQSpeedButton,
  13. ComCtrls, ImgList, StdCtrls, Buttons, RealICQButton, OleCtrls, SHDocVw,
  14. StdStyleActnCtrls, Menus, ActnPopup, RealICQRoundBorderPanel,
  15. RealICQNoBorderPageControl, jpeg, RealICQUserCard, RxRichEd, RealICQRichEdit,
  16. ExtDlgs, StrUtils, ActiveX, XMLDoc, XMLIntf, AppEvnts, RealICQTrackBar,
  17. RealICQMicrophoneVolumeControl, RealICQMasterVolumeControl,
  18. RealICQSingleImageButton, DSPack, ConfirmSendOfflineFileFrm,
  19. RealICQRemoteControlImage, ExtWebBrowser, lxkj_TLB, HTTPApp, UpLoadFileToWeb,
  20. WebBrowserWithUI, MyInputBoxFrm, BlockingTCPClient, FileTransferWithNode,
  21. TransmiteFileMission, UploadOrDownloadFileMission, VCardFrm;
  22. const
  23. TalkingTextColor: string = '#585858'; {对话窗口中系统信息字体颜色}
  24. MaxMessageLength: Integer = 3500; {消息的最大字符数}
  25. type
  26. PImageInfo = ^TImageInfo;
  27. TImageInfo = record
  28. Name: string;
  29. iFlag: Integer;
  30. end;
  31. TTalkingCategory = (tcNormal, tcTeam);
  32. TTalkingForm = class(TRealICQSkinForm)
  33. pnlClient: TPanel;
  34. ActionManager1: TActionManager;
  35. actSaveAsTextFile: TAction;
  36. EditCut: TEditCut;
  37. EditCopy: TEditCopy;
  38. EditPaste: TEditPaste;
  39. EditSelectAll: TEditSelectAll;
  40. EditUndo: TEditUndo;
  41. EditDelete: TEditDelete;
  42. actAlwayOnTop: TAction;
  43. pnlToolBar: TPanel;
  44. Shape1: TShape;
  45. ImgLstForActions: TImageList;
  46. pnlForActionToolBar: TPanel;
  47. actAddUser: TAction;
  48. actSendFile: TAction;
  49. actVideo: TAction;
  50. actAudio: TAction;
  51. ImgLstForShowHideUserPanel: TImageList;
  52. TimerForGetUserInformation: TTimer;
  53. ppMyOptions: TPopupActionBar;
  54. N2: TMenuItem;
  55. V1: TMenuItem;
  56. miShowMyHeadImage: TMenuItem;
  57. miShowMyCard: TMenuItem;
  58. ppYourOptions: TPopupActionBar;
  59. miShowYourHeadImage: TMenuItem;
  60. miShowYourCard: TMenuItem;
  61. miShowYourVideo: TMenuItem;
  62. miShowMyVideo: TMenuItem;
  63. N11: TMenuItem;
  64. miSeeYourDetailInformation: TMenuItem;
  65. FontDialog: TFontDialog;
  66. ppForWebBrowser: TPopupActionBar;
  67. miCopyFromIE: TMenuItem;
  68. miSelAllFromIE: TMenuItem;
  69. ppForInputer: TPopupActionBar;
  70. U1: TMenuItem;
  71. N14: TMenuItem;
  72. C1: TMenuItem;
  73. C2: TMenuItem;
  74. P1: TMenuItem;
  75. T1: TMenuItem;
  76. A1: TMenuItem;
  77. EditFontSet: TAction;
  78. OpenDialog: TOpenDialog;
  79. miSaveImageAs: TMenuItem;
  80. miAddImageToCustomFaces: TMenuItem;
  81. ApplicationEvents: TApplicationEvents;
  82. miSplitAtWebBrowser: TMenuItem;
  83. actPrint: TAction;
  84. actPageSet: TAction;
  85. actPreview: TAction;
  86. actClose: TAction;
  87. actSaveAsHTMLFile: TAction;
  88. actShowHistory: TAction;
  89. actEnter: TAction;
  90. actCtrlEnter: TAction;
  91. ClearInputtingMessageTimer: TTimer;
  92. ImgLstForAudio: TImageList;
  93. ppAudioSet: TPopupActionBar;
  94. miOpenSpeak: TMenuItem;
  95. miCloseSpeak: TMenuItem;
  96. miOpenMic: TMenuItem;
  97. MenuItem14: TMenuItem;
  98. miStopAudioTransmite: TMenuItem;
  99. miCloseMic: TMenuItem;
  100. miStopVideo: TMenuItem;
  101. actStopVideo: TAction;
  102. S1: TMenuItem;
  103. miMyVideoSize: TMenuItem;
  104. miMyVideoMiddleSize: TMenuItem;
  105. miMyVideoSmallSize: TMenuItem;
  106. miYourVideoSize: TMenuItem;
  107. miYourVideoSmallSize: TMenuItem;
  108. miYourVideoBigSize: TMenuItem;
  109. miMyVideoBigSize: TMenuItem;
  110. miYourVideoMiddleSize: TMenuItem;
  111. ReEnabledVideoActionTimer: TTimer;
  112. miSaveYourVideoImageAs: TMenuItem;
  113. miSaveMyVideoImageAs: TMenuItem;
  114. OpenPictureDialog: TOpenPictureDialog;
  115. miSeeTeamDetailInformation: TMenuItem;
  116. ppUserItemRightMenu: TPopupActionBar;
  117. miSendMessage: TMenuItem;
  118. miSeeUserInformation: TMenuItem;
  119. actSeeTeamOptions: TAction;
  120. actQuitTeam: TAction;
  121. actDisbandTeam: TAction;
  122. pnlAdvertisement: TPanel;
  123. pnlForWebBrowserAdvertisement: TPanel;
  124. WebBrowserForAdvertisement: TWebBrowser;
  125. pnlForHideWebBrowserAdvertisement: TPanel;
  126. ppColors: TPopupActionBar;
  127. MenuItem18: TMenuItem;
  128. miMoreColors: TMenuItem;
  129. miShowVideoForm: TMenuItem;
  130. imgToolbarBack: TImage;
  131. spbAddUser: TRealICQSpeedButton;
  132. spbSendFile: TRealICQSpeedButton;
  133. spbAudio: TRealICQSpeedButton;
  134. spbVideo: TRealICQSpeedButton;
  135. spbSeeTeamOptions: TRealICQSpeedButton;
  136. spbQuitTeam: TRealICQSpeedButton;
  137. spbDisbandTeam: TRealICQSpeedButton;
  138. miVideoSet: TMenuItem;
  139. spbUploadFile: TRealICQSpeedButton;
  140. spbRemoteControl: TRealICQSpeedButton;
  141. pnlRC: TPanel;
  142. pnlTalkingArea: TPanel;
  143. Splitter1: TSplitter;
  144. pnlDisplayer: TPanel;
  145. ShpDisplayerTopMiddle: TShape;
  146. ShpDisplayerClient: TShape;
  147. ImgDisplayerTopLeft: TImage;
  148. ImgDisplayerTopRight: TImage;
  149. lblDest: TLabel;
  150. pnlForWebBrowser: TPanel;
  151. pnlHint: TPanel;
  152. Image1: TImage;
  153. LblHint: TLabel;
  154. pnlUserInformation: TPanel;
  155. pnlMyInfo: TPanel;
  156. rndMyInfo: TRealICQRoundBorderPanel;
  157. SpbForMyInfo: TRealICQSpeedButton;
  158. spbMic: TRealICQSpeedButton;
  159. MicrophoneVolume: TRealICQMicrophoneVolumeControl;
  160. pnlTeamCallBoard: TPanel;
  161. rndTeamCallBoard: TRealICQRoundBorderPanel;
  162. Image2: TImage;
  163. lblTeamCallBoardTitle: TLabel;
  164. mmTeamCallBoard: TMemo;
  165. pnlRemoteControl: TPanel;
  166. rndRemoteControl: TRealICQRoundBorderPanel;
  167. btSetControl: TRealICQSpeedButton;
  168. btClose: TRealICQSpeedButton;
  169. btReleaseControl: TRealICQSpeedButton;
  170. lblRCState: TLabel;
  171. SplitterRC: TSplitter;
  172. ppForTeamMenu: TPopupActionBar;
  173. miTeamSendMessage: TMenuItem;
  174. miTeamSMS: TMenuItem;
  175. miTeamSeeUserInfo: TMenuItem;
  176. miTeamAddFriend: TMenuItem;
  177. miAddFriend: TMenuItem;
  178. miSendSms: TMenuItem;
  179. ppForInputerImg: TPopupActionBar;
  180. MenuItem3: TMenuItem;
  181. miCopyImage: TMenuItem;
  182. miPasteImg: TMenuItem;
  183. MenuItem6: TMenuItem;
  184. MenuItem7: TMenuItem;
  185. S2: TMenuItem;
  186. actSaveImgAs: TAction;
  187. actAddImageToCustomFaces: TAction;
  188. F2: TMenuItem;
  189. spbSendFolder: TRealICQSpeedButton;
  190. miSaveToWeb: TMenuItem;
  191. LblSendSMS: TLabel;
  192. LblSendSMS1: TLabel;
  193. PnlShowHideUserInfo: TPanel;
  194. ImgHideShowUserInformation: TImage;
  195. spbTeamNetWorkDisk: TRealICQSpeedButton;
  196. PnlTeamWebDisk: TPanel;
  197. pnlTeamMembers: TPanel;
  198. rndTeamMembers: TRealICQRoundBorderPanel;
  199. SpbForTeamMemberInfo: TRealICQSpeedButton;
  200. rndTeamMemberContainer: TRealICQRoundBorderPanel;
  201. pnlTeamMemberContainer: TPanel;
  202. FLVTeamMembers: TRealICQContacterListView;
  203. rndTeamWebDisk: TRealICQRoundBorderPanel;
  204. Panel2: TPanel;
  205. imgTeamWebDiskToolbarBack: TImage;
  206. lblTeamWebDiskHint: TLabel;
  207. spbCloseTeamWebDisk: TRealICQSpeedButton;
  208. Panel4: TPanel;
  209. WebBrowserForTeamDiskold: TWebBrowser;
  210. pnlForHideTeamDisk: TPanel;
  211. N3: TMenuItem;
  212. N4: TMenuItem;
  213. N5: TMenuItem;
  214. N6: TMenuItem;
  215. N7: TMenuItem;
  216. N8: TMenuItem;
  217. N9: TMenuItem;
  218. N10: TMenuItem;
  219. N17: TMenuItem;
  220. TimerForCheckPastedContent: TTimer;
  221. actCopyScreenHideForm: TAction;
  222. spbSendSMS: TRealICQSpeedButton;
  223. SaveDialog: TSaveDialog;
  224. miAddWorkOrder: TMenuItem;
  225. spbUploadTeamFile: TRealICQSpeedButton;
  226. spbUploadTeamFileProcess: TRealICQSpeedButton;
  227. WebBrowserForTeamDisk: TWebBrowserWithUI;
  228. UpdateAlias: TMenuItem;
  229. CaptureGraph: TFilterGraph;
  230. VideoSourceFilter: TFilter;
  231. spbPostSMS: TRealICQSpeedButton;
  232. pnlInputer: TPanel;
  233. ImgInputerTopLeft: TImage;
  234. ImgInputerTopRight: TImage;
  235. ImgInputerTopMiddle: TImage;
  236. ShpInputerClient: TShape;
  237. spbFont: TRealICQSpeedButton;
  238. spbFace: TRealICQSpeedButton;
  239. lblState: TLabel;
  240. spbSendImage: TRealICQSpeedButton;
  241. spbCopyScreen: TRealICQSpeedButton;
  242. spbSelUIColor: TRealICQSpeedButton;
  243. spbShakeWindow: TRealICQSpeedButton;
  244. spbBackground: TRealICQSpeedButton;
  245. spbHistroyMessage: TRealICQSpeedButton;
  246. pnlInputeBack: TPanel;
  247. Panel1: TPanel;
  248. RichEditTemp: TRealICQRichEdit;
  249. RichEdInputer: TRealICQRichEdit;
  250. Panel5: TPanel;
  251. Image3: TImage;
  252. btSend: TRealICQButton;
  253. btCloseTalk: TRealICQButton;
  254. spbUserInfo: TRealICQSpeedButton;
  255. lblTeamMemberCount: TLabel;
  256. actClearWeb: TAction;
  257. E1: TMenuItem;
  258. N12: TMenuItem;
  259. E2: TMenuItem;
  260. actClearEdit: TAction;
  261. btDownArrow: TRealICQButton;
  262. ppForSnap: TPopupActionBar;
  263. ppForDown: TPopupActionBar;
  264. H1: TMenuItem;
  265. N16: TMenuItem;
  266. Enter: TMenuItem;
  267. CtrlEnter: TMenuItem;
  268. ppForMsg: TPopupActionBar;
  269. H2: TMenuItem;
  270. MClearWindow: TMenuItem;
  271. spbNormalMsg: TRealICQSpeedButton;
  272. spbEncryMsg: TRealICQSpeedButton;
  273. Image4: TImage;
  274. pnlYourInfo: TPanel;
  275. rndYourInfo: TRealICQRoundBorderPanel;
  276. SpbForYourInfo: TRealICQSpeedButton;
  277. spbSpk: TRealICQSpeedButton;
  278. MasterVolume: TRealICQMasterVolumeControl;
  279. rndMy: TRealICQRoundBorderPanel;
  280. pgcMyInfo: TRealICQNoBorderPageControl;
  281. tsMyHeadImage: TTabSheet;
  282. ImgHeadForMyInfo: TImage;
  283. tsMyCard: TTabSheet;
  284. cardMine: TRealICQUserCard;
  285. tsMyVideo: TTabSheet;
  286. ImgMyVideo: TImage;
  287. lblMyInfo: TLabel;
  288. N18: TMenuItem;
  289. ShpHeadBackForMyInfo: TShape;
  290. lblYourInfo: TLabel;
  291. rndYour: TRealICQRoundBorderPanel;
  292. pgcYourInfo: TRealICQNoBorderPageControl;
  293. tsYourHeadImage: TTabSheet;
  294. ShpHeadBackForYourInfo: TShape;
  295. ImgHeadForYourInfo: TImage;
  296. tsYourCard: TTabSheet;
  297. cardYour: TRealICQUserCard;
  298. tsYourVideo: TTabSheet;
  299. ImgYourVideo: TImage;
  300. N1: TMenuItem;
  301. HTML1: TMenuItem;
  302. N19: TMenuItem;
  303. N20: TMenuItem;
  304. V2: TMenuItem;
  305. U2: TMenuItem;
  306. pnlForHideWebBrowser: TPanel;
  307. WebBrowser: TWebBrowser;
  308. spbSet: TRealICQSpeedButton;
  309. ppForSet: TPopupActionBar;
  310. O1: TMenuItem;
  311. N13: TMenuItem;
  312. I1: TMenuItem;
  313. W1: TMenuItem;
  314. spbAbout: TRealICQSpeedButton;
  315. O2: TMenuItem;
  316. btnQR: TRealICQSpeedButton;
  317. //ImgMyVideoBorder: TImage;
  318. procedure spbHistroyMessageClick(Sender: TObject);
  319. procedure UpdateAliasClick(Sender: TObject);
  320. procedure spbUploadTeamFileClick(Sender: TObject);
  321. procedure miAddWorkOrderClick(Sender: TObject);
  322. procedure spbSendSMSClick(Sender: TObject);
  323. procedure sbpSMSClick(Sender: TObject);
  324. procedure actCopyScreenHideFormExecute(Sender: TObject);
  325. procedure ppForWebBrowserPopup(Sender: TObject);
  326. procedure ppForInputerImgPopup(Sender: TObject);
  327. procedure TimerForCheckPastedContentTimer(Sender: TObject);
  328. procedure RichEdInputerInsertObject(Sender: TObject);
  329. procedure RichEdInputerDropFiles(Sender: TObject; AFiles: TStringList);
  330. procedure WebBrowserForTeamDiskoldBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  331. procedure WebBrowserForTeamDiskoldDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  332. procedure RichEdInputerSelectionChange(Sender: TObject);
  333. procedure EditPasteUpdate(Sender: TObject);
  334. procedure EditPasteExecute(Sender: TObject);
  335. procedure spbCloseTeamWebDiskClick(Sender: TObject);
  336. procedure spbTeamNetWorkDiskClick(Sender: TObject);
  337. procedure FormResize(Sender: TObject);
  338. procedure ImgHideShowUserInformationClick(Sender: TObject);
  339. procedure ImgHideShowUserInformationMouseLeave(Sender: TObject);
  340. procedure ImgHideShowUserInformationMouseEnter(Sender: TObject);
  341. procedure LblSendSMSClick(Sender: TObject);
  342. procedure LblSendSMSMouseLeave(Sender: TObject);
  343. procedure LblSendSMSMouseEnter(Sender: TObject);
  344. procedure miSaveToWebClick(Sender: TObject);
  345. procedure spbSendFolderClick(Sender: TObject);
  346. procedure miPasteImgClick(Sender: TObject);
  347. procedure actAddImageToCustomFacesExecute(Sender: TObject);
  348. procedure actSaveImgAsExecute(Sender: TObject);
  349. procedure ppForInputerImgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  350. procedure miCopyImageClick(Sender: TObject);
  351. procedure miTeamAddFriendClick(Sender: TObject);
  352. procedure miAddFriendClick(Sender: TObject);
  353. procedure miTeamSeeUserInfoClick(Sender: TObject);
  354. procedure ppForTeamMenuPopup(Sender: TObject);
  355. procedure miSendSmsClick(Sender: TObject);
  356. procedure miTeamSMSClick(Sender: TObject);
  357. procedure miTeamSendMessageClick(Sender: TObject);
  358. procedure ppForTeamMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  359. procedure btCloseClick(Sender: TObject);
  360. procedure btReleaseControlClick(Sender: TObject);
  361. procedure btSetControlClick(Sender: TObject);
  362. procedure spbRemoteControlClick(Sender: TObject);
  363. procedure spbUploadFileClick(Sender: TObject);
  364. procedure miMoreColorsClick(Sender: TObject);
  365. procedure ppColorsPopup(Sender: TObject);
  366. procedure ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  367. procedure actShowHistoryExecute(Sender: TObject);
  368. procedure WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  369. procedure WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  370. procedure actAddUserExecute(Sender: TObject);
  371. procedure actDisbandTeamExecute(Sender: TObject);
  372. procedure actQuitTeamExecute(Sender: TObject);
  373. procedure actSeeTeamOptionsExecute(Sender: TObject);
  374. procedure miSeeUserInformationClick(Sender: TObject);
  375. procedure miSendMessageClick(Sender: TObject);
  376. procedure ppUserItemRightMenuPopup(Sender: TObject);
  377. procedure ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  378. procedure miSeeTeamDetailInformationClick(Sender: TObject);
  379. procedure spbCopyScreenClick(Sender: TObject);
  380. procedure miSaveYourVideoImageAsClick(Sender: TObject);
  381. procedure miSaveMyVideoImageAsClick(Sender: TObject);
  382. procedure ReEnabledVideoActionTimerTimer(Sender: TObject);
  383. procedure miMyVideoSmallSizeClick(Sender: TObject);
  384. procedure miYourVideoSmallSizeClick(Sender: TObject);
  385. procedure actStopVideoExecute(Sender: TObject);
  386. procedure actVideoExecute(Sender: TObject);
  387. procedure miStopAudioTransmiteClick(Sender: TObject);
  388. procedure miOpenMicClick(Sender: TObject);
  389. procedure miCloseMicClick(Sender: TObject);
  390. procedure miOpenSpeakClick(Sender: TObject);
  391. procedure miCloseSpeakClick(Sender: TObject);
  392. procedure spbMicClick(Sender: TObject);
  393. procedure spbSpkClick(Sender: TObject);
  394. procedure ppAudioSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  395. procedure actAudioExecute(Sender: TObject);
  396. procedure FormShow(Sender: TObject);
  397. procedure ClearInputtingMessageTimerTimer(Sender: TObject);
  398. procedure actCtrlEnterExecute(Sender: TObject);
  399. procedure actEnterExecute(Sender: TObject);
  400. procedure actAlwayOnTopExecute(Sender: TObject);
  401. procedure actEmptyWebExecute(Sender: TObject);
  402. procedure spbSendImageClick(Sender: TObject);
  403. procedure actSaveAsHTMLFileExecute(Sender: TObject);
  404. procedure actPreviewExecute(Sender: TObject);
  405. procedure actPrintExecute(Sender: TObject);
  406. procedure actPageSetExecute(Sender: TObject);
  407. procedure actSaveAsTextFileExecute(Sender: TObject);
  408. procedure actCloseExecute(Sender: TObject);
  409. procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
  410. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  411. procedure actSendFileExecute(Sender: TObject);
  412. procedure EditFontSetExecute(Sender: TObject);
  413. procedure RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  414. procedure ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  415. procedure miSelAllFromIEClick(Sender: TObject);
  416. procedure miCopyFromIEClick(Sender: TObject);
  417. procedure ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  418. procedure WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  419. procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  420. procedure spbFaceClick(Sender: TObject);
  421. procedure spbFontClick(Sender: TObject);
  422. procedure RichEdInputerChange(Sender: TObject);
  423. procedure btSendClick(Sender: TObject);
  424. procedure lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  425. procedure lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  426. procedure lblDestClick(Sender: TObject);
  427. procedure lblDestMouseLeave(Sender: TObject);
  428. procedure lblDestMouseEnter(Sender: TObject);
  429. procedure miSeeYourDetailInformationClick(Sender: TObject);
  430. procedure rndMyInfoResize(Sender: TObject);
  431. procedure tsMyVideoShow(Sender: TObject);
  432. procedure miShowMyVideoClick(Sender: TObject);
  433. procedure tsYourVideoShow(Sender: TObject);
  434. procedure miShowYourVideoClick(Sender: TObject);
  435. procedure tsMyCardShow(Sender: TObject);
  436. procedure tsMyHeadImageShow(Sender: TObject);
  437. procedure miShowMyCardClick(Sender: TObject);
  438. procedure miShowMyHeadImageClick(Sender: TObject);
  439. procedure tsYourCardShow(Sender: TObject);
  440. procedure tsYourHeadImageShow(Sender: TObject);
  441. procedure miShowYourCardClick(Sender: TObject);
  442. procedure miShowYourHeadImageClick(Sender: TObject);
  443. procedure SpbForYourInfoClick(Sender: TObject);
  444. procedure ppYourOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  445. procedure ppMyOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  446. procedure SpbForMyInfoClick(Sender: TObject);
  447. procedure pnlDisplayerResize(Sender: TObject);
  448. procedure TimerForGetUserInformationTimer(Sender: TObject);
  449. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  450. //procedure spbShowHideUserInformationClick(Sender: TObject);
  451. procedure spbSelUIColorClick(Sender: TObject);
  452. procedure FormDestroy(Sender: TObject);
  453. procedure FormCreate(Sender: TObject);
  454. procedure spbShakeWindowClick(Sender: TObject);
  455. procedure spbBackgroundClick(Sender: TObject);
  456. procedure miShowVideoFormClick(Sender: TObject);
  457. procedure ApplicationEventsException(Sender: TObject; E: Exception);
  458. procedure miVideoSetClick(Sender: TObject);
  459. //procedure pnlTeamCallBoardClick(Sender: TObject);
  460. procedure WebBrowserForTeamDiskBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  461. //procedure spbCopyScreen2Click(Sender: TObject);
  462. procedure spbUserInfoClick(Sender: TObject);
  463. //procedure chkEncryMessageClick(Sender: TObject);
  464. procedure actClearWebExecute(Sender: TObject);
  465. procedure actClearEditExecute(Sender: TObject);
  466. procedure btDownArrowClick(Sender: TObject);
  467. procedure ppForSnapGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  468. procedure ppForDownGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  469. procedure ppForMsgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  470. procedure ppForSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  471. procedure MClearWindowClick(Sender: TObject);
  472. procedure spbEncryMsgClick(Sender: TObject);
  473. procedure spbNormalMsgClick(Sender: TObject);
  474. procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
  475. procedure spbSetClick(Sender: TObject);
  476. procedure spbAboutClick(Sender: TObject);
  477. procedure btnQRClick(Sender: TObject);
  478. procedure pnlTalkingAreaClick(Sender: TObject);
  479. procedure cardYourResize(Sender: TObject);
  480. procedure btCloseTalkClick(Sender: TObject);
  481. //procedure tsMyVideoContextPopup(Sender: TObject; MousePos: TPoint;
  482. // var Handled: Boolean);
  483. private
  484. FVCardFrom: TVCardForm;
  485. FTcpClient: TBlockingTCPClient;
  486. FCategory: TTalkingCategory;
  487. FRightMouseClickedFace: TFaceInRichEdit;
  488. FTeamID: string;
  489. FTeamUpLoadFile: TUpLoadFile;
  490. //显示群组成员列表的ListView
  491. FFileTransmitters: TStringList;
  492. FOldWidth, FOldHeight, FOldWidthOfUserInfo, FMinWidthOfYourPanel, FMinWidthOfMyPanel: Integer;
  493. FSender, FReceiver: string;
  494. FFaceMenuAtFileName: string; //在自定义表情上弹出右键菜单时所指的图片文件的名称
  495. FSetFaceMenuAtFileNameTicket: Cardinal;
  496. FLastSendInputtingMessageTicket: Cardinal;
  497. FAudioMission: TAudioMission;
  498. FVideoMission: TVideoMission;
  499. FRemoteControlMission: TRemoteControlMission;
  500. FWindowColor: TColor;
  501. FUseSelfColor: Boolean;
  502. FBackGroundImage: string;
  503. FOfflinefilesAddr: string;
  504. FOfflinefilesPort: Integer;
  505. FPackageSize: Integer;
  506. FTransmiteFileMissions: TList;
  507. FUpDownFileMissions: TList;
  508. FNodeTransferMissions: TList;
  509. FSettedYourVideImageSize, FSettedMyVideImageSize: Boolean;
  510. FLastSendShakeWindowTicket: Cardinal;
  511. FLastRecvShakeWindowTicket: Cardinal;
  512. FLastSendMsgTicket: Cardinal;
  513. FRidrected: Boolean;
  514. FRidrectURL: string;
  515. FImageSize: Integer;
  516. FBaseURL: string;
  517. FMaxID: Integer;
  518. procedure LoadOfflinefilesConfig;
  519. procedure LoadWindowColor;
  520. procedure SaveWindowColor;
  521. procedure miColorClick(Sender: TObject);
  522. procedure LoadBackGround;
  523. procedure SaveBackGround;
  524. procedure IdHTTPOnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
  525. procedure IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
  526. procedure IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
  527. procedure IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  528. function GetHTMLUBBCode(AHTML: string; var ABaseURL: string): string;
  529. function ReAlighHTMLContent(ABaseURL: string): Boolean;
  530. function CheckImageExists(AImageFile: string): string;
  531. function FindIECacheImage(ADir, AImageFile: string): string;
  532. procedure CheckPastedContent(ADeleteOtherObj: Boolean = False);
  533. procedure AddImageToInput(AFileName: string; ARichEd: TRealICQRichEdit);
  534. procedure ChangePopupActionBarColor(PopupActionBar: TPopupActionBar);
  535. function CheckNotCompletedMission: Integer;
  536. procedure LoadNotReadMessages;
  537. procedure UpdateMyInfo;
  538. procedure UpdateTeamMembers;
  539. procedure SetTeamID(Value: string);
  540. procedure SetReceiver(Value: string);
  541. procedure ShowSpbShowHideUserInformationState;
  542. function GetInputerLength: Integer;
  543. procedure InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
  544. procedure SetDOMStyle(Doc: IHTMLDocument2);
  545. procedure LoadAdvertisement;
  546. procedure P2PTypeChanged(Sender: TObject);
  547. function GetCanWriteMessage: Boolean;
  548. procedure CancelAllSendFile;
  549. procedure CloseAllMissions;
  550. procedure CancelAllUpDdownFile;
  551. procedure CancelAllUpDdownNodeFile;
  552. procedure CalculatedWaveInVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
  553. procedure CalculatedWaveOutVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
  554. procedure CapturedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
  555. procedure ReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
  556. procedure CreateTeamResult(Sender: TObject; ATeamCaption: string; ACreated: Boolean; ATeamID: string; AFailingCause: string);
  557. procedure AddMessageToWebBrowser(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
  558. procedure ShakeWindow;
  559. procedure SetLblSendSMSPosition(HIntMsg: string);
  560. procedure AddMessageToWebBrowserTop(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
  561. protected
  562. procedure CMWininichange(var Message: TWMWinIniChange); message CM_WININICHANGE;
  563. procedure CreateParams(var Params: TCreateParams); override;
  564. procedure DropFiles(var Message: TMessage); message WM_DropFiles;
  565. procedure OnKeyDown(var Msg: TMessage); message WM_KEYDOWN;
  566. procedure OnKeyUp(var Msg: TMessage); message WM_KEYUP;
  567. public
  568. FRealICQClient: TRealICQClient;
  569. procedure LoadHistoryMessages;
  570. procedure UpdateTeamMember(ARealICQUser: TRealICQUser);
  571. function PasteImage(AUseTemp: Boolean = True): Boolean;
  572. procedure LoadNotReadMessagesFromDBHistory(DBHistorySearchResult: TDBHistorySearchResult);
  573. procedure OpenSendFolderForm(FolderName: string);
  574. procedure SendFile(FileName: string);
  575. procedure ChangeUIColor(AColor: TColor); override;
  576. procedure InsertFaceToRichEdit(Face: TFace; FaceID: Integer);
  577. procedure ShowMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean = False);
  578. procedure ShowTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean = False);
  579. procedure SendDropFile(AFileName: string);
  580. procedure ShowGettedSendFileRequest(ASendFileRequestInfo: TSendFileRequestInfo);
  581. procedure ShowCancelSendFile(AOppositeID: Cardinal);
  582. procedure ShowSendOfflineFileRequest(AOppositeID: Cardinal);
  583. procedure ShowSendedSendFileRequest(APtoPFileTransmitter: TPtoPFileTransmitter);
  584. procedure ShowGettedAudioTransmiteRequest;
  585. procedure ShowSendedAudioTransmiteRequest;
  586. procedure ShowCanceledAudioTransmite;
  587. procedure ShowGettedAudioTransmiteResponse(AAcceptted: Boolean);
  588. procedure ShowStoppedAudioTransmite(AIsStopper: Boolean);
  589. procedure ShowGettedAudioTransmiteConnectted;
  590. procedure ShowGettedRemoteControlTransmiteRequest;
  591. procedure ShowSendedRemoteControlTransmiteRequest;
  592. procedure ShowCanceledRemoteControlTransmite;
  593. procedure ShowGettedRemoteControlTransmiteResponse(AAcceptted: Boolean);
  594. procedure ShowStoppedRemoteControlTransmite(AIsStopper: Boolean);
  595. procedure ShowGettedRemoteControlTransmiteConnectted;
  596. procedure ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight: Integer);
  597. procedure ShowGettedRemoteControlTransmiteControlRequest;
  598. procedure ShowSendedRemoteControlTransmiteControlRequest;
  599. procedure ShowCancelControlRemoteControlTransmite;
  600. procedure ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted: Boolean);
  601. procedure ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted: Boolean);
  602. procedure FullScreenRemoteControlPanel;
  603. procedure CloseRemoteControlPanel;
  604. procedure OpenRemoteControlPanel;
  605. procedure ShowGettedVideoTransmiteRequest;
  606. procedure ShowSendedVideoTransmiteRequest;
  607. procedure ShowCanceledVideoTransmite;
  608. procedure ShowGettedVideoTransmiteResponse(AAcceptted: Boolean);
  609. procedure ShowStoppedVideoTransmite(AIsStopper: Boolean);
  610. procedure ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp: Boolean);
  611. procedure ShowInputting(AInputting: Boolean);
  612. procedure ShowShakeWindow(AIsSource: Boolean);
  613. //TODO: 发送离线文件
  614. procedure SendOfflineFile(AFileName: string);
  615. //保存用户剪切屏幕的图片
  616. procedure SaveImageInfo(TempFaceFileName: string; iFlag: Integer);
  617. procedure SetBrowserBg(BackImage: string);
  618. function FindTransmitFileByBaseID(ABaseID: string): TTransmiteFileMission;
  619. function FindFileTransmitByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
  620. function FindUpDownFileByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
  621. function FindUpNodeFileByBaseID(ABaseID: string): TFileTransferWithNode;
  622. property TransmiteFileMissions: TList read FTransmiteFileMissions;
  623. property UpDownFileMissions: TList read FUpDownFileMissions;
  624. property FileTransmitters: TStringList read FFileTransmitters;
  625. property NodeTransferMissions: TList read FNodeTransferMissions;
  626. property SettedYourVideImageSize: Boolean read FSettedYourVideImageSize write FSettedYourVideImageSize;
  627. property SettedMyVideImageSize: Boolean read FSettedMyVideImageSize write FSettedMyVideImageSize;
  628. property AudioMission: TAudioMission read FAudioMission write FAudioMission;
  629. property VideoMission: TVideoMission read FVideoMission write FVideoMission;
  630. property RemoteControlMission: TRemoteControlMission read FRemoteControlMission write FRemoteControlMission;
  631. property FaceMenuAtFileName: string read FFaceMenuAtFileName write FFaceMenuAtFileName;
  632. property SetFaceMenuAtFileNameTicket: Cardinal read FSetFaceMenuAtFileNameTicket write FSetFaceMenuAtFileNameTicket;
  633. property Category: TTalkingCategory read FCategory;
  634. property TeamID: string read FTeamID write SetTeamID;
  635. property Receiver: string read FReceiver write SetReceiver;
  636. property CanWriteMessage: Boolean read GetCanWriteMessage;
  637. property WindowColor: TColor read FWindowColor;
  638. property LastRecvShakeWindowTicket: Cardinal read FLastRecvShakeWindowTicket write FLastRecvShakeWindowTicket;
  639. property OfflinefilesAddr: string read FOfflinefilesAddr write FOfflinefilesAddr;
  640. property OfflinefilesPort: Integer read FOfflinefilesPort write FOfflinefilesPort;
  641. property PackageSize: Integer read FPackageSize write FPackageSize;
  642. property TeamUpLoadFile: TUpLoadFile read FTeamUpLoadFile;
  643. public
  644. ImagesList: TList;
  645. ALoginName: string;
  646. function HasMobilePhone(LoginName: string): Boolean;
  647. procedure DownFileComplete(ASource, ADest, ARemark: string; AStatus: boolean; AFileSize: Integer; IsNeedNotify: Boolean);
  648. procedure TeamUpFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: string);
  649. property LVTeamMembers: TRealICQContacterListView read FLVTeamMembers;
  650. end;
  651. function GetTalkingFormCount: Integer;
  652. procedure CloseAllTalkingForm;
  653. procedure SetAllTakingFormEnabledState(AEnableValue: Boolean);
  654. procedure UpdateAllTakingFormGIFHeadImage;
  655. procedure UpdateAllTakingFormHotKeySet;
  656. procedure ChangeTalkingFormVisible(AVisible: Boolean);
  657. function OpenTalkingForm(AReceiver: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  658. function GetTalkingForm(AReceiver: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  659. procedure UpdateTalkingForm(ARealICQUser: TRealICQUser);
  660. function OpenTeamTalkingForm(ATeamID: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  661. function GetTeamTalkingForm(ATeamID: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  662. procedure UpdateTeamTalkingForm(ATeam: TRealICQTeam);
  663. function InTalkingFormAdvertisement(AHandle: THandle): Boolean;
  664. function InTalkingFormTeamDisk(AHandle: THandle): Boolean;
  665. procedure ChangeTalkingFormColor(AColor: TColor);
  666. procedure ChangeTalkingFormSkin(ASkinName: string);
  667. procedure UpdateTalkingFormAdversement;
  668. procedure ShowCopyScreenForm(ATalkingForm: TTalkingForm);
  669. function FindURLCache(pstrDatfile: PAnsiChar; pstrURL: PAnsiChar): PAnsiChar; stdcall external 'binary/DATReader.dll';
  670. implementation
  671. uses
  672. UserCardDetailView, SMSFrm, AddFriendFrm, SelFaceFrm, AddFaceFrm,
  673. CopyScreenFrm, TrueHiddenMainFrm, TeamOptionsFrm, AddUserFrm,
  674. MessagesManagerFrm, SelBackFrm, UserCardFrm, VideoFrm, RemoteControlFrm,
  675. SendFolderFrm, NotReadMessageBoxFrm, TeamsAdapter, LoggerImport,
  676. TeamShareAdapter, LimitCondition, AsynActions, FileTransmitAdapter,
  677. TalkFormController, UsersService, GroupConfig, ConditionConfig, UploaderTask,
  678. MessagesHander, RealICQUtility;
  679. {$R *.dfm}
  680. {$R TalkImg.RES}
  681. {TTalkingForm}
  682. procedure TTalkingForm.LoadBackGround;
  683. var
  684. XMLFile: string;
  685. XMLDocument: TXMLDocument;
  686. BackGroundImagesNode: IXMLNode;
  687. NodeName: string;
  688. begin
  689. XMLFile := TRealICQClient.GetUserDir + BackGroundImagesXMLFile;
  690. XMLDocument := TXMLDocument.Create(Self);
  691. try
  692. XMLDocument.Active := True;
  693. if not FileExists(XMLFile) then
  694. begin
  695. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + BackGroundImagesXMLFile), PChar(XMLFile), False);
  696. XMLDocument.Active := True;
  697. end;
  698. XMLDocument.LoadFromFile(XMLFile);
  699. BackGroundImagesNode := XMLDocument.DocumentElement;
  700. if FCategory = tcNormal then
  701. NodeName := 'U' + FReceiver
  702. else
  703. NodeName := 'T' + FTeamID;
  704. try
  705. if BackGroundImagesNode.ChildNodes.FindNode(NodeName) <> nil then
  706. begin
  707. FBackGroundImage := BackGroundImagesNode.ChildNodes.FindNode(NodeName).Attributes['BackGroundImage'];
  708. if not FileExists(FBackGroundImage) then
  709. FBackGroundImage := '';
  710. try
  711. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  712. except
  713. end;
  714. end;
  715. except
  716. end;
  717. finally
  718. XMLDocument.Free;
  719. end;
  720. end;
  721. //------------------------------------------------------------------------------
  722. procedure TTalkingForm.SaveBackGround;
  723. var
  724. XMLFile: string;
  725. XMLDocument: TXMLDocument;
  726. BackGroundImagesNode: IXMLNode;
  727. NodeName: string;
  728. begin
  729. XMLFile := TRealICQClient.GetUserDir + BackGroundImagesXMLFile;
  730. XMLDocument := TXMLDocument.Create(Self);
  731. try
  732. XMLDocument.Active := True;
  733. if not FileExists(XMLFile) then
  734. begin
  735. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + BackGroundImagesXMLFile), PChar(XMLFile), False);
  736. XMLDocument.Active := True;
  737. end;
  738. XMLDocument.LoadFromFile(XMLFile);
  739. BackGroundImagesNode := XMLDocument.DocumentElement;
  740. if FCategory = tcNormal then
  741. NodeName := 'U' + FReceiver
  742. else
  743. NodeName := 'T' + FTeamID;
  744. try
  745. BackGroundImagesNode.ChildNodes.FindNode(NodeName).Attributes['BackGroundImage'] := FBackGroundImage;
  746. except
  747. BackGroundImagesNode.AddChild(NodeName).Attributes['BackGroundImage'] := FBackGroundImage;
  748. end;
  749. XMLDocument.SaveToFile();
  750. finally
  751. XMLDocument.Free;
  752. end;
  753. end;
  754. //------------------------------------------------------------------------------
  755. procedure TTalkingForm.LoadWindowColor;
  756. var
  757. XMLFile: string;
  758. XMLDocument: TXMLDocument;
  759. WindowColorsNode: IXMLNode;
  760. NodeName: string;
  761. begin
  762. XMLFile := TRealICQClient.GetUserDir + WindowColorsXMLFile;
  763. XMLDocument := TXMLDocument.Create(Self);
  764. try
  765. XMLDocument.Active := True;
  766. if not FileExists(XMLFile) then
  767. begin
  768. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + WindowColorsXMLFile), PChar(XMLFile), False);
  769. XMLDocument.Active := True;
  770. end;
  771. XMLDocument.LoadFromFile(XMLFile);
  772. WindowColorsNode := XMLDocument.DocumentElement;
  773. if FCategory = tcNormal then
  774. NodeName := 'U' + FReceiver
  775. else
  776. NodeName := 'T' + FTeamID;
  777. FWindowColor := MainForm.UIMainColor;
  778. FUseSelfColor := False;
  779. try
  780. if WindowColorsNode.ChildNodes.FindNode(NodeName) <> nil then
  781. begin
  782. FWindowColor := WindowColorsNode.ChildNodes.FindNode(NodeName).Attributes['WindowColor'];
  783. if FWindowColor <> MainForm.UIMainColor then
  784. FUseSelfColor := True;
  785. end;
  786. except
  787. end;
  788. ChangeUIColor(FWindowColor);
  789. finally
  790. XMLDocument.Free;
  791. end;
  792. end;
  793. //------------------------------------------------------------------------------
  794. procedure TTalkingForm.AddImageToInput(AFileName: string; ARichEd: TRealICQRichEdit);
  795. var
  796. gifImage: TGifImage;
  797. newBitmap: TBitmap;
  798. newJpg: TJPegImage;
  799. TempFaceFileName: string;
  800. Face: TFace;
  801. MD5HashValue: MD5Digest;
  802. MD5HashString: string;
  803. AOldFileName: string;
  804. iLoop: Integer;
  805. Sys32Dir: string;
  806. pSys32Dir: array[0..Max_Path] of char;
  807. begin
  808. try
  809. //判断是否为系统表情
  810. for iLoop := 0 to MainForm.FaceList.Count - 1 do
  811. begin
  812. Face := MainForm.FaceList.Objects[iLoop] as TFace;
  813. if AnsiSameText(ReplaceStr(Face.FileName, '/', '\'), ReplaceStr(AFileName, '/', '\')) then
  814. begin
  815. ARichEd.InsertImage(Face.FileName, iLoop);
  816. Exit;
  817. end;
  818. end;
  819. newJpg := TJPegImage.Create;
  820. newBitmap := Tbitmap.create;
  821. gifImage := TGifImage.Create;
  822. try
  823. if AnsiSameText(ExtractFileExt(AFileName), '.BMP') then
  824. begin
  825. newBitmap.LoadFromFile(AFileName);
  826. newJpg.Assign(newBitmap);
  827. newJpg.CompressionQuality := 90;
  828. newJpg.Compress;
  829. end
  830. else if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
  831. begin
  832. gifImage.LoadFromFile(AFileName);
  833. end
  834. else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
  835. begin
  836. end
  837. else
  838. begin
  839. newJpg.LoadFromFile(AFileName);
  840. end;
  841. if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
  842. begin
  843. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.GIF';
  844. gifImage.SaveToFile(AFileName);
  845. end
  846. else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
  847. begin
  848. AOldFileName := AFileName;
  849. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.PNG';
  850. CopyFile(PChar(AOldFileName), PChar(AFileName), False);
  851. end
  852. else
  853. begin
  854. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.JPG';
  855. newJpg.SaveToFile(AFileName);
  856. end;
  857. MD5HashValue := MD5File(AFileName);
  858. MD5HashString := MD5.MD5Print(MD5HashValue);
  859. if AnsiSameText(ExtractFileExt(AFileName), '.GIF') then
  860. TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.GIF'
  861. else if AnsiSameText(ExtractFileExt(AFileName), '.PNG') then
  862. TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.PNG'
  863. else
  864. TempFaceFileName := ExtractFilePath(AFileName) + MD5HashString + '.JPG';
  865. RenameFile(AFileName, TempFaceFileName);
  866. Face := TFace.Create(TempFaceFileName, '', '', MD5HashString, '');
  867. try
  868. ARichEd.InsertImage(TempFaceFileName, BaseTempFaceIndex + MainForm.TempFaceList.AddObject(MD5HashString, Face));
  869. except
  870. on e: exception do
  871. begin
  872. Log(E.Message, 'ARichEd.InsertImage');
  873. GetSystemDirectory(pSys32Dir, Max_Path);
  874. Sys32Dir := StrPas(pSys32Dir);
  875. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ImageX2_DLL_PACH), PChar(Sys32Dir + '\ImageX2.dll'), False);
  876. try
  877. WinExec(PChar('regsvr32 /s "' + 'ImageX2.dll"'), SW_HIDE);
  878. except
  879. end;
  880. Sleep(500);
  881. ARichEd.InsertImage(TempFaceFileName, BaseTempFaceIndex + MainForm.TempFaceList.AddObject(MD5HashString, Face));
  882. end;
  883. end;
  884. finally
  885. gifImage.Free;
  886. newbitmap.free;
  887. newjpg.Free;
  888. end;
  889. except
  890. on E: Exception do
  891. begin
  892. Log(E.Message, 'TTalkingForm.AddImageToInput');
  893. raise;
  894. end;
  895. //
  896. end;
  897. end;
  898. //------------------------------------------------------------------
  899. procedure TTalkingForm.MClearWindowClick(Sender: TObject);
  900. begin
  901. actClearWeb.Execute;
  902. actClearEdit.Execute;
  903. end;
  904. //------------------------------------------------------------------------------
  905. procedure TTalkingForm.SaveWindowColor;
  906. var
  907. XMLFile: string;
  908. XMLDocument: TXMLDocument;
  909. WindowColorsNode: IXMLNode;
  910. NodeName: string;
  911. begin
  912. XMLFile := TRealICQClient.GetUserDir + WindowColorsXMLFile;
  913. XMLDocument := TXMLDocument.Create(Self);
  914. try
  915. XMLDocument.Active := True;
  916. if not FileExists(XMLFile) then
  917. begin
  918. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + WindowColorsXMLFile), PChar(XMLFile), False);
  919. XMLDocument.Active := True;
  920. end;
  921. XMLDocument.LoadFromFile(XMLFile);
  922. WindowColorsNode := XMLDocument.DocumentElement;
  923. if FCategory = tcNormal then
  924. NodeName := 'U' + FReceiver
  925. else
  926. NodeName := 'T' + FTeamID;
  927. try
  928. WindowColorsNode.ChildNodes.FindNode(NodeName).Attributes['WindowColor'] := FWindowColor;
  929. except
  930. WindowColorsNode.AddChild(NodeName).Attributes['WindowColor'] := FWindowColor;
  931. end;
  932. XMLDocument.SaveToFile();
  933. FUseSelfColor := (FWindowColor <> MainForm.UIMainColor);
  934. finally
  935. XMLDocument.Free;
  936. end;
  937. end;
  938. procedure TTalkingForm.sbpSMSClick(Sender: TObject);
  939. begin
  940. if (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) or (not MainForm.RealICQClient.UserPermission.EnableSendSms) then
  941. begin
  942. Dialogs.ShowMessage('您没有手机短信群发权限! ');
  943. Exit;
  944. end;
  945. OpenTeamSMSForm(self.TeamID);
  946. end;
  947. //------------------------------------------------------------------------------
  948. procedure TTalkingForm.miColorClick(Sender: TObject);
  949. begin
  950. ChangeUIColor((Sender as TMenuItem).Tag);
  951. FWindowColor := (Sender as TMenuItem).Tag;
  952. SaveWindowColor;
  953. end;
  954. //------------------------------------------------------------------------------
  955. procedure TTalkingForm.miMoreColorsClick(Sender: TObject);
  956. begin
  957. MainForm.ColorDialog.Color := FWindowColor;
  958. if MainForm.ColorDialog.Execute then
  959. begin
  960. ChangeUIColor(MainForm.ColorDialog.Color);
  961. FWindowColor := MainForm.ColorDialog.Color;
  962. SaveWindowColor;
  963. end;
  964. end;
  965. //------------------------------------------------------------------------------
  966. procedure TTalkingForm.CapturedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
  967. begin
  968. try
  969. if not FSettedMyVideImageSize then
  970. begin
  971. miShowMyVideo.Click;
  972. //ImgMyVideoBorder.Refresh;
  973. Application.ProcessMessages;
  974. if ABitmap.Width >= 320 then
  975. miMyVideoBigSize.Click
  976. else
  977. miMyVideoSmallSize.Click;
  978. FSettedMyVideImageSize := True;
  979. end;
  980. ImgMyVideo.Picture.Bitmap.Assign(ABitmap);
  981. except
  982. end;
  983. end;
  984. procedure TTalkingForm.cardYourResize(Sender: TObject);
  985. begin
  986. end;
  987. //------------------------------------------------------------------------------
  988. procedure TTalkingForm.ReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
  989. begin
  990. try
  991. if not FSettedYourVideImageSize then
  992. begin
  993. miShowYourVideo.Visible := True;
  994. miYourVideoSize.Visible := True;
  995. miSaveYourVideoImageAs.Visible := True;
  996. miShowVideoForm.Visible := True;
  997. miShowYourVideo.Click;
  998. Application.ProcessMessages;
  999. if ABitmap.Width >= 320 then
  1000. miYourVideoBigSize.Click
  1001. else
  1002. miYourVideoSmallSize.Click;
  1003. FSettedYourVideImageSize := True;
  1004. end;
  1005. if VideoForm <> nil then
  1006. VideoForm.ImgYourVideo.Picture.Bitmap.Assign(ABitmap)
  1007. else
  1008. ImgYourVideo.Picture.Bitmap.Assign(ABitmap);
  1009. except
  1010. end;
  1011. end;
  1012. //------------------------------------------------------------------------------
  1013. procedure TTalkingForm.ReEnabledVideoActionTimerTimer(Sender: TObject);
  1014. begin
  1015. ReEnabledVideoActionTimer.Enabled := False;
  1016. actVideo.Enabled := True;
  1017. end;
  1018. //------------------------------------------------------------------------------
  1019. procedure TTalkingForm.ShowGettedVideoTransmiteRequest;
  1020. begin
  1021. try
  1022. if FVideoMission <> nil then
  1023. begin
  1024. if FVideoMission.FIsSource then
  1025. begin
  1026. if FVideoMission.FAccepted then
  1027. FVideoMission.ShowStopped(True)
  1028. else
  1029. FVideoMission.ShowCancel;
  1030. end
  1031. else
  1032. begin
  1033. if FVideoMission.FAccepted then
  1034. FVideoMission.ShowStopped(True)
  1035. else
  1036. FVideoMission.ShowDeclined;
  1037. end;
  1038. FreeAndNil(FVideoMission);
  1039. end;
  1040. finally
  1041. FVideoMission := TVideoMission.Create(Self, False);
  1042. end;
  1043. end;
  1044. //------------------------------------------------------------------------------
  1045. procedure TTalkingForm.ShowSendedVideoTransmiteRequest;
  1046. begin
  1047. try
  1048. FreeAndNil(FVideoMission);
  1049. finally
  1050. FVideoMission := TVideoMission.Create(Self, True);
  1051. end;
  1052. end;
  1053. //------------------------------------------------------------------------------
  1054. procedure TTalkingForm.ShowCanceledVideoTransmite;
  1055. begin
  1056. try
  1057. if FVideoMission <> nil then
  1058. FVideoMission.ShowCancel;
  1059. finally
  1060. FreeAndNil(FVideoMission);
  1061. end;
  1062. end;
  1063. //------------------------------------------------------------------------------
  1064. procedure TTalkingForm.ShowStoppedVideoTransmite(AIsStopper: Boolean);
  1065. var
  1066. NeedEnabledVideoAction: Boolean;
  1067. begin
  1068. NeedEnabledVideoAction := False;
  1069. if actVideo.Enabled then
  1070. begin
  1071. NeedEnabledVideoAction := True;
  1072. actVideo.Enabled := False;
  1073. end;
  1074. try
  1075. try
  1076. if FVideoMission <> nil then
  1077. FVideoMission.ShowStopped(AIsStopper);
  1078. finally
  1079. FreeAndNil(FVideoMission);
  1080. actStopVideo.Visible := False;
  1081. miShowYourVideo.Visible := False;
  1082. miYourVideoSize.Visible := False;
  1083. miSaveYourVideoImageAs.Visible := False;
  1084. miShowVideoForm.Visible := False;
  1085. if pgcYourInfo.ActivePage = tsYourVideo then
  1086. miShowYourHeadImage.Click;
  1087. miShowMyVideo.Visible := False;
  1088. miMyVideoSize.Visible := False;
  1089. miVideoSet.Visible := False;
  1090. miSaveMyVideoImageAs.Visible := False;
  1091. if pgcMyInfo.ActivePage = tsMyVideo then
  1092. miShowMyHeadImage.Click;
  1093. FreeAndNil(VideoForm);
  1094. end;
  1095. finally
  1096. if NeedEnabledVideoAction then
  1097. ReEnabledVideoActionTimer.Enabled := True;
  1098. end;
  1099. end;
  1100. //------------------------------------------------------------------------------
  1101. procedure TTalkingForm.ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp: Boolean);
  1102. begin
  1103. try
  1104. if FVideoMission <> nil then
  1105. begin
  1106. FVideoMission.ShowConnectted(ASendBigBmp, ARecvBigBmp);
  1107. end;
  1108. except
  1109. end;
  1110. end;
  1111. //------------------------------------------------------------------------------
  1112. procedure TTalkingForm.ShowGettedVideoTransmiteResponse(AAcceptted: Boolean);
  1113. begin
  1114. try
  1115. if FVideoMission <> nil then
  1116. begin
  1117. if AAcceptted then
  1118. begin
  1119. FVideoMission.ShowAcceptted;
  1120. TVideoTransmitter.SetVideoCapContainer(Self);
  1121. FRealICQClient.OnCapturedVideoImage := nil;
  1122. FRealICQClient.OnReceivedVideoImage := nil;
  1123. FRealICQClient.OnCapturedVideoImage := CapturedVideoImage;
  1124. FRealICQClient.OnReceivedVideoImage := ReceivedVideoImage;
  1125. actStopVideo.Visible := True;
  1126. try
  1127. ImgYourVideo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + WorldCamPicture);
  1128. except
  1129. end;
  1130. if FRealICQClient.InstalledCamera then
  1131. begin
  1132. try
  1133. ImgMyVideo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + WorldCamPicture);
  1134. except
  1135. end;
  1136. miShowMyVideo.Visible := True;
  1137. miMyVideoSize.Visible := True;
  1138. miVideoSet.Visible := True;
  1139. miSaveMyVideoImageAs.Visible := True;
  1140. miShowMyVideo.Click;
  1141. end;
  1142. end
  1143. else
  1144. FVideoMission.ShowDeclined;
  1145. end;
  1146. finally
  1147. if not AAcceptted then
  1148. FreeAndNil(FVideoMission);
  1149. end;
  1150. end;
  1151. //------------------------------------------------------------------------------
  1152. procedure TTalkingForm.ShowGettedAudioTransmiteRequest;
  1153. begin
  1154. try
  1155. if FAudioMission <> nil then
  1156. begin
  1157. if FAudioMission.FIsSource then
  1158. begin
  1159. if FAudioMission.FAccepted then
  1160. FAudioMission.ShowStopped(True)
  1161. else
  1162. FAudioMission.ShowCancel;
  1163. end
  1164. else
  1165. begin
  1166. if FAudioMission.FAccepted then
  1167. FAudioMission.ShowStopped(True)
  1168. else
  1169. FAudioMission.ShowDeclined;
  1170. end;
  1171. FreeAndNil(FAudioMission);
  1172. end;
  1173. finally
  1174. FAudioMission := TAudioMission.Create(Self, False);
  1175. end;
  1176. end;
  1177. //------------------------------------------------------------------------------
  1178. procedure TTalkingForm.ShowSendedAudioTransmiteRequest;
  1179. begin
  1180. try
  1181. FreeAndNil(FAudioMission);
  1182. finally
  1183. FAudioMission := TAudioMission.Create(Self, True);
  1184. end;
  1185. end;
  1186. //------------------------------------------------------------------------------
  1187. procedure TTalkingForm.ShowCanceledAudioTransmite;
  1188. begin
  1189. try
  1190. if FAudioMission <> nil then
  1191. FAudioMission.ShowCancel;
  1192. finally
  1193. FreeAndNil(FAudioMission);
  1194. end;
  1195. end;
  1196. //------------------------------------------------------------------------------
  1197. procedure TTalkingForm.ShowStoppedAudioTransmite(AIsStopper: Boolean);
  1198. begin
  1199. try
  1200. if FAudioMission <> nil then
  1201. FAudioMission.ShowStopped(AIsStopper);
  1202. spbSpk.Visible := False;
  1203. spbMic.Visible := False;
  1204. MasterVolume.Visible := False;
  1205. MicrophoneVolume.Visible := False;
  1206. finally
  1207. FreeAndNil(FAudioMission);
  1208. end;
  1209. end;
  1210. procedure TTalkingForm.CalculatedWaveInVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
  1211. begin
  1212. try
  1213. MicrophoneVolume.PeakValue := AVolume;
  1214. except
  1215. end;
  1216. end;
  1217. //------------------------------------------------------------------------------
  1218. procedure TTalkingForm.CalculatedWaveOutVolume(Sender: TObject; ALoginName: string; AVolume: Integer);
  1219. begin
  1220. try
  1221. MasterVolume.PeakValue := AVolume;
  1222. except
  1223. end;
  1224. end;
  1225. //------------------------------------------------------------------------------
  1226. procedure TTalkingForm.ShowGettedRemoteControlTransmiteRequest;
  1227. begin
  1228. try
  1229. if FRemoteControlMission <> nil then
  1230. begin
  1231. if FRemoteControlMission.FIsSource then
  1232. begin
  1233. if FRemoteControlMission.FAccepted then
  1234. FRemoteControlMission.ShowStopped(True)
  1235. else
  1236. FRemoteControlMission.ShowCancel;
  1237. end
  1238. else
  1239. begin
  1240. if FRemoteControlMission.FAccepted then
  1241. FRemoteControlMission.ShowStopped(True)
  1242. else
  1243. FRemoteControlMission.ShowDeclined;
  1244. end;
  1245. FreeAndNil(FRemoteControlMission);
  1246. end;
  1247. finally
  1248. FRemoteControlMission := TRemoteControlMission.Create(Self, False);
  1249. end;
  1250. end;
  1251. //------------------------------------------------------------------------------
  1252. procedure TTalkingForm.ShowSendedRemoteControlTransmiteRequest;
  1253. begin
  1254. try
  1255. FreeAndNil(FRemoteControlMission);
  1256. finally
  1257. FRemoteControlMission := TRemoteControlMission.Create(Self, True);
  1258. end;
  1259. end;
  1260. //------------------------------------------------------------------------------
  1261. procedure TTalkingForm.ShowCanceledRemoteControlTransmite;
  1262. begin
  1263. try
  1264. if FRemoteControlMission <> nil then
  1265. FRemoteControlMission.ShowCancel;
  1266. finally
  1267. FreeAndNil(FRemoteControlMission);
  1268. end;
  1269. end;
  1270. //------------------------------------------------------------------------------
  1271. procedure TTalkingForm.ShowStoppedRemoteControlTransmite(AIsStopper: Boolean);
  1272. begin
  1273. try
  1274. if FRemoteControlMission <> nil then
  1275. FRemoteControlMission.ShowStopped(AIsStopper);
  1276. finally
  1277. pnlRemoteControl.Visible := False;
  1278. // pnlMyInfo.Visible := True;
  1279. pnlYourInfo.Visible := True;
  1280. pnlShowHideUserInfo.Visible := True;
  1281. pnlShowHideUserInfo.Width := 10;
  1282. if (not FRemoteControlMission.FIsSource) and (RemoteControlForm <> nil) then
  1283. begin
  1284. LockWindowUpdate(GetDesktopWindow);
  1285. try
  1286. OpenRemoteControlPanel;
  1287. RemoteControlForm.FTalkingForm := nil;
  1288. try
  1289. RemoteControlForm.Close;
  1290. finally
  1291. FreeAndNil(RemoteControlForm);
  1292. end;
  1293. pnlRC.Visible := False;
  1294. SplitterRC.Visible := False;
  1295. pnlUserInformation.Visible := True;
  1296. Width := FOldWidth;
  1297. Height := FOldHeight;
  1298. finally
  1299. LockWindowUpdate(0);
  1300. end;
  1301. end;
  1302. FreeAndNil(FRemoteControlMission);
  1303. end;
  1304. end;
  1305. //------------------------------------------------------------------------------
  1306. procedure TTalkingForm.FullScreenRemoteControlPanel;
  1307. begin
  1308. if RemoteControlForm = nil then
  1309. Exit;
  1310. LockWindowUpdate(GetDesktopWindow);
  1311. try
  1312. RemoteControlForm.Parent := nil;
  1313. RemoteControlForm.BorderStyle := bsNone;
  1314. RemoteControlForm.Align := alNone;
  1315. RemoteControlForm.btUP.Caption := '浮动停靠';
  1316. RemoteControlForm.pnlScreen.Visible := True;
  1317. RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := 0;
  1318. RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := 0;
  1319. RemoteControlForm.pnlClient.Constraints.MaxWidth := 0;
  1320. RemoteControlForm.pnlClient.Constraints.MaxHeight := 0;
  1321. RemoteControlForm.Constraints.MaxWidth := 0;
  1322. RemoteControlForm.Constraints.MaxHeight := 0;
  1323. RemoteControlForm.Left := -3;
  1324. RemoteControlForm.Top := -(3 + RemoteControlForm.pnlTop.Height);
  1325. RemoteControlForm.Width := Screen.Width + 6;
  1326. RemoteControlForm.Height := Screen.Height + 6 + RemoteControlForm.pnlTop.Height + RemoteControlForm.pnlBottom.Height;
  1327. pnlRC.Visible := False;
  1328. SplitterRC.Visible := False;
  1329. pnlUserInformation.Visible := True;
  1330. Width := FOldWidth;
  1331. Height := FOldHeight;
  1332. finally
  1333. LockWindowUpdate(0);
  1334. end;
  1335. end;
  1336. //------------------------------------------------------------------------------
  1337. procedure TTalkingForm.CloseRemoteControlPanel;
  1338. begin
  1339. if RemoteControlForm = nil then
  1340. Exit;
  1341. LockWindowUpdate(GetDesktopWindow);
  1342. try
  1343. RemoteControlForm.Parent := nil;
  1344. RemoteControlForm.BorderStyle := bsSizeable;
  1345. RemoteControlForm.Align := alNone;
  1346. RemoteControlForm.btUP.Caption := '浮动停靠';
  1347. RemoteControlForm.pnlScreen.Visible := False;
  1348. RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := RemoteControlForm.imgRCScreen.Width + 4;
  1349. RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := RemoteControlForm.imgRCScreen.Height + 4;
  1350. RemoteControlForm.pnlClient.Constraints.MaxWidth := RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth;
  1351. RemoteControlForm.pnlClient.Constraints.MaxHeight := RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight + RemoteControlForm.pnlTop.Height + RemoteControlForm.pnlBottom.Height;
  1352. RemoteControlForm.Constraints.MaxWidth := RemoteControlForm.pnlClient.Constraints.MaxWidth + (RemoteControlForm.Width - RemoteControlForm.pnlClient.Width);
  1353. RemoteControlForm.Constraints.MaxHeight := RemoteControlForm.pnlClient.Constraints.MaxHeight + (RemoteControlForm.Height - RemoteControlForm.pnlClient.Height);
  1354. if RemoteControlForm.Constraints.MaxWidth < Screen.WorkAreaWidth then
  1355. RemoteControlForm.Width := RemoteControlForm.Constraints.MaxWidth
  1356. else
  1357. RemoteControlForm.Width := Round(Screen.WorkAreaWidth * 0.8);
  1358. if RemoteControlForm.Constraints.MaxHeight < Screen.WorkAreaHeight then
  1359. RemoteControlForm.Height := RemoteControlForm.Constraints.MaxHeight
  1360. else
  1361. RemoteControlForm.Height := Round(Screen.WorkAreaHeight * 0.8);
  1362. RemoteControlForm.Left := (Screen.WorkAreaWidth - RemoteControlForm.Width) div 2;
  1363. RemoteControlForm.Top := (Screen.WorkAreaHeight - RemoteControlForm.Height) div 2;
  1364. pnlRC.Visible := False;
  1365. SplitterRC.Visible := False;
  1366. pnlUserInformation.Visible := True;
  1367. Width := FOldWidth;
  1368. Height := FOldHeight;
  1369. finally
  1370. LockWindowUpdate(0);
  1371. end;
  1372. end;
  1373. //------------------------------------------------------------------------------
  1374. procedure TTalkingForm.OpenRemoteControlPanel;
  1375. begin
  1376. if RemoteControlForm = nil then
  1377. Exit;
  1378. LockWindowUpdate(GetDesktopWindow);
  1379. try
  1380. Left := 0;
  1381. Top := 0;
  1382. Width := Screen.Width;
  1383. Height := Screen.WorkAreaHeight;
  1384. pnlRC.Visible := True;
  1385. SplitterRC.Visible := True;
  1386. RemoteControlForm.pnlRCWorkArea.Constraints.MaxWidth := 0;
  1387. RemoteControlForm.pnlRCWorkArea.Constraints.MaxHeight := 0;
  1388. RemoteControlForm.pnlClient.Constraints.MaxWidth := 0;
  1389. RemoteControlForm.pnlClient.Constraints.MaxHeight := 0;
  1390. RemoteControlForm.Constraints.MaxWidth := 0;
  1391. RemoteControlForm.Constraints.MaxHeight := 0;
  1392. RemoteControlForm.Parent := pnlRC;
  1393. RemoteControlForm.BorderStyle := bsNone;
  1394. RemoteControlForm.ParentWindow := pnlRC.Handle;
  1395. RemoteControlForm.Align := alClient;
  1396. RemoteControlForm.WindowState := wsMaximized;
  1397. RemoteControlForm.btUP.Caption := '浮动窗口';
  1398. RemoteControlForm.pnlScreen.Visible := False;
  1399. //if Width - 258 - 50 < RemoteControlForm.imgRCScreen.Width + 20 then
  1400. // pnlRC.Width := Width - 258 - 50
  1401. //else
  1402. // pnlRC.Width := RemoteControlForm.imgRCScreen.Width + 10;
  1403. SplitterRC.Left := pnlRC.Left - 5;
  1404. pnlUserInformation.Visible := False;
  1405. PostMessage(RemoteControlForm.Handle, WM_SIZE, 0, 0);
  1406. finally
  1407. LockWindowUpdate(0);
  1408. end;
  1409. end;
  1410. //------------------------------------------------------------------------------
  1411. procedure TTalkingForm.ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight: Integer);
  1412. begin
  1413. try
  1414. if FRemoteControlMission <> nil then
  1415. begin
  1416. FRemoteControlMission.RecvedScreenSize;
  1417. if (not FRemoteControlMission.FIsSource) then
  1418. begin
  1419. LockWindowUpdate(GetDesktopWindow);
  1420. try
  1421. if RemoteControlForm = nil then
  1422. begin
  1423. FOldWidth := Width;
  1424. FOldHeight := Height;
  1425. Left := 0;
  1426. Top := 0;
  1427. Width := Screen.Width;
  1428. Height := Screen.WorkAreaHeight;
  1429. pnlRC.Visible := True;
  1430. SplitterRC.Visible := True;
  1431. RemoteControlForm := TRemoteControlForm.Create(pnlRC);
  1432. RemoteControlForm.FTalkingForm := Self;
  1433. RemoteControlForm.Parent := pnlRC;
  1434. RemoteControlForm.ParentWindow := pnlRC.Handle;
  1435. RemoteControlForm.Align := alClient;
  1436. RemoteControlForm.WindowState := wsMaximized;
  1437. RemoteControlForm.ChangeUIColor(FormColor);
  1438. RemoteControlForm.imgRCScreen.Picture.Bitmap.SetSize(AWidth, AHeight);
  1439. RemoteControlForm.imgRCScreen.Width := AWidth;
  1440. RemoteControlForm.imgRCScreen.Height := AHeight;
  1441. RemoteControlForm.imgRCScreen.Cursor := crDefault;
  1442. RemoteControlForm.lblRCState.Caption := '控制中。';
  1443. RemoteControlForm.lblRCState2.Caption := '控制中。';
  1444. RemoteControlForm.Show;
  1445. if Width - 258 - 50 < RemoteControlForm.imgRCScreen.Width + 20 then
  1446. pnlRC.Width := Width - 258 - 50
  1447. else
  1448. pnlRC.Width := RemoteControlForm.imgRCScreen.Width + 10;
  1449. SplitterRC.Left := pnlRC.Left - 5;
  1450. pnlUserInformation.Visible := False;
  1451. end
  1452. else
  1453. begin
  1454. RemoteControlForm.imgRCScreen.Picture.Bitmap.SetSize(AWidth, AHeight);
  1455. RemoteControlForm.imgRCScreen.Width := AWidth;
  1456. RemoteControlForm.imgRCScreen.Height := AHeight;
  1457. end;
  1458. PostMessage(RemoteControlForm.Handle, WM_SIZE, 0, 0);
  1459. finally
  1460. LockWindowUpdate(0);
  1461. end;
  1462. end;
  1463. end;
  1464. except
  1465. end;
  1466. end;
  1467. //------------------------------------------------------------------------------
  1468. procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted: Boolean);
  1469. begin
  1470. try
  1471. if FRemoteControlMission <> nil then
  1472. begin
  1473. FRemoteControlMission.ShowBeControlResponse(AAcceptted);
  1474. if not FRemoteControlMission.FIsSource then
  1475. begin
  1476. if RemoteControlForm <> nil then
  1477. begin
  1478. if AAcceptted then
  1479. begin
  1480. RemoteControlForm.imgRCScreen.Cursor := crDefault;
  1481. RemoteControlForm.lblRCState.Caption := '控制中。';
  1482. RemoteControlForm.lblRCState2.Caption := '控制中。';
  1483. end
  1484. else
  1485. begin
  1486. RemoteControlForm.imgRCScreen.Cursor := crNo;
  1487. RemoteControlForm.lblRCState.Caption := '未被控制。';
  1488. RemoteControlForm.lblRCState2.Caption := '未被控制。';
  1489. end;
  1490. end;
  1491. end
  1492. else
  1493. begin
  1494. if AAcceptted then
  1495. lblRCState.Caption := '控制中。'
  1496. else
  1497. lblRCState.Caption := '未被控制。';
  1498. end;
  1499. end;
  1500. except
  1501. end;
  1502. end;
  1503. //------------------------------------------------------------------------------
  1504. procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted: Boolean);
  1505. begin
  1506. try
  1507. if FRemoteControlMission <> nil then
  1508. begin
  1509. FRemoteControlMission.ShowControlResponse(AAcceptted);
  1510. end;
  1511. except
  1512. end;
  1513. end;
  1514. //------------------------------------------------------------------------------
  1515. procedure TTalkingForm.ShowGettedRemoteControlTransmiteControlRequest;
  1516. begin
  1517. try
  1518. if FRemoteControlMission <> nil then
  1519. begin
  1520. FRemoteControlMission.AccepteControl;
  1521. end;
  1522. except
  1523. end;
  1524. end;
  1525. //------------------------------------------------------------------------------
  1526. procedure TTalkingForm.ShowSendedRemoteControlTransmiteControlRequest;
  1527. begin
  1528. try
  1529. if FRemoteControlMission <> nil then
  1530. begin
  1531. FRemoteControlMission.ShowControlRequest;
  1532. end;
  1533. except
  1534. end;
  1535. end;
  1536. //------------------------------------------------------------------------------
  1537. procedure TTalkingForm.ShowCancelControlRemoteControlTransmite;
  1538. begin
  1539. try
  1540. if FRemoteControlMission <> nil then
  1541. begin
  1542. FRemoteControlMission.ShowCancelControl;
  1543. if RemoteControlForm <> nil then
  1544. begin
  1545. RemoteControlForm.imgRCScreen.Cursor := crNo;
  1546. RemoteControlForm.lblRCState.Caption := '未被控制。';
  1547. RemoteControlForm.lblRCState2.Caption := '未被控制。';
  1548. end;
  1549. lblRCState.Caption := '未被控制。';
  1550. end;
  1551. except
  1552. end;
  1553. end;
  1554. //------------------------------------------------------------------------------
  1555. procedure TTalkingForm.ShowGettedRemoteControlTransmiteConnectted;
  1556. begin
  1557. try
  1558. if FRemoteControlMission <> nil then
  1559. begin
  1560. FRemoteControlMission.AccepteSend;
  1561. end;
  1562. except
  1563. end;
  1564. end;
  1565. //------------------------------------------------------------------------------
  1566. procedure TTalkingForm.ShowGettedRemoteControlTransmiteResponse(AAcceptted: Boolean);
  1567. begin
  1568. try
  1569. if FRemoteControlMission <> nil then
  1570. begin
  1571. if AAcceptted then
  1572. begin
  1573. FRemoteControlMission.ShowAcceptted;
  1574. end
  1575. else
  1576. FRemoteControlMission.ShowDeclined;
  1577. end;
  1578. finally
  1579. if not AAcceptted then
  1580. FreeAndNil(FRemoteControlMission);
  1581. end;
  1582. end;
  1583. //------------------------------------------------------------------------------
  1584. procedure TTalkingForm.ShowGettedAudioTransmiteConnectted;
  1585. begin
  1586. try
  1587. if FAudioMission <> nil then
  1588. begin
  1589. FAudioMission.ShowConnectted;
  1590. spbSpk.Visible := True;
  1591. spbMic.Visible := True;
  1592. MasterVolume.Visible := True;
  1593. MicrophoneVolume.Visible := True;
  1594. FRealICQClient.OnCalculatedWaveInVolume := CalculatedWaveInVolume;
  1595. FRealICQClient.OnCalculatedWaveOutVolume := CalculatedWaveOutVolume;
  1596. end;
  1597. except
  1598. end;
  1599. end;
  1600. //------------------------------------------------------------------------------
  1601. procedure TTalkingForm.ShowGettedAudioTransmiteResponse(AAcceptted: Boolean);
  1602. begin
  1603. try
  1604. if FAudioMission <> nil then
  1605. begin
  1606. if AAcceptted then
  1607. begin
  1608. FAudioMission.ShowAcceptted;
  1609. FRealICQClient.OnCalculatedWaveInVolume := nil;
  1610. FRealICQClient.OnCalculatedWaveOutVolume := nil;
  1611. end
  1612. else
  1613. FAudioMission.ShowDeclined;
  1614. end;
  1615. finally
  1616. if not AAcceptted then
  1617. FreeAndNil(FAudioMission);
  1618. end;
  1619. end;
  1620. //------------------------------------------------------------------------------
  1621. function TTalkingForm.FindUpDownFileByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
  1622. var
  1623. iLoop: Integer;
  1624. AUpDownFileMissions: TUploadOrDownloadFileMission;
  1625. begin
  1626. Result := nil;
  1627. for iLoop := 0 to FUpDownFileMissions.Count - 1 do
  1628. begin
  1629. AUpDownFileMissions := TUploadOrDownloadFileMission(FUpDownFileMissions[iLoop]);
  1630. if AnsiSameStr(AUpDownFileMissions.BaseID, ABaseID) then
  1631. begin
  1632. Result := AUpDownFileMissions;
  1633. Exit;
  1634. end;
  1635. end;
  1636. end;
  1637. function TTalkingForm.FindUpNodeFileByBaseID(ABaseID: string): TFileTransferWithNode;
  1638. var
  1639. iLoop: Integer;
  1640. AUpDownFileMissions: TFileTransferWithNode;
  1641. begin
  1642. Result := nil;
  1643. for iLoop := 0 to FNodeTransferMissions.Count - 1 do
  1644. begin
  1645. AUpDownFileMissions := TFileTransferWithNode(FNodeTransferMissions[iLoop]);
  1646. if AnsiSameStr(AUpDownFileMissions.BaseID, ABaseID) then
  1647. begin
  1648. Result := AUpDownFileMissions;
  1649. Exit;
  1650. end;
  1651. end;
  1652. end;
  1653. //------------------------------------------------------------------------------
  1654. function TTalkingForm.FindTransmitFileByBaseID(ABaseID: string): TTransmiteFileMission;
  1655. var
  1656. iLoop: Integer;
  1657. ATransmiteFileMission: TTransmiteFileMission;
  1658. begin
  1659. Result := nil;
  1660. for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
  1661. begin
  1662. ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
  1663. if AnsiSameStr(ATransmiteFileMission.BaseID, ABaseID) then
  1664. begin
  1665. Result := ATransmiteFileMission;
  1666. Exit;
  1667. end;
  1668. end;
  1669. end;
  1670. //------------------------------------------------------------------------------
  1671. function TTalkingForm.FindFileTransmitByBaseID(ABaseID: string): TUploadOrDownloadFileMission;
  1672. var
  1673. iLoop: Integer;
  1674. AUploadOrDownloadFileMission: TUploadOrDownloadFileMission;
  1675. begin
  1676. Result := nil;
  1677. for iLoop := 0 to FFileTransmitters.Count - 1 do
  1678. begin
  1679. AUploadOrDownloadFileMission := FFileTransmitters.Objects[iLoop] as TUploadOrDownloadFileMission;
  1680. if AnsiSameStr(AUploadOrDownloadFileMission.BaseID, ABaseID) then
  1681. begin
  1682. Result := AUploadOrDownloadFileMission;
  1683. Exit;
  1684. end;
  1685. end;
  1686. end;
  1687. //------------------------------------------------------------------------------
  1688. procedure TTalkingForm.ShowGettedSendFileRequest(ASendFileRequestInfo: TSendFileRequestInfo);
  1689. var
  1690. ATransmiteFileMission, ATransmiteFileMissionTemp: TTransmiteFileMission;
  1691. iLoop, ReceivingFaceCount: Integer;
  1692. FileExt: string;
  1693. begin
  1694. ATransmiteFileMission := TTransmiteFileMission.Create(Self, tdReceiver, ASendFileRequestInfo.FileName, ASendFileRequestInfo.MD5Code, ASendFileRequestInfo.FileLength, ASendFileRequestInfo.Objective, ASendFileRequestInfo.FileExtImage);
  1695. ATransmiteFileMission.FOppositeID := ASendFileRequestInfo.OppositeID;
  1696. if ASendFileRequestInfo.Objective = foFace then
  1697. begin
  1698. ReceivingFaceCount := 0;
  1699. for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
  1700. begin
  1701. ATransmiteFileMissionTemp := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
  1702. if ATransmiteFileMissionTemp = ATransmiteFileMission then
  1703. continue;
  1704. if ATransmiteFileMissionTemp.FObjective = foFile then
  1705. continue;
  1706. if (ATransmiteFileMissionTemp.FDirection = tdReceiver) and (ATransmiteFileMissionTemp.FAccepted = True) then
  1707. begin
  1708. Inc(ReceivingFaceCount);
  1709. if ReceivingFaceCount >= 1 then
  1710. Exit; //同时只允许传送1个表情
  1711. end;
  1712. end;
  1713. ATransmiteFileMission.Accept(TRealICQClient.GetReceivedFaceDir + ASendFileRequestInfo.FileName);
  1714. end
  1715. else
  1716. begin
  1717. FileExt := ExtractFileExt(ASendFileRequestInfo.FileName);
  1718. if (MainForm.RecvFileSafeLevel = fsHigh) or ((MainForm.RecvFileSafeLevel = fsMiddle) and (AnsiSameText(FileExt, '.EXE') or AnsiSameText(FileExt, '.COM'))) then
  1719. begin
  1720. ATransmiteFileMission.Decline;
  1721. FreeAndNil(ATransmiteFileMission);
  1722. end;
  1723. end;
  1724. end;
  1725. //------------------------------------------------------------------------------
  1726. procedure TTalkingForm.ShowSendOfflineFileRequest(AOppositeID: Cardinal);
  1727. var
  1728. iLoop: Integer;
  1729. ATransmiteFileMission: TTransmiteFileMission;
  1730. begin
  1731. for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
  1732. begin
  1733. ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
  1734. if ATransmiteFileMission.FOppositeID = AOppositeID then
  1735. begin
  1736. ATransmiteFileMission.GettedSendOfflineFileRequest;
  1737. FreeAndNil(ATransmiteFileMission);
  1738. Exit;
  1739. end;
  1740. end;
  1741. end;
  1742. //------------------------------------------------------------------------------
  1743. procedure TTalkingForm.ShowCancelSendFile(AOppositeID: Cardinal);
  1744. var
  1745. iLoop: Integer;
  1746. ATransmiteFileMission: TTransmiteFileMission;
  1747. begin
  1748. for iLoop := 0 to FTransmiteFileMissions.Count - 1 do
  1749. begin
  1750. ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
  1751. if ATransmiteFileMission.FOppositeID = AOppositeID then
  1752. begin
  1753. ATransmiteFileMission.Cancel;
  1754. FreeAndNil(ATransmiteFileMission);
  1755. Exit;
  1756. end;
  1757. end;
  1758. end;
  1759. //------------------------------------------------------------------------------
  1760. procedure TTalkingForm.CancelAllSendFile;
  1761. var
  1762. iLoop: Integer;
  1763. ATransmiteFileMission: TTransmiteFileMission;
  1764. begin
  1765. for iLoop := FTransmiteFileMissions.Count - 1 downto 0 do
  1766. begin
  1767. ATransmiteFileMission := TTransmiteFileMission(FTransmiteFileMissions[iLoop]);
  1768. if not ATransmiteFileMission.FAccepted then
  1769. begin
  1770. if ATransmiteFileMission.FDirection = tdSender then
  1771. ATransmiteFileMission.Cancel
  1772. else
  1773. ATransmiteFileMission.Decline;
  1774. end
  1775. else if not ATransmiteFileMission.FMovingFile then
  1776. begin
  1777. ATransmiteFileMission.Stop;
  1778. end;
  1779. FreeAndNil(ATransmiteFileMission);
  1780. end;
  1781. end;
  1782. //------------------------------------------------------------------------------
  1783. procedure TTalkingForm.CancelAllUpDdownFile;
  1784. var
  1785. iLoop: Integer;
  1786. ATransmiteFileMission: TUploadOrDownloadFileMission;
  1787. begin
  1788. for iLoop := FUpDownFileMissions.Count - 1 downto 0 do
  1789. begin
  1790. ATransmiteFileMission := TUploadOrDownloadFileMission(FUpDownFileMissions[iLoop]);
  1791. ATransmiteFileMission.Stop;
  1792. FreeAndNil(ATransmiteFileMission);
  1793. end;
  1794. end;
  1795. procedure TTalkingForm.CancelAllUpDdownNodeFile;
  1796. var
  1797. iLoop: Integer;
  1798. ATransmiteFileMission: TFileTransferWithNode;
  1799. begin
  1800. for iLoop := FNodeTransferMissions.Count - 1 downto 0 do
  1801. begin
  1802. ATransmiteFileMission := TFileTransferWithNode(FNodeTransferMissions[iLoop]);
  1803. FreeAndNil(ATransmiteFileMission);
  1804. end;
  1805. end;
  1806. //------------------------------------------------------------------------------
  1807. procedure TTalkingForm.ShowSendedSendFileRequest(APtoPFileTransmitter: TPtoPFileTransmitter);
  1808. var
  1809. ATransmiteFileMission: TTransmiteFileMission;
  1810. begin
  1811. ATransmiteFileMission := TTransmiteFileMission.Create(Self, tdSender, APtoPFileTransmitter.FileName, APtoPFileTransmitter.MD5Code, APtoPFileTransmitter.StreamLength, APtoPFileTransmitter.Objective, APtoPFileTransmitter.FileExtImage);
  1812. ATransmiteFileMission.FPtoPFileTransmitter := APtoPFileTransmitter;
  1813. ATransmiteFileMission.FPtoPFileTransmitter.OnAcceptted := ATransmiteFileMission.FileTransmitterAcceptted;
  1814. ATransmiteFileMission.FPtoPFileTransmitter.OnDeclined := ATransmiteFileMission.FileTransmitterDeclined;
  1815. end;
  1816. {将消息内容显示在WebBrowser中}
  1817. //------------------------------------------------------------------------------
  1818. procedure TTalkingForm.AddMessageToWebBrowser(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
  1819. var
  1820. MsgContent, HexString, HTML, SenderColor: string;
  1821. TextFont: TFont;
  1822. ID: string;
  1823. begin
  1824. ID := IntToStr(GetTickCount);
  1825. TextFont := TFont.Create;
  1826. StringToFont(FontStr, TextFont);
  1827. MsgContent := FilterHTMLCode(SenderName, MainForm.AllowURL);
  1828. if Category = tcTeam then
  1829. MsgContent := MsgContent + '(<a href="OpenRightMenu,' + SenderId + '">' + Copy(SenderId, Pos('-', SenderId) + 1, Length(SenderId)) + '</a>)';
  1830. if CompareDate(Now, SendDateTime) = EqualsValue then
  1831. MsgContent := MsgContent + ' ' + TimeToStr(SendDateTime)
  1832. else
  1833. MsgContent := MsgContent + ' ' + DateTimeToStr(SendDateTime);
  1834. if ShowSendFailed then
  1835. MsgContent := MsgContent + '(发送消息超时)'
  1836. else if (not AnsiSameText(SenderID, MainForm.RealICQClient.LoginName)) and (not IsHistory) then
  1837. 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>';
  1838. if not IsHistory then
  1839. begin
  1840. if AnsiSameText(SenderID, FReceiver) then
  1841. SenderColor := '#009900'
  1842. else
  1843. SenderColor := '#0000FF';
  1844. end
  1845. else
  1846. SenderColor := '#686868';
  1847. HTML := '<DIV style="padding-bottom:2px; padding-top:2px; color:' + SenderColor + '">' + MsgContent + '</DIV>';
  1848. HTML := HTML + '<DIV style="padding-left:9px; padding-bottom:2px;';
  1849. //设置字体
  1850. HTML := HTML + ';font-family:' + TextFont.Name;
  1851. HexString := IntToHex(TextFont.Color, 6); //获取颜色的16进制格式
  1852. HTML := HTML + ';color:#' + Copy(HexString, 5, 2) + Copy(HexString, 3, 2) + Copy(HexString, 1, 2); //将BGR颜色转换为RGB颜色
  1853. HTML := HTML + ';font-size:' + IntToStr(TextFont.Size) + 'pt';
  1854. if fsBold in TextFont.Style then
  1855. HTML := HTML + ';font-weight:bold';
  1856. if fsItalic in TextFont.Style then
  1857. HTML := HTML + ';font-style:italic';
  1858. HTML := HTML + ';text-decoration:';
  1859. if fsUnderline in TextFont.Style then
  1860. HTML := HTML + ' underline ';
  1861. if fsStrikeOut in TextFont.Style then
  1862. HTML := HTML + ' line-through ';
  1863. if IsEncry then
  1864. begin
  1865. if AnsiSameText(MainForm.RealICQClient.LoginName, SenderId) then
  1866. MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '签收消息已发送' + '</a></span>'
  1867. else
  1868. MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '收到一条待签收消息' + '</a></span>'
  1869. end
  1870. else
  1871. begin
  1872. MsgContent := FilterHTMLCode(MessageStr, MainForm.AllowURL); //过滤HTML代码
  1873. GetFaces(Self, SenderID, MsgContent, not (IsHistory or ShowSendFailed));
  1874. end;
  1875. //如果对方和自己的语言版本相同,则不要进行转换
  1876. //此处的代码,应该要移到存储消息记录到数据库之前
  1877. //if 自己是简体版 and 对方是繁体版 then MsgContent := BIG5toGB(MsgContent);
  1878. //if 自己是繁体版 and 对方是简体版 then MsgContent := GBtoBIG5(MsgContent);
  1879. HTML := HTML + '"><span id="' + ID + '">' + MsgContent + '</span> </DIV>';
  1880. InsertHTML(WebBrowser, HTML);
  1881. end;
  1882. procedure TTalkingForm.AddMessageToWebBrowserTop(SenderID: string; SenderName, FontStr, MessageStr: string; SendDateTime: TDateTime; IsEncry: Boolean; ShowSendFailed: Boolean = False; IsHistory: Boolean = False);
  1883. var
  1884. MsgContent, HexString, HTML, SenderColor: string;
  1885. TextFont: TFont;
  1886. ID: string;
  1887. begin
  1888. ID := IntToStr(GetTickCount);
  1889. TextFont := TFont.Create;
  1890. StringToFont(FontStr, TextFont);
  1891. MsgContent := FilterHTMLCode(SenderName, MainForm.AllowURL);
  1892. if Category = tcTeam then
  1893. MsgContent := MsgContent + '(<a href="OpenRightMenu,' + SenderId + '">' + Copy(SenderId, Pos('-', SenderId) + 1, Length(SenderId)) + '</a>)';
  1894. if CompareDate(Now, SendDateTime) = EqualsValue then
  1895. MsgContent := MsgContent + ' ' + TimeToStr(SendDateTime)
  1896. else
  1897. MsgContent := MsgContent + ' ' + DateTimeToStr(SendDateTime);
  1898. if ShowSendFailed then
  1899. MsgContent := MsgContent + '(发送消息超时)'
  1900. else if (not AnsiSameText(SenderID, MainForm.RealICQClient.LoginName)) and (not IsHistory) then
  1901. 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>';
  1902. if not IsHistory then
  1903. begin
  1904. if AnsiSameText(SenderID, FReceiver) then
  1905. SenderColor := '#009900'
  1906. else
  1907. SenderColor := '#0000FF';
  1908. end
  1909. else
  1910. SenderColor := '#686868';
  1911. HTML := '<DIV style="padding-bottom:2px; padding-top:2px; color:' + SenderColor + '">' + MsgContent + '</DIV>';
  1912. HTML := HTML + '<DIV style="padding-left:9px; padding-bottom:2px;';
  1913. //设置字体
  1914. HTML := HTML + ';font-family:' + TextFont.Name;
  1915. HexString := IntToHex(TextFont.Color, 6); //获取颜色的16进制格式
  1916. HTML := HTML + ';color:#' + Copy(HexString, 5, 2) + Copy(HexString, 3, 2) + Copy(HexString, 1, 2); //将BGR颜色转换为RGB颜色
  1917. HTML := HTML + ';font-size:' + IntToStr(TextFont.Size) + 'pt';
  1918. if fsBold in TextFont.Style then
  1919. HTML := HTML + ';font-weight:bold';
  1920. if fsItalic in TextFont.Style then
  1921. HTML := HTML + ';font-style:italic';
  1922. HTML := HTML + ';text-decoration:';
  1923. if fsUnderline in TextFont.Style then
  1924. HTML := HTML + ' underline ';
  1925. if fsStrikeOut in TextFont.Style then
  1926. HTML := HTML + ' line-through ';
  1927. if IsEncry then
  1928. begin
  1929. if AnsiSameText(MainForm.RealICQClient.LoginName, SenderId) then
  1930. MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '签收消息已发送' + '</a></span>'
  1931. else
  1932. MsgContent := '<span id=SeePrivateMessage' + MessageStr + '><a href="SeePrivateMessage,' + MessageStr + '">' + '收到一条待签收消息' + '</a></span>'
  1933. end
  1934. else
  1935. begin
  1936. MsgContent := FilterHTMLCode(MessageStr, MainForm.AllowURL); //过滤HTML代码
  1937. GetFaces(Self, SenderID, MsgContent, not (IsHistory or ShowSendFailed));
  1938. end;
  1939. //如果对方和自己的语言版本相同,则不要进行转换
  1940. //此处的代码,应该要移到存储消息记录到数据库之前
  1941. //if 自己是简体版 and 对方是繁体版 then MsgContent := BIG5toGB(MsgContent);
  1942. //if 自己是繁体版 and 对方是简体版 then MsgContent := GBtoBIG5(MsgContent);
  1943. HTML := HTML + '"><span id="' + ID + '">' + MsgContent + '</span> </DIV>';
  1944. InsertHTMLTop(WebBrowser, HTML);
  1945. end;
  1946. {显示群组消息}
  1947. //------------------------------------------------------------------------------
  1948. procedure TTalkingForm.ShowTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean = False);
  1949. var
  1950. AFileName, AMessageStr: string;
  1951. SenderName: string;
  1952. FRealICQUser: TRealICQUser;
  1953. HTML: string;
  1954. Alias: string;
  1955. begin
  1956. Alias := TTeamsAdapter.GetAlias(RealICQTeamMessage.TeamID, RealICQTeamMessage.Sender);
  1957. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(RealICQTeamMessage.Sender);
  1958. if Alias = '' then
  1959. begin
  1960. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  1961. SenderName := FRealICQUser.LoginName
  1962. else
  1963. SenderName := FRealICQUser.DisplayName;
  1964. end
  1965. else
  1966. SenderName := Alias;
  1967. if Copy(RealICQTeamMessage.MessageStr, 1, 11) = '<TeamShare>' then
  1968. begin
  1969. if Copy(RealICQTeamMessage.MessageStr, Length(RealICQTeamMessage.MessageStr) - 11, 12) = '</TeamShare>' then
  1970. begin
  1971. HTML := '<table width="100%" style="font-size:9pt;border:0px; padding:2px; color:#000000; margin-top:2px;margin-bottom:5px;"><tr><td>';
  1972. HTML := HTML + '<img src="' + ExtractFilePath(Application.ExeName) + TeamSharePic + '" align="absmiddle"> ';
  1973. HTML := HTML + '<span>';
  1974. AFileName := ReplaceStr(ReplaceStr(RealICQTeamMessage.MessageStr, '<TeamShare>', ''), '</TeamShare>', '');
  1975. HTML := HTML + FilterHtmlCode(SenderName, MainForm.AllowURL) + ' 共享了文件:' + AFileName + ' <a href="ShowTeamShare_' + AFileName + '" title="点击查看群共享空间" >查看</a> ';
  1976. HTML := HTML + '</span>';
  1977. HTML := HTML + '</td></tr></table>';
  1978. InsertHTML(WebBrowser, HTML);
  1979. Exit;
  1980. end;
  1981. end;
  1982. if RealICQTeamMessage.IsEncryMessage then
  1983. begin
  1984. AMessageStr := IntToStr(RealICQTeamMessage.ID)
  1985. end
  1986. else
  1987. AMessageStr := RealICQTeamMessage.MessageStr;
  1988. AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, RealICQTeamMessage.FontStr, AMessageStr, RealICQTeamMessage.SendDateTime, RealICQTeamMessage.IsEncryMessage, ShowSendFailed);
  1989. end;
  1990. {显示消息}
  1991. //------------------------------------------------------------------------------
  1992. procedure TTalkingForm.ShowMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean = False);
  1993. var
  1994. SenderName, AMessageStr: string;
  1995. FRealICQUser: TRealICQUser;
  1996. begin
  1997. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(RealICQMessage.Sender);
  1998. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  1999. SenderName := FRealICQUser.LoginName
  2000. else
  2001. SenderName := FRealICQUser.DisplayName;
  2002. if RealICQMessage.IsEncryMessage then
  2003. begin
  2004. AMessageStr := IntToStr(RealICQMessage.ID)
  2005. end
  2006. else
  2007. AMessageStr := RealICQMessage.MessageStr;
  2008. AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, RealICQMessage.FontStr, AMessageStr, RealICQMessage.SendDateTime, RealICQMessage.IsEncryMessage, ShowSendFailed);
  2009. if AnsiSameText(RealICQMessage.Sender, Receiver) then
  2010. begin
  2011. ClearInputtingMessageTimerTimer(nil);
  2012. end;
  2013. end;
  2014. //------------------------------------------------------------------------------
  2015. procedure TTalkingForm.ImgHideShowUserInformationClick(Sender: TObject);
  2016. begin
  2017. imgHideShowUserInformation.Enabled := False;
  2018. try
  2019. if pnlUserInformation.Width = 0 then
  2020. begin
  2021. Width := Width + FOldWidthOfUserInfo;
  2022. pnlUserInformation.Width := FOldWidthOfUserInfo;
  2023. end
  2024. else
  2025. begin
  2026. FOldWidthOfUserInfo := pnlUserInformation.Width;
  2027. pnlUserInformation.Width := 0;
  2028. Width := Width - FOldWidthOfUserInfo;
  2029. end;
  2030. finally
  2031. imgHideShowUserInformation.Enabled := True;
  2032. ShowspbShowHideUserInformationState;
  2033. if ImgHideShowUserInformation.Hint = '隐藏侧边' then
  2034. ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'HideBmp')
  2035. else
  2036. ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'ShowBmp');
  2037. ConvertBitmapToColor(ImgHideShowUserInformation.Picture.Bitmap, MainForm.UIMainColor);
  2038. ImgHideShowUserInformation.Invalidate;
  2039. end;
  2040. end;
  2041. //------------------------------------------------------------------------------
  2042. procedure TTalkingForm.ShowSpbShowHideUserInformationState;
  2043. begin
  2044. if pnlUserInformation.Width = 0 then
  2045. begin
  2046. imgHideShowUserInformation.Hint := '显示侧边';
  2047. end
  2048. else
  2049. begin
  2050. imgHideShowUserInformation.Hint := '隐藏侧边';
  2051. end;
  2052. end;
  2053. procedure TTalkingForm.ImgHideShowUserInformationMouseEnter(Sender: TObject);
  2054. begin
  2055. if ImgHideShowUserInformation.Hint = '隐藏侧边' then
  2056. ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'HideBmp')
  2057. else
  2058. ImgHideShowUserInformation.Picture.Bitmap.Handle := LoadBitmap(hInstance, 'ShowBmp');
  2059. ConvertBitmapToColor(ImgHideShowUserInformation.Picture.Bitmap, MainForm.UIMainColor);
  2060. ImgHideShowUserInformation.Invalidate;
  2061. end;
  2062. procedure TTalkingForm.ImgHideShowUserInformationMouseLeave(Sender: TObject);
  2063. begin
  2064. ImgHideShowUserInformation.Picture.Bitmap := nil;
  2065. ImgHideShowUserInformation.Invalidate;
  2066. end;
  2067. procedure TTalkingForm.InsertFaceToRichEdit(Face: TFace; FaceID: Integer);
  2068. var
  2069. Sys32Dir: string;
  2070. pSys32Dir: array[0..Max_Path] of char;
  2071. begin
  2072. try
  2073. RichEdInputer.InsertImage(Face.FileName, FaceID);
  2074. except
  2075. on e: exception do
  2076. begin
  2077. GetSystemDirectory(pSys32Dir, Max_Path);
  2078. Sys32Dir := StrPas(pSys32Dir);
  2079. CopyFile(PChar(ExtractFilePath(paramstr(0)) + ImageX2_DLL_PACH), PChar(Sys32Dir + '\ImageX2.dll'), False);
  2080. try
  2081. WinExec(PChar('regsvr32 /s "' + 'ImageX2.dll"'), SW_HIDE);
  2082. except
  2083. end;
  2084. Sleep(500);
  2085. RichEdInputer.InsertImage(Face.FileName, FaceID);
  2086. end;
  2087. end;
  2088. end;
  2089. //------------------------------------------------------------------------------
  2090. procedure TTalkingForm.ChangeUIColor(AColor: TColor);
  2091. begin
  2092. inherited ChangeUIColor(AColor);
  2093. spbCloseTeamWebDisk.ChangeUIColor(AColor);
  2094. PnlShowHideUserInfo.Color := FormColor;
  2095. pnlClient.Color := FormColor;
  2096. //pnlMenu.Color := FormColor;
  2097. pnlUserInformation.Color := FormColor;
  2098. pnlTalkingArea.Color := FormColor;
  2099. //Splitter1.Color := ConvertColorToColor(Splitter1.Color, AColor);
  2100. Panel5.Color := FormColor;
  2101. ConvertBitmapToColor(ImgInputerTopLeft.Picture.Bitmap, AColor);
  2102. ImgInputerTopLeft.Invalidate;
  2103. ConvertBitmapToColor(ImgInputerTopRight.Picture.Bitmap, AColor);
  2104. ImgInputerTopRight.Invalidate;
  2105. //pnlForActionMainMenuBar.Color := FormColor;
  2106. pnlForActionToolBar.Color := FormColor;
  2107. pnlTeamMembers.Color := FormColor;
  2108. pnlTeamCallBoard.Color := FormColor;
  2109. //ActionMainMenuBar.ColorMap.Color := FormColor;
  2110. //ActionMainMenuBar.ColorMap.SelectedColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.SelectedColor, AColor);
  2111. //ActionMainMenuBar.ColorMap.BtnFrameColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.BtnFrameColor, AColor);
  2112. //ActionMainMenuBar.Font.Name := '宋体';
  2113. //ActionMainMenuBar.Font.Size := 9;
  2114. if FVCardFrom <> nil then
  2115. FVCardFrom.ChangeUIColor(AColor);
  2116. spbAddUser.ChangeUIColor(AColor);
  2117. spbSendFile.ChangeUIColor(AColor);
  2118. spbAudio.ChangeUIColor(AColor);
  2119. spbVideo.ChangeUIColor(AColor);
  2120. spbSeeTeamOptions.ChangeUIColor(AColor);
  2121. spbQuitTeam.ChangeUIColor(AColor);
  2122. spbDisbandTeam.ChangeUIColor(AColor);
  2123. spbUploadFile.ChangeUIColor(AColor);
  2124. spbRemoteControl.ChangeUIColor(AColor);
  2125. spbSendFolder.ChangeUIColor(AColor);
  2126. spbTeamNetWorkDisk.ChangeUIColor(AColor);
  2127. spbSendSMS.ChangeUIColor(AColor);
  2128. spbPostSMS.ChangeUIColor(AColor);
  2129. spbUserInfo.ChangeUIColor(AColor);
  2130. spbSet.ChangeUIColor(AColor);
  2131. spbAbout.ChangeUIColor(AColor);
  2132. btnQR.ChangeUIColor(AColor);
  2133. spbSelUIColor.ChangeUIColor(AColor);
  2134. spbUploadTeamFile.ChangeUIColor(AColor);
  2135. spbUploadTeamFileProcess.ChangeUIColor(AColor);
  2136. ConvertBitmapToColor(imgToolbarBack.Picture.Bitmap, AColor);
  2137. imgToolbarBack.Invalidate;
  2138. ConvertBitmapToColor(ImgDisplayerTopLeft.Picture.Bitmap, AColor);
  2139. ImgDisplayerTopLeft.Invalidate;
  2140. ConvertBitmapToColor(ImgDisplayerTopRight.Picture.Bitmap, AColor);
  2141. ImgDisplayerTopRight.Invalidate;
  2142. ConvertBitmapToColor(imgTeamWebDiskToolbarBack.Picture.Bitmap, AColor);
  2143. imgTeamWebDiskToolbarBack.Invalidate;
  2144. ShpDisplayerTopMiddle.Pen.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Pen.Color, AColor);
  2145. ShpDisplayerTopMiddle.Brush.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Brush.Color, AColor);
  2146. ShpDisplayerClient.Pen.Color := ConvertColorToColor(ShpDisplayerClient.Pen.Color, AColor);
  2147. ConvertBitmapToColor(ImgInputerTopLeft.Picture.Bitmap, AColor);
  2148. ImgInputerTopLeft.Invalidate;
  2149. //ConvertBitmapToColor(ImgInputerTopMiddle.Picture.Bitmap, AColor);
  2150. //ImgInputerTopMiddle.Invalidate;
  2151. ConvertBitmapToColor(ImgInputerTopRight.Picture.Bitmap, AColor);
  2152. ImgInputerTopRight.Invalidate;
  2153. //ConvertBitmapToColor(ImgInputerBottomLeft.Picture.Bitmap, AColor);
  2154. //ImgInputerBottomLeft.Invalidate;
  2155. //ConvertBitmapToColor(ImgInputerBottomMiddle.Picture.Bitmap, AColor);
  2156. //ImgInputerBottomMiddle.Invalidate;
  2157. //ConvertBitmapToColor(ImgInputerBottomRight.Picture.Bitmap, AColor);
  2158. //ImgInputerBottomRight.Invalidate;
  2159. //ConvertBitmapToColor(ImgMyVideoBorder.Picture.Bitmap, AColor);
  2160. //ImgMyVideoBorder.Invalidate;
  2161. //ConvertBitmapToColor(ImgYourVideoBorder.Picture.Bitmap, AColor);
  2162. //ImgYourVideoBorder.Invalidate;
  2163. ShpInputerClient.Pen.Color := ConvertColorToColor(ShpInputerClient.Pen.Color, AColor);
  2164. //ConvertBitmapToColor(ImgHeadBorderForMyInfo.Picture.Bitmap, AColor);
  2165. //ImgHeadBorderForMyInfo.Invalidate;
  2166. SpbForMyInfo.ChangeUIColor(AColor);
  2167. //rndMyInfo.ChangeUIColor(AColor);
  2168. //pgcMyInfo.Color := rndMyInfo.BackColor;
  2169. //ConvertBitmapToColor(ImgHeadBorderForYourInfo.Picture.Bitmap, AColor);
  2170. //ImgHeadBorderForYourInfo.Invalidate;
  2171. SpbForYourInfo.ChangeUIColor(AColor);
  2172. //pgcYourInfo.Color := rndYourInfo.BackColor;
  2173. //rndYourInfo.ChangeUIColor(AColor);
  2174. SpbForTeamMemberInfo.ChangeUIColor(AColor);
  2175. PnlTeamWebDisk.Color := FormColor;
  2176. RndTeamWebDisk.ChangeUIColor(AColor);
  2177. rndTeamMembers.ChangeUIColor(AColor);
  2178. rndTeamCallBoard.ChangeUIColor(AColor);
  2179. lblTeamMemberCount.Font.Color := ConvertColorToColor(lblTeamMemberCount.Font.Color, AColor);
  2180. rndTeamMemberContainer.ChangeUIColor(AColor);
  2181. //ShpHint.Pen.Color := ConvertColorToColor(ShpHint.Pen.Color, AColor);
  2182. //CardYour.ChangeUIColor(AColor);
  2183. //CardMine.ChangeUIColor(AColor);
  2184. btSend.ChangeUIColor(AColor);
  2185. btCloseTalk.ChangeUIColor(AColor);
  2186. btDownArrow.ChangeUIColor(AColor);
  2187. spbFont.ChangeUIColor(AColor);
  2188. spbFace.ChangeUIColor(AColor);
  2189. spbSendImage.ChangeUIColor(AColor);
  2190. spbCopyScreen.ChangeUIColor(AColor);
  2191. //spbCopyScreen2.ChangeUIColor(AColor);
  2192. spbShakeWindow.ChangeUIColor(AColor);
  2193. spbBackground.ChangeUIColor(AColor);
  2194. spbHistroyMessage.ChangeUIColor(AColor);
  2195. spbNormalMsg.ChangeUIColor(AColor);
  2196. spbEncryMsg.ChangeUIColor(AColor);
  2197. MicrophoneVolume.ChangeUIColor(AColor);
  2198. //MicrophoneVolume.Color := rndMyInfo.BackColor;
  2199. MasterVolume.ChangeUIColor(AColor);
  2200. //MasterVolume.Color := rndYourInfo.BackColor;
  2201. rndMyInfo.BorderColor := ConvertColorToColor(rndMyInfo.BorderColor, AColor);
  2202. rndYourInfo.BorderColor := ConvertColorToColor(rndYourInfo.BorderColor, AColor);
  2203. spbSpk.ChangeUIColor(AColor);
  2204. spbMic.ChangeUIColor(AColor);
  2205. if FLVTeamMembers <> nil then
  2206. FLVTeamMembers.ChangeUIColor(AColor);
  2207. if VideoForm <> nil then
  2208. begin
  2209. if VideoForm.TalkingForm = Self then
  2210. VideoForm.ChangeUIColor(AColor);
  2211. end;
  2212. try
  2213. FWindowColor := AColor;
  2214. if not WebBrowser.Busy then
  2215. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  2216. except
  2217. end;
  2218. end;
  2219. //------------------------------------------------------------------------------
  2220. procedure TTalkingForm.ClearInputtingMessageTimerTimer(Sender: TObject);
  2221. var
  2222. RealICQUser: TRealICQUser;
  2223. UserName: string;
  2224. begin
  2225. lblState.Caption := '';
  2226. if FCategory = tcNormal then
  2227. begin
  2228. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  2229. if not Assigned(RealICQUser) then
  2230. UserName := FReceiver
  2231. else if RealICQUser.DisplayName = '' then
  2232. UserName := RealICQUser.LoginName
  2233. else
  2234. UserName := RealICQUser.DisplayName;
  2235. Caption := UserName;
  2236. PostMessage(Handle, WM_SIZE, 0, 0);
  2237. end;
  2238. end;
  2239. procedure TTalkingForm.EditFontSetExecute(Sender: TObject);
  2240. begin
  2241. FontDialog.Font := RichEdInputer.Font;
  2242. if FontDialog.Execute then
  2243. begin
  2244. RichEdInputer.Font := FontDialog.Font;
  2245. MainForm.InputFont := RichEdInputer.Font;
  2246. RichEdInputer.DisableAlign;
  2247. try
  2248. PostMessage(RichEdInputer.Handle, WM_SIZE, 0, 0);
  2249. finally
  2250. RichEdInputer.EnableAlign;
  2251. end;
  2252. end;
  2253. end;
  2254. //------------------------------------------------------------------------------
  2255. procedure TTalkingForm.FormClose(Sender: TObject; var Action: TCloseAction);
  2256. begin
  2257. Action := caFree;
  2258. FreeAndNil(FTeamUpLoadFile);
  2259. end;
  2260. //------------------------------------------------------------------------------
  2261. function TTalkingForm.CheckNotCompletedMission: Integer;
  2262. begin
  2263. Result := 0;
  2264. //是否有音频对话任务未结束
  2265. if FAudioMission <> nil then
  2266. Inc(Result);
  2267. //是否有音频对话任务未结束
  2268. if FVideoMission <> nil then
  2269. Inc(Result);
  2270. //是否有文件传输任务未结束
  2271. Inc(Result, FTransmiteFileMissions.Count);
  2272. //是否有文件传输任务未结束
  2273. Inc(Result, FUpDownFileMissions.Count);
  2274. //是否有远程协助任务未结束
  2275. if FRemoteControlMission <> nil then
  2276. Inc(Result);
  2277. //是否有离线文件传输任务未结束
  2278. Inc(Result, FNodeTransferMissions.Count);
  2279. end;
  2280. procedure TTalkingForm.CloseAllMissions;
  2281. var
  2282. iLoop: Integer;
  2283. WaitingFace: TWaitingFace;
  2284. begin
  2285. try
  2286. {$region '结束音频对话'}
  2287. try
  2288. if FAudioMission <> nil then
  2289. begin
  2290. if FAudioMission.FAccepted then
  2291. FRealICQClient.StopAudioTransmitter(Receiver)
  2292. else if FAudioMission.FIsSource then
  2293. FRealICQClient.CancelAudioTransmitter(Receiver)
  2294. else
  2295. FRealICQClient.DeclineAudioTransmitter(Receiver);
  2296. end;
  2297. except
  2298. end;
  2299. {$endregion}
  2300. {$region '结束视频对话'}
  2301. try
  2302. if FVideoMission <> nil then
  2303. begin
  2304. if FVideoMission.FAccepted then
  2305. FRealICQClient.StopVideoTransmitter(Receiver)
  2306. else if FVideoMission.FIsSource then
  2307. FRealICQClient.CancelVideoTransmitter(Receiver)
  2308. else
  2309. FRealICQClient.DeclineVideoTransmitter(Receiver);
  2310. end;
  2311. except
  2312. end;
  2313. {$endregion}
  2314. {$region '结束程协助'}
  2315. try
  2316. if FRemoteControlMission <> nil then
  2317. begin
  2318. if FRemoteControlMission.FAccepted then
  2319. FRealICQClient.StopRemoteControlTransmitter(Receiver)
  2320. else if FRemoteControlMission.FIsSource then
  2321. FRealICQClient.CancelRemoteControlTransmitter(Receiver)
  2322. else
  2323. FRealICQClient.DeclineRemoteControlTransmitter(Receiver);
  2324. for iLoop := 0 to 10 do
  2325. begin
  2326. Sleep(50);
  2327. Application.ProcessMessages;
  2328. end;
  2329. end;
  2330. except
  2331. end;
  2332. {$endregion}
  2333. {$region '结束文件传输'}
  2334. try
  2335. CancelAllSendFile;
  2336. except
  2337. end;
  2338. {$endregion}
  2339. {$region '结束离线文件传输'}
  2340. try
  2341. CancelAllUpDdownFile;
  2342. except
  2343. end;
  2344. {$endregion}
  2345. {$region '删除等待表情的任务'}
  2346. for iLoop := WaitingFaces.Count - 1 downto 0 do
  2347. begin
  2348. WaitingFace := WaitingFaces.Objects[iLoop] as TWaitingFace;
  2349. if WaitingFace.WebBrowser = Self.WebBrowser then
  2350. begin
  2351. WaitingFaces.Delete(iLoop);
  2352. FreeAndNil(WaitingFace);
  2353. end;
  2354. end;
  2355. {$endregion}
  2356. {$region '结束Node文件传输'}
  2357. try
  2358. CancelAllUpDdownNodeFile;
  2359. except
  2360. end;
  2361. {$endregion}
  2362. except
  2363. end;
  2364. end;
  2365. //------------------------------------------------------------------------------
  2366. procedure TTalkingForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  2367. var
  2368. NotCompletedMission, iIndex: Integer;
  2369. ATeam: TRealICQTeam;
  2370. begin
  2371. try
  2372. if FCategory = tcTeam then
  2373. begin
  2374. iIndex := FRealICQClient.Teams.IndexOf(FTeamID);
  2375. if iIndex = -1 then
  2376. Exit;
  2377. ATeam := FRealICQClient.Teams.Objects[iIndex] as TRealICQTeam;
  2378. if ATeam.IsTempTeam then
  2379. begin
  2380. if AnsiSameText(ATeam.TeamCreater, FRealICQClient.LoginName) then
  2381. begin
  2382. if MessageBox(Handle, '关闭窗口将会解散该临时群组会话,确定要关闭吗? ', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  2383. begin
  2384. CanClose := False;
  2385. Exit;
  2386. end
  2387. else
  2388. begin
  2389. FRealICQClient.DisbandTeam(FTeamID);
  2390. end;
  2391. end
  2392. else
  2393. begin
  2394. if MessageBox(Handle, '闭窗口将会解散该临时群组会话,确定要关闭吗? ', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  2395. begin
  2396. CanClose := False;
  2397. Exit;
  2398. end
  2399. else
  2400. begin
  2401. FRealICQClient.QuitTeam(FTeamID);
  2402. end;
  2403. end;
  2404. end;
  2405. NotCompletedMission := CheckNotCompletedMission;
  2406. if NotCompletedMission > 0 then
  2407. begin
  2408. if MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个任务未结束,确定要关闭窗口吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  2409. begin
  2410. CanClose := False;
  2411. Exit;
  2412. end;
  2413. end;
  2414. CloseAllMissions;
  2415. end
  2416. else
  2417. begin
  2418. NotCompletedMission := CheckNotCompletedMission;
  2419. if NotCompletedMission > 0 then
  2420. begin
  2421. if MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个任务未结束,确定要关闭窗口吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  2422. begin
  2423. CanClose := False;
  2424. Exit;
  2425. end;
  2426. end;
  2427. CloseAllMissions;
  2428. end;
  2429. except
  2430. end;
  2431. CanClose := True;
  2432. end;
  2433. //------------------------------------------------------------------------------
  2434. procedure TTalkingForm.FormCreate(Sender: TObject);
  2435. var
  2436. iLoop: Integer;
  2437. begin
  2438. FMaxID := MaxInt;
  2439. FTeamUpLoadFile := TUpLoadFile.Create;
  2440. FTeamUpLoadFile.OnProgress := TeamUpFileProgress;
  2441. FTeamUpLoadFile.OnComplete := DownFileComplete;
  2442. TalkingForms.Add(Self);
  2443. ImagesList := TList.Create;
  2444. DoubleBuffered := True;
  2445. // pnlClient.DoubleBuffered := True;
  2446. // pnlToolBar.DoubleBuffered := True;
  2447. //pnlMenu.DoubleBuffered := True;
  2448. for iLoop := 0 to Self.ControlCount - 1 do
  2449. if Self.Controls[iLoop] is TWinControl then
  2450. (Self.Controls[iLoop] as TWinControl).DoubleBuffered := True;
  2451. // pnlUserInformation.DoubleBuffered := True;
  2452. // pnlTalkingArea.DoubleBuffered := True;
  2453. // pnlInputer.DoubleBuffered := True;
  2454. // pnlDisplayer.DoubleBuffered := True;
  2455. // pnlMyInfo.DoubleBuffered := True;
  2456. // pnlYourInfo.DoubleBuffered := True;
  2457. // pnlHint.DoubleBuffered := True;
  2458. // pnlForWebBrowser.DoubleBuffered := True;
  2459. // tsMyHeadImage.DoubleBuffered := True;
  2460. // tsYourHeadImage.DoubleBuffered := True;
  2461. // btSend.DoubleBuffered := True;
  2462. // WebBrowser.DoubleBuffered := False;
  2463. // tsYourVideo.DoubleBuffered := True;
  2464. // tsMyVideo.DoubleBuffered := True;
  2465. // ImgYourVideo.Parent.DoubleBuffered := True;
  2466. //ImgYourVideoBorder.Parent.DoubleBuffered := True;
  2467. // ImgMyVideo.Parent.DoubleBuffered := True;
  2468. //ImgMyVideoBorder.Parent.DoubleBuffered := True;
  2469. // pnlForActionToolBar.DoubleBuffered := True;
  2470. // pnlInputeBack.DoubleBuffered := True;
  2471. // RichEdInputer.DoubleBuffered := True;
  2472. TTalkFormController.GetController.ChangeStyle(Self);
  2473. for iLoop := 0 to RichEdInputer.ControlCount - 1 do
  2474. begin
  2475. if RichEdInputer.Controls[iLoop] is TWinControl then
  2476. TWinControl(RichEdInputer.Controls[iLoop]).DoubleBuffered := True;
  2477. end;
  2478. // RichEdInputer.Parent.DoubleBuffered := True;
  2479. //pnlSendButtonBack.DoubleBuffered := True;
  2480. FLastSendMsgTicket := 0;
  2481. FVCardFrom := TVCardForm.Create(Self);
  2482. FReceiver := '';
  2483. FTeamID := '';
  2484. Left := MainForm.TalkingFormLeft;
  2485. Top := MainForm.TalkingFormTop;
  2486. Width := MainForm.TalkingFormWidth - pnlRC.Width - SplitterRC.Width;
  2487. Height := MainForm.TalkingFormHeight;
  2488. if Left < 0 then
  2489. Left := 0;
  2490. if Left + Width > Screen.WorkAreaWidth then
  2491. Left := Screen.WorkAreaWidth - Width;
  2492. if Top < 0 then
  2493. Top := 0;
  2494. if Top + Height > Screen.WorkAreaHeight then
  2495. Top := Screen.WorkAreaHeight - Height;
  2496. FLastSendInputtingMessageTicket := 0;
  2497. FormStyle := fsNormal;
  2498. actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage;
  2499. actEnter.Checked := not MainForm.CtrlEnterSendMessage;
  2500. actCopyScreenHideForm.Checked := MainForm.CopyScreenHideTalkForm;
  2501. FAudioMission := nil;
  2502. FTransmiteFileMissions := TList.Create;
  2503. FUpDownFileMissions := TList.Create;
  2504. FNodeTransferMissions := TList.Create;
  2505. FFileTransmitters := TStringList.Create;
  2506. RichEdInputer.MaxLength := MaxMessageLength;
  2507. RichEdInputer.DoubleBuffered := False;
  2508. RichEdInputer.Color := 16645629;
  2509. RichEdInputer.Font := MainForm.InputFont;
  2510. FSender := '';
  2511. FReceiver := '';
  2512. SkinName := AnsiReplaceText(MainForm.SkinName, 'MainForm', '');
  2513. FWindowColor := MainForm.UIMainColor;
  2514. //ChangeUIColor(FWindowColor);
  2515. FOldWidthOfUserInfo := pnlUserInformation.Width;
  2516. FMinWidthOfYourPanel := 114;
  2517. FMinWidthOfMyPanel := 114;
  2518. FLastSendShakeWindowTicket := 0;
  2519. ShowSpbShowHideUserInformationState;
  2520. LoadOfflinefilesConfig;
  2521. //Exit;
  2522. WebBrowser.OnBeforeNavigate2 := nil;
  2523. WebBrowser.Navigate(ExtractFilePath(paramstr(0)) + 'html\chat.html');
  2524. FBaseURL := ExtractFilePath(paramstr(0)) + 'html\';
  2525. FBaseURL := UpperCase(FBaseURL);
  2526. WebBrowser.OnBeforeNavigate2 := WebBrowserBeforeNavigate2;
  2527. DragAcceptFiles(Handle, True);
  2528. DragAcceptFiles(RichEdInputer.Handle, True);
  2529. DragAcceptFiles(WebBrowser.Handle, True);
  2530. DragAcceptFiles(RichEditTemp.Handle, True);
  2531. end;
  2532. //------------------------------------------------------------------------------
  2533. procedure TTalkingForm.FormDestroy(Sender: TObject);
  2534. begin
  2535. try
  2536. try
  2537. if FVCardFrom <> nil then
  2538. FreeAndNil(FVCardFrom);
  2539. if WindowState <> wsMaximized then
  2540. begin
  2541. MainForm.TalkingFormLeft := Left;
  2542. MainForm.TalkingFormTop := Top;
  2543. MainForm.TalkingFormWidth := Width;
  2544. MainForm.TalkingFormHeight := Height;
  2545. MainForm.SaveDefaultConfigs;
  2546. end;
  2547. CloseAllMissions;
  2548. while (ImagesList.Count > 0) do
  2549. begin
  2550. dispose(ImagesList.First);
  2551. ImagesList.Delete(0);
  2552. end;
  2553. ImagesList.Free;
  2554. finally
  2555. TalkingForms.Remove(Self);
  2556. FreeAndNil(FTransmiteFileMissions);
  2557. FreeAndNil(FUpDownFileMissions);
  2558. FreeAndNil(FNodeTransferMissions);
  2559. FreeAndNil(FFileTransmitters);
  2560. end;
  2561. FLVTeamMembers.Items.Clear;
  2562. //if FLVTeamMembers <> nil then FreeAndNil(FLVTeamMembers);
  2563. except
  2564. end;
  2565. end;
  2566. procedure TTalkingForm.FormResize(Sender: TObject);
  2567. begin
  2568. ImgHideShowUserInformation.Top := (PnlShowHideUserInfo.Height - ImgHideShowUserInformation.Height) div 2 - 20;
  2569. end;
  2570. //------------------------------------------------------------------------------
  2571. procedure TTalkingForm.FormShow(Sender: TObject);
  2572. var
  2573. iWaitTimes: Integer;
  2574. begin
  2575. if TConditionConfig.GetConfig.GradeSystem and (FCategory = tcNormal) then
  2576. begin
  2577. btCloseTalk.Caption := '邀请评分';
  2578. btCloseTalk.Width := 96;
  2579. btCloseTalk.Left := 233;
  2580. end;
  2581. pnlRC.Visible := False;
  2582. SplitterRC.Visible := False;
  2583. pnlTalkingArea.Align := alLeft;
  2584. pnlTalkingArea.Align := alClient;
  2585. Left := MainForm.TalkingFormLeft;
  2586. Top := MainForm.TalkingFormTop;
  2587. Width := MainForm.TalkingFormWidth;
  2588. Height := MainForm.TalkingFormHeight;
  2589. if Left < 0 then
  2590. Left := 0;
  2591. if Left + Width > Screen.WorkAreaWidth then
  2592. Left := Screen.WorkAreaWidth - Width;
  2593. if Top < 0 then
  2594. Top := 0;
  2595. if Top + Height > Screen.WorkAreaHeight then
  2596. Top := Screen.WorkAreaHeight - Height;
  2597. Application.ProcessMessages;
  2598. iWaitTimes := 0;
  2599. while not CanWriteMessage do
  2600. begin
  2601. Application.ProcessMessages;
  2602. Inc(iWaitTimes);
  2603. if iWaitTimes > 1000 then
  2604. break;
  2605. Sleep(10);
  2606. end;
  2607. try
  2608. LoadNotReadMessages;
  2609. except
  2610. end;
  2611. LoadAdvertisement;
  2612. FreeAndNil(UserCardForm);
  2613. end;
  2614. //------------------------------------------------------------------------------
  2615. procedure TTalkingForm.lblDestClick(Sender: TObject);
  2616. begin
  2617. if FCategory = tcNormal then
  2618. miSeeYourDetailInformationClick(nil)
  2619. else
  2620. miSeeTeamDetailInformationClick(nil);
  2621. end;
  2622. //------------------------------------------------------------------------------
  2623. procedure TTalkingForm.lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2624. begin
  2625. lblDest.Left := lblDest.Left + 1;
  2626. lblDest.Top := lblDest.Top + 1;
  2627. end;
  2628. //------------------------------------------------------------------------------
  2629. procedure TTalkingForm.lblDestMouseEnter(Sender: TObject);
  2630. begin
  2631. lblDest.Cursor := crHandPoint;
  2632. lblDest.Font.Style := [fsUnderline]
  2633. end;
  2634. //------------------------------------------------------------------------------
  2635. procedure TTalkingForm.lblDestMouseLeave(Sender: TObject);
  2636. begin
  2637. lblDest.Cursor := crDefault;
  2638. lblDest.Font.Style := []
  2639. end;
  2640. //------------------------------------------------------------------------------
  2641. procedure TTalkingForm.lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2642. begin
  2643. lblDest.Left := lblDest.Left - 1;
  2644. lblDest.Top := lblDest.Top - 1;
  2645. end;
  2646. //------------------------------------------------------------------------------
  2647. procedure TTalkingForm.ChangePopupActionBarColor(PopupActionBar: TPopupActionBar);
  2648. begin
  2649. PopupActionBar.PopupMenu.ColorMap.Color := FormColor;
  2650. PopupActionBar.PopupMenu.ColorMap.SelectedColor := ConvertColorToColor(PopupActionBar.PopupMenu.ColorMap.SelectedColor, FWindowColor);
  2651. PopupActionBar.PopupMenu.ColorMap.BtnFrameColor := ConvertColorToColor(PopupActionBar.PopupMenu.ColorMap.BtnFrameColor, FWindowColor);
  2652. PopupActionBar.PopupMenu.Font.Name := '宋体';
  2653. PopupActionBar.PopupMenu.Font.Size := 9;
  2654. end;
  2655. //------------------------------------------------------------------------------
  2656. procedure TTalkingForm.ppAudioSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2657. begin
  2658. ChangePopupActionBarColor(ppAudioSet);
  2659. end;
  2660. //------------------------------------------------------------------------------
  2661. procedure TTalkingForm.ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2662. begin
  2663. ChangePopupActionBarColor(ppColors);
  2664. end;
  2665. //------------------------------------------------------------------------------
  2666. procedure TTalkingForm.ppColorsPopup(Sender: TObject);
  2667. var
  2668. iLoop: Integer;
  2669. ColorStr: string;
  2670. MenuItem: TMenuItem;
  2671. Bitmap: TBitmap;
  2672. begin
  2673. MainForm.ImgLstColors.Clear;
  2674. while ppColors.Items.Count > 2 do
  2675. ppColors.Items.Delete(0);
  2676. Bitmap := TBitmap.Create;
  2677. Bitmap.SetSize(16, 16);
  2678. try
  2679. for iLoop := MainForm.ColorDialog.CustomColors.Count - 1 downto 0 do
  2680. begin
  2681. ColorStr := Copy(MainForm.ColorDialog.CustomColors[iLoop], 8, 6);
  2682. if ColorStr = 'FFFFFF' then
  2683. continue;
  2684. ColorStr := '$00' + ColorStr;
  2685. Bitmap.Canvas.Pen.Color := clGray;
  2686. Bitmap.Canvas.Pen.Style := psSolid;
  2687. Bitmap.Canvas.Brush.Color := StrToInt(ColorStr);
  2688. Bitmap.Canvas.Brush.Style := bsSolid;
  2689. Bitmap.Canvas.Rectangle(0, 0, Width, Height);
  2690. MainForm.ImgLstColors.Add(Bitmap, nil);
  2691. MenuItem := TMenuItem.Create(ppColors);
  2692. MenuItem.Caption := '颜色' + IntToStr(iLoop);
  2693. MenuItem.Tag := StrToInt(ColorStr);
  2694. MenuItem.ImageIndex := MainForm.ImgLstColors.Count - 1;
  2695. MenuItem.OnClick := miColorClick;
  2696. MenuItem.Enabled := MenuItem.Tag <> FWindowColor;
  2697. MenuItem.Checked := MenuItem.Tag = FWindowColor;
  2698. if MenuItem.Checked then
  2699. MenuItem.ImageIndex := -1;
  2700. ppColors.Items.Insert(0, MenuItem);
  2701. end;
  2702. finally
  2703. Bitmap.Free;
  2704. end;
  2705. end;
  2706. //------------------------------------------------------------------------------
  2707. procedure TTalkingForm.ppForDownGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2708. begin
  2709. ChangePopupActionBarColor(ppForDown);
  2710. end;
  2711. procedure TTalkingForm.ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2712. begin
  2713. ChangePopupActionBarColor(ppForInputer);
  2714. end;
  2715. procedure TTalkingForm.ppForInputerImgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2716. begin
  2717. ChangePopupActionBarColor(ppForInputerImg);
  2718. end;
  2719. procedure TTalkingForm.ppForInputerImgPopup(Sender: TObject);
  2720. begin
  2721. ppForInputerImg.Tag := 1;
  2722. end;
  2723. procedure TTalkingForm.ppForMsgGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2724. begin
  2725. ChangePopupActionBarColor(ppForMsg);
  2726. end;
  2727. procedure TTalkingForm.ppForSnapGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2728. begin
  2729. ChangePopupActionBarColor(ppForSnap);
  2730. end;
  2731. procedure TTalkingForm.ppForTeamMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2732. begin
  2733. ChangePopupActionBarColor(ppForTeamMenu);
  2734. end;
  2735. procedure TTalkingForm.ppForTeamMenuPopup(Sender: TObject);
  2736. begin
  2737. ppForTeamMenu.Items[1].Enabled := HasMobilePhone(ALoginName);
  2738. end;
  2739. //------------------------------------------------------------------------------
  2740. procedure TTalkingForm.ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2741. begin
  2742. ChangePopupActionBarColor(ppForWebBrowser);
  2743. if WebBrowser.OleObject.Document.queryCommandEnabled('Copy') then
  2744. miCopyFromIE.Enabled := True
  2745. else
  2746. miCopyFromIE.Enabled := False;
  2747. miSaveToWeb.Enabled := miCopyFromIE.Enabled;
  2748. if not miCopyFromIE.Enabled then
  2749. miCopyFromIE.Enabled := actSaveImgAs.Enabled;
  2750. end;
  2751. procedure TTalkingForm.ppForWebBrowserPopup(Sender: TObject);
  2752. begin
  2753. ppForInputerImg.Tag := 0;
  2754. end;
  2755. //------------------------------------------------------------------------------
  2756. procedure TTalkingForm.ppMyOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2757. begin
  2758. ChangePopupActionBarColor(ppMyOptions);
  2759. end;
  2760. //------------------------------------------------------------------------------
  2761. procedure TTalkingForm.ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2762. begin
  2763. ChangePopupActionBarColor(ppUserItemRightMenu);
  2764. end;
  2765. //------------------------------------------------------------------------------
  2766. procedure TTalkingForm.ppUserItemRightMenuPopup(Sender: TObject);
  2767. var
  2768. iLoop: Integer;
  2769. ListItem: TRealICQContacterListItem;
  2770. begin
  2771. miSendMessage.Visible := FLVTeamMembers.SelCount = 1;
  2772. miSeeUserInformation.Visible := FLVTeamMembers.SelCount = 1;
  2773. for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do
  2774. begin
  2775. ListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem;
  2776. if ListItem.Selected then
  2777. begin
  2778. ALoginName := ListItem.LoginName;
  2779. ppUserItemRightMenu.Items[1].Enabled := HasMobilePhone(ALoginName);
  2780. Break;
  2781. end;
  2782. end;
  2783. if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
  2784. begin
  2785. ppUserItemRightMenu.Items[4].Enabled := True;
  2786. end
  2787. else
  2788. ppUserItemRightMenu.Items[4].Enabled := False;
  2789. if MainForm.RealICQClient.LoginName = ALoginName then
  2790. ppUserItemRightMenu.Items[4].Enabled := True;
  2791. end;
  2792. //------------------------------------------------------------------------------
  2793. procedure TTalkingForm.ppYourOptionsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2794. begin
  2795. ChangePopupActionBarColor(ppYourOptions);
  2796. end;
  2797. procedure TTalkingForm.ppForSetGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
  2798. begin
  2799. ChangePopupActionBarColor(ppForSet);
  2800. end;
  2801. //------------------------------------------------------------------------------
  2802. function TTalkingForm.GetInputerLength: Integer;
  2803. var
  2804. Face: TFace;
  2805. iLoop, InputerLength: Integer;
  2806. FaceInRichEdit: TFaceInRichEdit;
  2807. FaceIndexes: TIndexes;
  2808. begin
  2809. InputerLength := Length(Trim(RichEdInputer.Text));
  2810. FaceIndexes := RichEdInputer.GetFaceIndexes;
  2811. for iLoop := 0 to Length(FaceIndexes) - 1 do
  2812. begin
  2813. FaceInRichEdit := FaceIndexes[iLoop];
  2814. if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
  2815. Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
  2816. else
  2817. Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
  2818. if FaceInRichEdit.FaceIndex < MainForm.SystemFaceCount then
  2819. Inc(InputerLength, Length(Face.ShortCut))
  2820. else
  2821. Inc(InputerLength, 38);
  2822. end;
  2823. Result := InputerLength;
  2824. end;
  2825. //------------------------------------------------------------------------------
  2826. procedure TTalkingForm.CreateTeamResult(Sender: TObject; ATeamCaption: string; ACreated: Boolean; ATeamID: string; AFailingCause: string);
  2827. begin
  2828. if ACreated then
  2829. begin
  2830. tsYourCardShow(nil);
  2831. FCategory := tcTeam;
  2832. TeamID := ATeamID;
  2833. end;
  2834. end;
  2835. procedure TTalkingForm.actSaveImgAsExecute(Sender: TObject);
  2836. var
  2837. Face: TFace;
  2838. begin
  2839. if ppForInputerImg.Tag = 1 then
  2840. begin
  2841. if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
  2842. Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace
  2843. else
  2844. Face := MainForm.FaceList.Objects[FRightMouseClickedFace.FaceIndex] as TFace;
  2845. SaveDialog.FileName := AnsiReplaceText(Face.FileName, ExtractFilePath(Face.FileName), '');
  2846. if SaveDialog.Execute then
  2847. begin
  2848. CopyFile(PChar(Face.FileName), PChar(SaveDialog.FileName), False);
  2849. end;
  2850. end
  2851. else
  2852. begin
  2853. SaveDialog.FileName := AnsiReplaceText(FFaceMenuAtFileName, ExtractFilePath(FFaceMenuAtFileName), '');
  2854. if SaveDialog.Execute then
  2855. begin
  2856. CopyFile(PChar(FFaceMenuAtFileName), PChar(SaveDialog.FileName), False);
  2857. end;
  2858. end;
  2859. end;
  2860. procedure TTalkingForm.actAddImageToCustomFacesExecute(Sender: TObject);
  2861. var
  2862. Face: TFace;
  2863. begin
  2864. if ppForInputerImg.Tag = 1 then
  2865. begin
  2866. if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
  2867. begin
  2868. Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace;
  2869. end
  2870. else
  2871. begin
  2872. MessageBox(Handle, '图片已在表情库中! ', '提示', MB_OK);
  2873. Exit;
  2874. end;
  2875. if AddFaceForm <> nil then
  2876. Exit;
  2877. AddFaceForm := TAddFaceForm.Create(Self);
  2878. with AddFaceForm do
  2879. try
  2880. OpenPictureDialog.FileName := Face.FileName;
  2881. edFileNames.Text := Face.FileName;
  2882. SelectedFileCount := 1;
  2883. edName.Text := ReplaceStr(ExtractFileName(edFileNames.Text), ExtractFileExt(edFileNames.Text), '');
  2884. edShortCut.Text := Copy(edName.Text, 1, 8);
  2885. btBrowse.Enabled := False;
  2886. if ShowModal = mrOK then
  2887. begin
  2888. Face := AddFaceForm.AddedFaces[0] as TFace;
  2889. if Face = nil then
  2890. Exit;
  2891. if MainForm.FaceCategory.IndexOf(Face.Category) < 0 then
  2892. begin
  2893. if not AnsiSameText(Face.Category, NOFaceCategory) then
  2894. begin
  2895. MainForm.FaceCategory.Add(Face.Category);
  2896. end
  2897. else
  2898. begin
  2899. MainForm.FaceCategory.Insert(0, Face.Category);
  2900. end;
  2901. end;
  2902. MainForm.SaveCustomFaceConfig;
  2903. MessageBox(Handle, '表情添加成功! ', '提示', MB_ICONINFORMATION);
  2904. end;
  2905. finally
  2906. FreeAndNil(AddFaceForm);
  2907. end;
  2908. end
  2909. else
  2910. begin
  2911. if AddFaceForm <> nil then
  2912. Exit;
  2913. AddFaceForm := TAddFaceForm.Create(Self);
  2914. with AddFaceForm do
  2915. try
  2916. OpenPictureDialog.FileName := FFaceMenuAtFileName;
  2917. edFileNames.Text := FFaceMenuAtFileName;
  2918. SelectedFileCount := 1;
  2919. edName.Text := ReplaceStr(ExtractFileName(edFileNames.Text), ExtractFileExt(edFileNames.Text), '');
  2920. edShortCut.Text := Copy(edName.Text, 1, 8);
  2921. btBrowse.Enabled := False;
  2922. if ShowModal = mrOK then
  2923. begin
  2924. Face := AddFaceForm.AddedFaces[0] as TFace;
  2925. if Face = nil then
  2926. Exit;
  2927. if MainForm.FaceCategory.IndexOf(Face.Category) < 0 then
  2928. begin
  2929. if not AnsiSameText(Face.Category, NOFaceCategory) then
  2930. begin
  2931. MainForm.FaceCategory.Add(Face.Category);
  2932. end
  2933. else
  2934. begin
  2935. MainForm.FaceCategory.Insert(0, Face.Category);
  2936. end;
  2937. end;
  2938. MainForm.SaveCustomFaceConfig;
  2939. MessageBox(Handle, '表情添加成功! ', '提示', MB_ICONINFORMATION);
  2940. end;
  2941. finally
  2942. FreeAndNil(AddFaceForm);
  2943. end;
  2944. end;
  2945. end;
  2946. procedure TTalkingForm.actAddUserExecute(Sender: TObject);
  2947. var
  2948. AddUserForm: TAddUserForm;
  2949. AddedUsers: TStringList;
  2950. iIndex, iLoop: Integer;
  2951. LoginName: string;
  2952. NotCompletedMission: Integer;
  2953. begin
  2954. if FCategory <> tcNormal then
  2955. begin
  2956. if not TTeamsAdapter.IsTeamManager(FTeamID, FRealICQClient.LoginName) then
  2957. begin
  2958. MessageBox(Handle, PChar('没有添加群组成员的权限!'), '提示', MB_ICONINFORMATION);
  2959. Exit;
  2960. end;
  2961. end;
  2962. NotCompletedMission := CheckNotCompletedMission;
  2963. if NotCompletedMission > 0 then
  2964. begin
  2965. MessageBox(Handle, PChar('当前还有 ' + IntToStr(NotCompletedMission) + ' 个未结束的任务! '), '提示', MB_ICONINFORMATION);
  2966. Exit;
  2967. end;
  2968. AddUserForm := TAddUserForm.Create(Self);
  2969. try
  2970. if AddUserForm.ShowModal = mrOk then
  2971. begin
  2972. AddedUsers := AddUserForm.AddedUsers;
  2973. try
  2974. if AddedUsers.Count = 0 then
  2975. Exit;
  2976. if FCategory = tcNormal then
  2977. begin
  2978. AddedUsers.Insert(0, FRealICQClient.LoginName);
  2979. if AddedUsers.IndexOf(FReceiver) = -1 then
  2980. AddedUsers.Insert(1, FReceiver);
  2981. if AddedUsers.Count > MaxTeamMemberCount then
  2982. begin
  2983. MessageBox(Handle, PChar('该群组成员人数不能超过 ' + IntToStr(MaxTeamMemberCount) + ' 人! '), '提示', MB_ICONINFORMATION);
  2984. Exit;
  2985. end;
  2986. FRealICQClient.OnCreateTeamResult := CreateTeamResult;
  2987. FRealICQClient.CreateTeam('多人对话', '', '', AddedUsers, True, tvAllCanJoinTeam);
  2988. end
  2989. else
  2990. begin
  2991. for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
  2992. begin
  2993. LoginName := FLVTeamMembers.Items[iLoop];
  2994. if AddedUsers.IndexOf(LoginName) = -1 then
  2995. AddedUsers.Insert(0, LoginName);
  2996. end;
  2997. if AddedUsers.Count > MaxTeamMemberCount then
  2998. begin
  2999. MessageBox(Handle, PChar('该群组成员人数不能超过 ' + IntToStr(MaxTeamMemberCount) + ' 人! '), '提示', MB_ICONINFORMATION);
  3000. Exit;
  3001. end;
  3002. TTeamsAdapter.AddTeamMembers(FTeamID, AddedUsers);
  3003. end;
  3004. finally
  3005. FreeAndNil(AddedUsers);
  3006. end;
  3007. end;
  3008. finally
  3009. FreeAndNil(AddUserForm);
  3010. end;
  3011. end;
  3012. //------------------------------------------------------------------------------
  3013. procedure TTalkingForm.actEmptyWebExecute(Sender: TObject);
  3014. begin
  3015. ClearHTML(self.WebBrowser);
  3016. end;
  3017. //------------------------------------------------------------------------------
  3018. procedure TTalkingForm.actAlwayOnTopExecute(Sender: TObject);
  3019. var
  3020. iLoop: Integer;
  3021. AForm: TTalkingForm;
  3022. begin
  3023. // actAlwayOnTop.Checked := not actAlwayOnTop.Checked;
  3024. // MainForm.TalkingFormAlwaysOnTop := actAlwayOnTop.Checked;
  3025. //
  3026. // for iLoop := TalkingForms.Count - 1 downto 0 do
  3027. // begin
  3028. // AForm := TalkingForms[iLoop];
  3029. // AForm.actAlwayOnTop.Checked := actAlwayOnTop.Checked;
  3030. // if actAlwayOnTop.Checked then
  3031. // AForm.FormStyle := fsStayOnTop
  3032. // else
  3033. // AForm.FormStyle := fsStayOnTop;
  3034. // end;
  3035. end;
  3036. //------------------------------------------------------------------------------
  3037. procedure TTalkingForm.actAudioExecute(Sender: TObject);
  3038. begin
  3039. if FAudioMission <> nil then
  3040. begin
  3041. MessageBox(Handle, '请先结束已连接的语音对话任务! ', '提示', MB_ICONINFORMATION);
  3042. Exit;
  3043. end;
  3044. FRealICQClient.CreateAudioTransmitter(Receiver);
  3045. end;
  3046. //------------------------------------------------------------------------------
  3047. procedure TTalkingForm.actVideoExecute(Sender: TObject);
  3048. begin
  3049. if FVideoMission <> nil then
  3050. begin
  3051. MessageBox(Handle, '请先结束已连接的视频对话任务! ', '提示', MB_ICONINFORMATION);
  3052. Exit;
  3053. end;
  3054. FRealICQClient.CreateVideoTransmitter(Receiver);
  3055. end;
  3056. procedure TTalkingForm.actCloseExecute(Sender: TObject);
  3057. begin
  3058. Close;
  3059. end;
  3060. procedure TTalkingForm.actCopyScreenHideFormExecute(Sender: TObject);
  3061. begin
  3062. actCopyScreenHideForm.Checked := not actCopyScreenHideForm.Checked;
  3063. MainForm.CopyScreenHideTalkForm := actCopyScreenHideForm.Checked;
  3064. end;
  3065. //------------------------------------------------------------------------------
  3066. procedure TTalkingForm.actCtrlEnterExecute(Sender: TObject);
  3067. begin
  3068. actCtrlEnter.Checked := True;
  3069. MainForm.CtrlEnterSendMessage := True;
  3070. end;
  3071. //------------------------------------------------------------------------------
  3072. procedure TTalkingForm.actEnterExecute(Sender: TObject);
  3073. begin
  3074. actEnter.Checked := True;
  3075. MainForm.CtrlEnterSendMessage := False;
  3076. end;
  3077. //------------------------------------------------------------------------------
  3078. procedure TTalkingForm.actPageSetExecute(Sender: TObject);
  3079. begin
  3080. WebBrowser.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
  3081. end;
  3082. //------------------------------------------------------------------------------
  3083. procedure TTalkingForm.actPreviewExecute(Sender: TObject);
  3084. begin
  3085. if WebBrowser.QueryStatusWB(OLECMDID_PRINTPREVIEW) = 3 then
  3086. WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
  3087. end;
  3088. //------------------------------------------------------------------------------
  3089. procedure TTalkingForm.actPrintExecute(Sender: TObject);
  3090. begin
  3091. WebBrowser.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
  3092. end;
  3093. //------------------------------------------------------------------------------
  3094. procedure TTalkingForm.actQuitTeamExecute(Sender: TObject);
  3095. begin
  3096. if MessageBox(Handle, PChar('确定要退出“' + Caption + '”吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) = ID_OK then
  3097. begin
  3098. TTeamsAdapter.QuitTeam(FTeamID);
  3099. FCategory := tcNormal;
  3100. Close;
  3101. end;
  3102. end;
  3103. //------------------------------------------------------------------------------
  3104. procedure TTalkingForm.actDisbandTeamExecute(Sender: TObject);
  3105. begin
  3106. if MessageBox(Handle, PChar('确定要解散“' + Caption + '”吗? '), '提示', MB_ICONQUESTION or MB_OKCANCEL) = ID_OK then
  3107. begin
  3108. TTeamsAdapter.DisbandTeam(FTeamID);
  3109. FCategory := tcNormal;
  3110. Close;
  3111. end;
  3112. end;
  3113. //------------------------------------------------------------------------------
  3114. procedure TTalkingForm.actSaveAsHTMLFileExecute(Sender: TObject);
  3115. var
  3116. StringList: TStringList;
  3117. begin
  3118. SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd', Now()) + '.Html';
  3119. if SaveDialog.Execute then
  3120. begin
  3121. StringList := TStringList.Create;
  3122. try
  3123. StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.innerHTML);
  3124. StringList.SaveToFile(SaveDialog.FileName);
  3125. finally
  3126. StringList.Free;
  3127. end;
  3128. end;
  3129. end;
  3130. //------------------------------------------------------------------------------
  3131. procedure TTalkingForm.actSaveAsTextFileExecute(Sender: TObject);
  3132. var
  3133. StringList: TStringList;
  3134. begin
  3135. SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd', Now()) + '.txt';
  3136. if SaveDialog.Execute then
  3137. begin
  3138. StringList := TStringList.Create;
  3139. try
  3140. StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.OuterText);
  3141. StringList.SaveToFile(SaveDialog.FileName);
  3142. finally
  3143. StringList.Free;
  3144. end;
  3145. end;
  3146. end;
  3147. //------------------------------------------------------------------------------
  3148. procedure TTalkingForm.actSeeTeamOptionsExecute(Sender: TObject);
  3149. begin
  3150. miSeeTeamDetailInformation.Click;
  3151. end;
  3152. //------------------------------------------------------------------------------
  3153. procedure TTalkingForm.actSendFileExecute(Sender: TObject);
  3154. begin
  3155. if not FRealICQClient.Connected or not FRealICQClient.Logined then
  3156. Exit;
  3157. OpenDialog.Title := '传输在线文件';
  3158. if OpenDialog.Execute then
  3159. begin
  3160. SendFile(OpenDialog.FileName);
  3161. end;
  3162. end;
  3163. //----发送文件-----------------------------------------------------------------
  3164. procedure TTalkingForm.SendFile(FileName: string);
  3165. //var
  3166. // AFileStream: TFileStream;
  3167. begin
  3168. try
  3169. {try
  3170. AFileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  3171. if AFileStream.Size>=Int64(1024*1024*1024)*2 then
  3172. begin
  3173. MessageBox(0, PChar('在线发送文件大小不允许超过2G !'), '发送文件时出错', MB_ICONINFORMATION);
  3174. PostMessage(Handle, WM_SETFOCUS, 0, 0);
  3175. Exit;
  3176. end;
  3177. finally
  3178. FreeAndNil(AFileStream);
  3179. end;}
  3180. FRealICQClient.SendFile(MainForm.UseCacheDir, MainForm.CacheDir, Receiver, FileName, foFile);
  3181. except
  3182. on E: Exception do
  3183. MessageBox(0, PChar(E.Message), '传输文件时出错', MB_ICONINFORMATION);
  3184. end;
  3185. end;
  3186. //------------------------------------------------------------------------------
  3187. procedure TTalkingForm.actShowHistoryExecute(Sender: TObject);
  3188. begin
  3189. MainForm.OpenMessagesManagerForm;
  3190. Application.ProcessMessages;
  3191. if FCategory = tcNormal then
  3192. MessagesManagerForm.ShowUsersMessages(FReceiver)
  3193. else
  3194. MessagesManagerForm.ShowTeamsMessages(FTeamID);
  3195. end;
  3196. //------------------------------------------------------------------------------
  3197. procedure TTalkingForm.actStopVideoExecute(Sender: TObject);
  3198. begin
  3199. if FVideoMission <> nil then
  3200. FVideoMission.Stop;
  3201. end;
  3202. //------------------------------------------------------------------------------
  3203. procedure TTalkingForm.ApplicationEventsException(Sender: TObject; E: Exception);
  3204. begin
  3205. //
  3206. end;
  3207. //------------------------------------------------------------------------------
  3208. procedure TTalkingForm.spbSendImageClick(Sender: TObject);
  3209. var
  3210. AFileName: string;
  3211. begin
  3212. try
  3213. if OpenPictureDialog.Execute then
  3214. begin
  3215. AFileName := OpenPictureDialog.FileName;
  3216. AddImageToInput(AFileName, RichEdInputer);
  3217. end;
  3218. except
  3219. on E: Exception do
  3220. MessageBox(Handle, PChar('发送图片出错:' + E.Message), PChar('错误'), MB_ICONERROR);
  3221. end;
  3222. end;
  3223. procedure TTalkingForm.spbSendSMSClick(Sender: TObject);
  3224. begin
  3225. if (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) or (not MainForm.RealICQClient.UserPermission.EnableSendSms) then
  3226. begin
  3227. Dialogs.ShowMessage('您没有群发手机短信的权限! ');
  3228. Exit;
  3229. end;
  3230. OpenTeamSMSForm(self.TeamID);
  3231. end;
  3232. //------------------------------------------------------------------------------
  3233. procedure TTalkingForm.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
  3234. var
  3235. vaIn, vaOut: Olevariant;
  3236. begin
  3237. if IsChild(Webbrowser.Handle, Msg.hwnd) or (IsChild(Self.WebBrowserForTeamDisk.Handle, Msg.hwnd)) then
  3238. begin
  3239. if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then
  3240. begin
  3241. if msg.wParam = VK_F5 then
  3242. begin
  3243. Handled := True;
  3244. end;
  3245. end;
  3246. if (msg.wParam = ord('N')) and (GetKeyState(VK_CONTROL) < 0) then
  3247. begin
  3248. Handled := True;
  3249. end;
  3250. if (msg.wParam = ord('C')) and (GetKeyState(VK_CONTROL) < 0) then
  3251. begin
  3252. InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  3253. Handled := True;
  3254. end;
  3255. end;
  3256. if RichEdInputer.Handle = Msg.hwnd then
  3257. begin
  3258. if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then
  3259. begin
  3260. if (msg.wParam = 13) then
  3261. begin
  3262. if (not MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) < 0) then
  3263. Exit;
  3264. if (MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) >= 0) then
  3265. Exit;
  3266. btSendClick(nil);
  3267. Handled := True;
  3268. end;
  3269. //Ctrl + V
  3270. if (msg.wParam = 86) and (GetKeyState(VK_CONTROL) < 0) then
  3271. begin
  3272. LockWindowUpdate(GetDesktopWindow);
  3273. try
  3274. if not PasteImage then
  3275. RichEdInputer.PasteFromClipboard;
  3276. CheckPastedContent;
  3277. finally
  3278. LockWindowUpdate(0);
  3279. end;
  3280. Handled := True;
  3281. end;
  3282. end;
  3283. end;
  3284. end;
  3285. procedure TTalkingForm.EditPasteExecute(Sender: TObject);
  3286. //var handle:HWND;
  3287. begin
  3288. // handle:=GetFocus;
  3289. // SendMessage(handle, WM_SetText, 255, Integer(Pchar(Clipboard.AsText)));
  3290. // if (RichEdInputer.Handle<>handle) then Exit;
  3291. LockWindowUpdate(GetDesktopWindow);
  3292. try
  3293. try
  3294. if not PasteImage then
  3295. RichEdInputer.PasteFromClipboard;
  3296. except
  3297. RichEdInputer.PasteFromClipboard;
  3298. end;
  3299. CheckPastedContent;
  3300. finally
  3301. LockWindowUpdate(0);
  3302. end;
  3303. end;
  3304. procedure TTalkingForm.EditPasteUpdate(Sender: TObject);
  3305. var
  3306. CF_HTML: DWORD;
  3307. begin
  3308. CF_HTML := RegisterClipboardFormat('HTML Format');
  3309. 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);
  3310. end;
  3311. //------------------------------------------------------------------------------
  3312. procedure TTalkingForm.CheckPastedContent(ADeleteOtherObj: Boolean = False);
  3313. var
  3314. AIndexes: TIndexes;
  3315. AFaceInRichEdit: TFaceInRichEdit;
  3316. AOldSelStart: Integer;
  3317. iLoop: Integer;
  3318. APastedToTemp: Boolean;
  3319. begin
  3320. RichEditTemp.Clear;
  3321. APastedToTemp := False;
  3322. AOldSelStart := RichEdInputer.SelStart;
  3323. AIndexes := RichEdInputer.GetFaceIndexes;
  3324. try
  3325. for iLoop := 0 to High(AIndexes) do
  3326. begin
  3327. AFaceInRichEdit := AIndexes[iLoop];
  3328. if AFaceInRichEdit.FaceIndex < 0 then
  3329. begin
  3330. if ADeleteOtherObj then
  3331. begin
  3332. RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
  3333. RichEdInputer.SelLength := 1;
  3334. RichEdInputer.SelText := '';
  3335. end
  3336. else
  3337. begin
  3338. if not APastedToTemp then
  3339. begin
  3340. RichEditTemp.PasteFromClipboard;
  3341. APastedToTemp := True;
  3342. end;
  3343. RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
  3344. RichEdInputer.SelLength := 1;
  3345. RichEdInputer.CutToClipboard;
  3346. PasteImage(False);
  3347. end;
  3348. end;
  3349. end;
  3350. finally
  3351. if not ADeleteOtherObj then
  3352. begin
  3353. RichEdInputer.SelStart := AOldSelStart;
  3354. RichEdInputer.SelLength := 0;
  3355. RichEdInputer.Font.Color := RichEdInputer.Font.Color - 1;
  3356. RichEdInputer.Font.Color := RichEdInputer.Font.Color + 1;
  3357. RichEdInputer.DisableAlign;
  3358. try
  3359. PostMessage(RichEdInputer.Handle, WM_SIZE, 0, 0);
  3360. finally
  3361. RichEdInputer.EnableAlign;
  3362. end;
  3363. if APastedToTemp then
  3364. begin
  3365. RichEditTemp.SelectAll;
  3366. RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
  3367. RichEditTemp.CutToClipboard;
  3368. end;
  3369. end;
  3370. end;
  3371. end;
  3372. //------------------------------------------------------------------------------
  3373. function TTalkingForm.FindIECacheImage(ADir, AImageFile: string): string;
  3374. var
  3375. DSearchRec: TSearchRec;
  3376. FindResult: Integer;
  3377. AFileName: string;
  3378. AFileTime, AFileTimeTemp: TDateTime;
  3379. begin
  3380. AFileTime := 0.0;
  3381. Result := '';
  3382. FindResult := FindFirst(ADir + '\' + Format('%s[*]%s', [ReplaceText(AImageFile, ExtractFileExt(AImageFile), ''), ExtractFileExt(AImageFile)]), faAnyFile, DSearchRec);
  3383. while FindResult = 0 do
  3384. begin
  3385. if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
  3386. begin
  3387. AFileName := ADir + '\' + ExtractFileName(DSearchRec.Name);
  3388. //找出最新的文件
  3389. AFileTimeTemp := RealICQUtils.GetFileTime(AFileName, 3);
  3390. if AFileTimeTemp > AFileTime then
  3391. begin
  3392. AFileTime := AFileTimeTemp;
  3393. Result := AFileName;
  3394. end;
  3395. end;
  3396. FindResult := FindNext(DSearchRec);
  3397. end;
  3398. if Result <> '' then
  3399. Exit;
  3400. FindResult := FindFirst(ADir + '\*.*', $00002016, DSearchRec);
  3401. while FindResult = 0 do
  3402. begin
  3403. if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
  3404. begin
  3405. if DirectoryExists(ADir + '\' + ExtractFileName(DSearchRec.Name)) then
  3406. begin
  3407. Result := FindIECacheImage(ADir + '\' + ExtractFileName(DSearchRec.Name), AImageFile);
  3408. if Result <> '' then
  3409. Exit;
  3410. end;
  3411. end;
  3412. FindResult := FindNext(DSearchRec);
  3413. end;
  3414. end;
  3415. function TTalkingForm.CheckImageExists(AImageFile: string): string;
  3416. var
  3417. dwCacheEntryInfoBufferSize: DWORD;
  3418. lpCacheEntryInfo: PInternetCacheEntryInfoA;
  3419. ALocalFile, ALocalFileTemp: string;
  3420. ASplitString: TStringList;
  3421. iIndex: Integer;
  3422. begin
  3423. Result := '';
  3424. dwCacheEntryInfoBufferSize := 0;
  3425. lpCacheEntryInfo := nil;
  3426. GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0);
  3427. GetMem(lpCacheEntryInfo, dwCacheEntryInfoBufferSize);
  3428. try
  3429. if GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0) then
  3430. begin
  3431. Result := StrPas(lpCacheEntryInfo.lpszLocalFileName);
  3432. Exit;
  3433. end;
  3434. finally
  3435. FreeMem(lpCacheEntryInfo);
  3436. end;
  3437. ALocalFileTemp := ReplaceStr(AImageFile, '\', '/');
  3438. while Pos('/', ALocalFileTemp) > 0 do
  3439. begin
  3440. ALocalFileTemp := Copy(ALocalFileTemp, Pos('/', ALocalFileTemp) + 1, Length(ALocalFileTemp));
  3441. end;
  3442. ALocalFile := FindURLCache(PAnsiChar(GetIETempDir + '\Low\Content.IE5\index.dat'), PAnsiChar(AImageFile));
  3443. if Length(ALocalFile) > 0 then
  3444. begin
  3445. ASplitString := SplitString(ALocalFile, Chr(10));
  3446. AImageFile := GetIETempDir + '\Low\Content.IE5\' + ReplaceStr(ASplitString.Strings[0], '?', '') + '\';
  3447. iIndex := 2;
  3448. repeat
  3449. ALocalFile := AImageFile + LeftStr(ALocalFileTemp, 1) + Copy(ASplitString.Strings[iIndex], 3, Length(ASplitString.Strings[iIndex]) - 2);
  3450. Inc(iIndex);
  3451. until (FileExists(ALocalFile)) or (iIndex >= 4);
  3452. if FileExists(ALocalFile) then
  3453. begin
  3454. Result := ALocalFile;
  3455. end;
  3456. end;
  3457. {
  3458. ALocalFile := ReplaceStr(AImageFile, '\', '/');
  3459. while Pos('/', ALocalFile) > 0 do
  3460. begin
  3461. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3462. end;
  3463. Result := FindIECacheImage(GetIETempDir + '\Low\Content.IE5', ALocalFile); }
  3464. end;
  3465. //------------------------------------------------------------------------------
  3466. procedure TTalkingForm.RichEdInputerChange(Sender: TObject);
  3467. var
  3468. iLoop, iLength, InputerLength, iStart: Integer;
  3469. Face: TFace;
  3470. FRealICQUser: TRealICQUser;
  3471. begin
  3472. if Length(Trim(Receiver)) = 0 then
  3473. Exit;
  3474. iLength := Length(RichEdInputer.Text);
  3475. //发送“正在输入消息”字样
  3476. if FCategory = tcNormal then
  3477. begin
  3478. if (iLength = 0) or (GetTickCount - FLastSendInputtingMessageTicket > 5000) then
  3479. begin
  3480. if (FRealICQClient.Me <> nil) and (FRealICQClient.Me.LoginState <> stHidden) then
  3481. begin
  3482. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  3483. if Assigned(FRealICQUser) then
  3484. begin
  3485. ((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox) as TRealICQPtoPBox).SendInputting(iLength > 0);
  3486. FLastSendInputtingMessageTicket := GetTickCount;
  3487. end;
  3488. end;
  3489. end;
  3490. end;
  3491. if iLength = 0 then
  3492. Exit;
  3493. RichEdInputer.OnChange := nil;
  3494. try
  3495. for iLoop := 0 to MainForm.FaceList.Count - 1 do
  3496. begin
  3497. Face := MainForm.FaceList.Objects[iLoop] as TFace;
  3498. if Face.ShortCut = '' then
  3499. continue;
  3500. iStart := TRxRichEdit(Sender).FindText(Face.ShortCut, 0, iLength, []);
  3501. while iStart >= 0 do
  3502. begin
  3503. RichEdInputer.SelStart := iStart;
  3504. RichEdInputer.SelLength := Length(Face.ShortCut);
  3505. RichEdInputer.InsertImage(Face.FileName, iLoop);
  3506. RichEdInputer.SelStart := TRxRichEdit(Sender).SelStart;
  3507. RichEdInputer.SelLength := 0;
  3508. iStart := RichEdInputer.FindText(Face.ShortCut, RichEdInputer.SelStart, iLength, []);
  3509. end;
  3510. end;
  3511. finally
  3512. RichEdInputer.OnChange := RichEdInputerChange;
  3513. end;
  3514. RichEdInputer.MaxLength := Length(Trim(RichEdInputer.Text));
  3515. InputerLength := GetInputerLength;
  3516. if MaxMessageLength - InputerLength > 0 then
  3517. RichEdInputer.MaxLength := RichEdInputer.MaxLength + (MaxMessageLength - InputerLength);
  3518. end;
  3519. procedure TTalkingForm.IdHTTPOnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
  3520. begin
  3521. FRidrected := True;
  3522. FRidrectURL := dest;
  3523. end;
  3524. procedure TTalkingForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
  3525. begin
  3526. end;
  3527. procedure TTalkingForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
  3528. begin
  3529. FImageSize := AWorkCountMax;
  3530. //如果重定向或文件大于200k,断开连接(重新从缓存中查找)
  3531. //if (FRidrected) or (FImageSize > 1024 * 300) then
  3532. (ASender as TIdHTTP).Disconnect;
  3533. end;
  3534. procedure TTalkingForm.IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  3535. begin
  3536. end;
  3537. procedure TTalkingForm.spbUploadTeamFileClick(Sender: TObject);
  3538. var
  3539. UpUrl: string;
  3540. AFileSize: int64;
  3541. begin
  3542. if (FRealICQClient.Connected) and (FRealICQClient.Logined) then
  3543. if OpenDialog.Execute then
  3544. begin
  3545. TTeamShareAdapter.UploadFile(TeamID, OpenDialog.FileName, Self, FRealICQClient, False);
  3546. end;
  3547. end;
  3548. function TTalkingForm.ReAlighHTMLContent(ABaseURL: string): Boolean;
  3549. var
  3550. StrContent, imgBBURL, imgURL, ALocalFile, ALocalFile1, AFileExt, ABaseURLTop, AHttpStart: string;
  3551. iIndex1, iIndex2: Integer;
  3552. PngObject: TPngObject;
  3553. BMP: TBitmap;
  3554. AFinded: Boolean;
  3555. FIdHTTP: TIdHTTP;
  3556. FileStream: TFileStream;
  3557. begin
  3558. Result := False;
  3559. StrContent := RichEditTemp.Text;
  3560. iIndex1 := Pos('[img]', StrContent);
  3561. iIndex2 := Pos('[/img]', StrContent);
  3562. while (iIndex1 > 0) and (iIndex2 > 0) and (iIndex2 > iIndex1) do
  3563. begin
  3564. imgBBURL := Copy(StrContent, iIndex1, iIndex2 - iIndex1 + 6);
  3565. imgURL := Copy(imgBBURL, 6, iIndex2 - iIndex1 - 5);
  3566. RichEditTemp.SelStart := RichEditTemp.FindText(imgBBURL, 0, Length(StrContent), []);
  3567. RichEditTemp.SelLength := Length(WideString(imgBBURL));
  3568. ;
  3569. RichEditTemp.SelText := '';
  3570. ImgURL := ReplaceStr(ImgURL, '\', '/');
  3571. if Pos('http://', ImgURL) = 1 then
  3572. begin
  3573. end
  3574. else if Pos('https://', ImgURL) = 1 then
  3575. begin
  3576. end
  3577. else if Pos('/', ImgURL) = 1 then
  3578. begin
  3579. AHttpStart := Copy(ABaseURL, 1, Pos('://', ABaseURL) + 2);
  3580. ABaseURLTop := Copy(ABaseURL, Length(AHttpStart) + 1, Length(ABaseURL));
  3581. ABaseURLTop := Copy(ABaseURLTop, 1, Pos('/', ABaseURLTop) - 1);
  3582. ImgURL := AHttpStart + ABaseURLTop + ImgURL;
  3583. end
  3584. else
  3585. begin
  3586. ALocalFile := ReplaceStr(ABaseURL, '\', '/');
  3587. while Pos('/', ALocalFile) > 0 do
  3588. begin
  3589. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3590. end;
  3591. ImgURL := ReplaceStr(ABaseURL, ALocalFile, '') + ImgURL;
  3592. end;
  3593. ALocalFile := ReplaceStr(ImgURL, '\', '/');
  3594. while Pos('/', ALocalFile) > 0 do
  3595. begin
  3596. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3597. end;
  3598. AFileExt := ExtractFileExt(ALocalFile);
  3599. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  3600. begin
  3601. AFinded := False;
  3602. if AnsiSameText(Copy(ImgURL, 1, 8), 'file:///') then
  3603. begin
  3604. ImgURL := Copy(ImgURL, 9, Length(ImgURL) - 8);
  3605. AFinded := FileExists(ImgURL);
  3606. ALocalFile := ImgURL;
  3607. end
  3608. else
  3609. begin
  3610. ALocalFile1 := CheckImageExists(ImgURL);
  3611. if FileExists(ALocalFile1) then
  3612. begin
  3613. ALocalFile := ALocalFile1;
  3614. AFinded := True;
  3615. end
  3616. else
  3617. begin
  3618. {$region '检查是否有重定向'}
  3619. FRidrected := False;
  3620. FRidrectURL := '';
  3621. FImageSize := 0;
  3622. ALocalFile1 := MainForm.RealICQClient.GetCacheFaceDir + IntToStr(GetTickCount) + '_' + ALocalFile;
  3623. FIdHTTP := TIdHTTP.Create(nil);
  3624. try
  3625. FIdHTTP.ConnectTimeout := 1500;
  3626. FIdHTTP.ReadTimeout := 2000;
  3627. FIdHTTP.OnWork := IdHTTPWork;
  3628. FIdHTTP.OnWorkBegin := IdHTTPWorkBegin;
  3629. FIdHTTP.OnWorkEnd := IdHTTPWorkEnd;
  3630. FIdHTTP.OnRedirect := IdHTTPOnRedirect;
  3631. try
  3632. FileStream := TFileStream.Create(ALocalFile1, fmCreate, fmShareDenyNone);
  3633. try
  3634. FIdHTTP.Get(FIdHTTP.URL.URLEncode(ImgURL), FileStream);
  3635. ALocalFile := ALocalFile1;
  3636. AFinded := True;
  3637. finally
  3638. FileStream.Free;
  3639. end;
  3640. except
  3641. on E: Exception do
  3642. begin
  3643. DeleteFile(ALocalFile1);
  3644. end;
  3645. end;
  3646. finally
  3647. FreeAndNil(FIdHTTP);
  3648. end;
  3649. if FRidrected then
  3650. begin
  3651. FRidrectURL := ReplaceStr(FRidrectURL, '\', '/');
  3652. ImgURL := ReplaceStr(ImgURL, '\', '/');
  3653. if Pos('http://', FRidrectURL) = 1 then
  3654. ImgURL := FRidrectURL
  3655. else if Pos('https://', FRidrectURL) = 1 then
  3656. ImgURL := FRidrectURL
  3657. else if Pos('/', FRidrectURL) = 1 then
  3658. begin
  3659. AHttpStart := Copy(ImgURL, 1, Pos('://', ImgURL) + 2);
  3660. ImgURL := Copy(ImgURL, Length(AHttpStart) + 1, Length(ImgURL));
  3661. ImgURL := Copy(ImgURL, 1, Pos('/', ImgURL) - 1);
  3662. ImgURL := AHttpStart + ImgURL + FRidrectURL;
  3663. end
  3664. else
  3665. begin
  3666. ImgURL := ReplaceStr(ImgURL, ALocalFile, '') + FRidrectURL;
  3667. end;
  3668. ALocalFile := ReplaceStr(ImgURL, '\', '/');
  3669. while Pos('/', ALocalFile) > 0 do
  3670. begin
  3671. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3672. end;
  3673. AFileExt := ExtractFileExt(ALocalFile);
  3674. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  3675. begin
  3676. ALocalFile1 := CheckImageExists(ImgURL);
  3677. if FileExists(ALocalFile1) then
  3678. begin
  3679. ALocalFile := ALocalFile1;
  3680. AFinded := True;
  3681. end;
  3682. end;
  3683. end;
  3684. {$endregion }
  3685. end;
  3686. end;
  3687. if AFinded then
  3688. begin
  3689. try
  3690. AddImageToInput(ALocalFile, RichEditTemp);
  3691. Result := True;
  3692. except
  3693. on E: Exception do
  3694. begin
  3695. if Pos('JPEG error #53', E.Message) > 0 then
  3696. begin
  3697. MoveFile(PChar(ALocalFile), PChar(ALocalFile + '.gif'));
  3698. try
  3699. AddImageToInput(ALocalFile + '.gif', RichEditTemp);
  3700. Result := True;
  3701. except
  3702. Result := False;
  3703. end;
  3704. end
  3705. else
  3706. begin
  3707. Result := False;
  3708. end;
  3709. end;
  3710. end;
  3711. end;
  3712. end;
  3713. StrContent := RichEditTemp.Text;
  3714. iIndex1 := Pos('[img]', StrContent);
  3715. iIndex2 := Pos('[/img]', StrContent);
  3716. end;
  3717. Application.ProcessMessages;
  3718. Sleep(10);
  3719. Application.ProcessMessages;
  3720. RichEditTemp.SelectAll;
  3721. RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
  3722. RichEditTemp.CopyToClipboard;
  3723. RichEdInputer.PasteFromClipboard;
  3724. RichEditTemp.Clear;
  3725. end;
  3726. function TTalkingForm.GetHTMLUBBCode(AHTML: string; var ABaseURL: string): string;
  3727. var
  3728. iIndex1: Integer;
  3729. StrStartFragment, StrEndFragment: string;
  3730. iStartFragment, iEndFragment: Integer;
  3731. reg: TPerlRegEx;
  3732. ws: string;
  3733. begin
  3734. Result := '';
  3735. iIndex1 := Pos('SourceURL:', AHTML);
  3736. if iIndex1 > 0 then
  3737. begin
  3738. ABaseURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), 100);
  3739. iIndex1 := Pos(#$D, ABaseURL);
  3740. if iIndex1 > 0 then
  3741. begin
  3742. ABaseURL := Copy(ABaseURL, 1, iIndex1 - 1);
  3743. end;
  3744. end;
  3745. iIndex1 := Pos('StartFragment:', AHTML);
  3746. if iIndex1 = 0 then
  3747. Exit;
  3748. StrStartFragment := Copy(AHTML, iIndex1 + Length('StartFragment:'), 12);
  3749. iIndex1 := Pos(#$D, StrStartFragment);
  3750. if iIndex1 = 0 then
  3751. Exit;
  3752. StrStartFragment := Copy(StrStartFragment, 1, iIndex1 - 1);
  3753. iIndex1 := Pos('EndFragment:', AHTML);
  3754. if iIndex1 = 0 then
  3755. Exit;
  3756. StrEndFragment := Copy(AHTML, iIndex1 + Length('EndFragment:'), 12);
  3757. iIndex1 := Pos(#$D, StrEndFragment);
  3758. if iIndex1 = 0 then
  3759. Exit;
  3760. StrEndFragment := Copy(StrEndFragment, 1, iIndex1 - 1);
  3761. iStartFragment := StrToInt(StrStartFragment);
  3762. iEndFragment := StrToInt(StrEndFragment);
  3763. Result := Copy(AHTML, iStartFragment + 1, iEndFragment - iStartFragment);
  3764. {iIndex1 := Pos('SourceURL:', AHTML);
  3765. if iIndex1 = 0 then Exit;
  3766. StrSourceURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), Length(AHTML));
  3767. StrSourceURL := Copy(StrSourceURL, 1, Pos(#$D#$A, StrSourceURL)); }
  3768. reg := TPerlRegEx.Create;
  3769. reg.Subject := LowerCase(Result);
  3770. reg.RegEx := '聽'; //???????????????????????????????????????
  3771. reg.Replacement := ' ';
  3772. reg.ReplaceAll;
  3773. reg.RegEx := #$D#$A;
  3774. reg.Replacement := '';
  3775. reg.ReplaceAll;
  3776. reg.RegEx := '</p>';
  3777. reg.Replacement := #$D#$A;
  3778. reg.ReplaceAll;
  3779. reg.RegEx := '</div>';
  3780. reg.Replacement := #$D#$A;
  3781. reg.ReplaceAll;
  3782. reg.RegEx := '<br>';
  3783. reg.Replacement := #$D#$A;
  3784. reg.ReplaceAll;
  3785. reg.RegEx := '<script[^>]*?>([\w\W]*?)<\/script>';
  3786. reg.Replacement := '';
  3787. reg.ReplaceAll;
  3788. reg.RegEx := '<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>';
  3789. reg.Replacement := '$2';
  3790. reg.ReplaceAll;
  3791. reg.RegEx := '<img[^>]+src="([^"]+)"[^>]*>';
  3792. reg.Replacement := '[img]$1[/img]';
  3793. reg.ReplaceAll;
  3794. reg.RegEx := '<[^>]*?>';
  3795. reg.Replacement := '';
  3796. reg.ReplaceAll;
  3797. reg.RegEx := '&amp;';
  3798. reg.Replacement := '&';
  3799. reg.ReplaceAll;
  3800. reg.RegEx := '&lt;';
  3801. reg.Replacement := '<';
  3802. reg.ReplaceAll;
  3803. reg.RegEx := '&gt;';
  3804. reg.Replacement := '>';
  3805. reg.ReplaceAll;
  3806. reg.RegEx := '&nbsp;';
  3807. reg.Replacement := ' ';
  3808. reg.ReplaceAll;
  3809. reg.RegEx := '&quot;';
  3810. reg.Replacement := '"';
  3811. reg.ReplaceAll;
  3812. Result := reg.Subject;
  3813. FreeAndNil(reg);
  3814. ws := UTF8Decode(Result);
  3815. while (ws[Length(ws)] = #$A) or (ws[Length(ws)] = #$D) do
  3816. ws := Copy(ws, 1, Length(ws) - 1);
  3817. Result := ws;
  3818. end;
  3819. //------------------------------------------------------------------------------
  3820. function TTalkingForm.PasteImage(AUseTemp: Boolean = True): Boolean;
  3821. var
  3822. //vMetafile: TMetafile;
  3823. Picture: TPicture;
  3824. Bitmap: TBitmap;
  3825. GIF: TGIFImage;
  3826. AFileName: string;
  3827. AFindedImage: Boolean;
  3828. PFileName: PChar;
  3829. DataHandle: Thandle;
  3830. FilesCount: Integer;
  3831. ClipboardText: string;
  3832. iLoop, tabCount, returnCount: Integer;
  3833. AIndexes: TIndexes;
  3834. AFaceInRichEdit: TFaceInRichEdit;
  3835. CF_HTML: DWORD;
  3836. hMem: DWORD;
  3837. pHTML: PChar;
  3838. StrHTML, ABaseURL: string;
  3839. APasted: Boolean;
  3840. begin
  3841. Result := False;
  3842. ClipboardText := Clipboard.AsText;
  3843. if Clipboard.HasFormat(CF_HDROP) and ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
  3844. begin
  3845. // if FCategory = tcTeam then
  3846. // begin
  3847. // Result := True;
  3848. // Exit;
  3849. // end;
  3850. GetMem(PFileName, MAX_PATH + 1);
  3851. DataHandle := Clipboard.GetAsHandle(CF_HDROP);
  3852. FilesCount := DragQueryFile(DataHandle, MAXDWORD, PFileName, MAX_PATH);
  3853. for iLoop := 0 to FilesCount - 1 do
  3854. begin
  3855. if DragQueryFile(DataHandle, iLoop, PFileName, MAX_PATH) > 0 then
  3856. begin
  3857. if DirectoryExists(PFileName) then
  3858. OpenSendFolderForm(PFileName)
  3859. else
  3860. SendDropFile(PFileName);
  3861. end;
  3862. if iLoop > 20 then
  3863. break;
  3864. end;
  3865. FreeMem(PFileName);
  3866. Result := True;
  3867. Exit;
  3868. end;
  3869. tabCount := 0;
  3870. returnCount := 0;
  3871. for iLoop := 1 to Length(ClipboardText) do
  3872. begin
  3873. if ClipboardText[iLoop] = #9 then
  3874. Inc(tabCount);
  3875. if ClipboardText[iLoop] = #13 then
  3876. Inc(returnCount);
  3877. end;
  3878. //粘贴HTML数据
  3879. CF_HTML := RegisterClipboardFormat('HTML Format');
  3880. if Clipboard.HasFormat(CF_HTML) and not ((Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) and (Clipboard.HasFormat(CF_METAFILEPICT))) then
  3881. begin
  3882. Screen.Cursor := crHourGlass;
  3883. try
  3884. hMem := Clipboard.GetAsHandle(CF_HTML);
  3885. pHTML := GlobalLock(hMem);
  3886. StrHTML := StrPas(pHTML);
  3887. GlobalUnlock(hMem);
  3888. ABaseURL := '';
  3889. StrHTML := GetHTMLUBBCode(StrHTML, ABaseURL);
  3890. RichEditTemp.Clear;
  3891. RichEditTemp.Lines.Add(StrHTML);
  3892. APasted := ReAlighHTMLContent(ABaseURL);
  3893. finally
  3894. Screen.Cursor := crDefault;
  3895. end;
  3896. if (not APasted) and (Clipboard.HasFormat(CF_METAFILEPICT) or Clipboard.HasFormat(CF_PICTURE)) then
  3897. begin
  3898. end
  3899. else
  3900. begin
  3901. Result := True;
  3902. Exit;
  3903. end;
  3904. end;
  3905. {$region '先在临时RichEdit中粘贴'}
  3906. if AUseTemp and (Length(ClipboardText) = 0) then
  3907. begin
  3908. RichEditTemp.Clear;
  3909. RichEditTemp.PasteFromClipboard;
  3910. AIndexes := RichEditTemp.GetFaceIndexes;
  3911. if High(AIndexes) = 0 then //只有一个对象
  3912. begin
  3913. AFaceInRichEdit := AIndexes[0];
  3914. if AFaceInRichEdit.FaceIndex > 0 then //已经是表情对象
  3915. begin
  3916. Result := False;
  3917. RichEditTemp.Clear;
  3918. Exit;
  3919. end
  3920. else if ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
  3921. begin
  3922. Result := True;
  3923. RichEditTemp.Clear;
  3924. Exit;
  3925. end;
  3926. end;
  3927. end;
  3928. {$endregion}
  3929. try
  3930. if Clipboard.HasFormat(CF_METAFILEPICT) then
  3931. begin
  3932. if (Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) then
  3933. begin
  3934. AFindedImage := False;
  3935. Bitmap := TBitmap.Create;
  3936. try
  3937. try
  3938. Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
  3939. AFindedImage := True;
  3940. except
  3941. end;
  3942. if AFindedImage then
  3943. begin
  3944. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
  3945. Bitmap.SaveToFile(AFileName);
  3946. end;
  3947. finally
  3948. Bitmap.Free;
  3949. end;
  3950. if AFindedImage then
  3951. begin
  3952. AddImageToInput(AFileName, RichEdInputer);
  3953. DeleteFile(AFileName);
  3954. Result := True;
  3955. Exit;
  3956. end;
  3957. end;
  3958. end;
  3959. if Clipboard.HasFormat(CF_PICTURE) and (Length(Trim(Clipboard.AsText)) = 0) then
  3960. begin
  3961. Picture := TPicture.Create;
  3962. Bitmap := TBitmap.Create;
  3963. try
  3964. Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
  3965. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
  3966. Bitmap.SaveToFile(AFileName);
  3967. finally
  3968. Bitmap.Free;
  3969. Picture.Free;
  3970. end;
  3971. AddImageToInput(AFileName, RichEdInputer);
  3972. DeleteFile(AFileName);
  3973. Result := True;
  3974. Exit;
  3975. end;
  3976. except
  3977. on E: Exception do
  3978. Error(E.Message, 'TTalkingForm.PasteImage');
  3979. end;
  3980. end;
  3981. //------------------------------------------------------------------------------
  3982. procedure TTalkingForm.btCloseClick(Sender: TObject);
  3983. begin
  3984. if Assigned(FRemoteControlMission) then
  3985. FRemoteControlMission.Stop;
  3986. end;
  3987. procedure TTalkingForm.btCloseTalkClick(Sender: TObject);
  3988. var
  3989. source, target: string;
  3990. AUser: TRealICQUser;
  3991. begin
  3992. if TConditionConfig.GetConfig.GradeSystem and (FCategory = tcNormal) then
  3993. begin
  3994. AUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  3995. if not Assigned(AUser) then
  3996. Exit;
  3997. source := TUsersService.ClearServerID(FSender);
  3998. target := TUsersService.ClearServerID(FReceiver);
  3999. (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 + '"]');
  4000. end
  4001. else
  4002. Close;
  4003. end;
  4004. procedure TTalkingForm.btDownArrowClick(Sender: TObject);
  4005. var
  4006. Point1: TPoint;
  4007. begin
  4008. Point1.X := 0;
  4009. Point1.Y := (Sender as TRealICQButton).Height + 1;
  4010. Point1 := (Sender as TRealICQButton).ClientToScreen(Point1);
  4011. ppForDown.Popup(Point1.X + 6, Point1.Y);
  4012. end;
  4013. procedure TTalkingForm.btnQRClick(Sender: TObject);
  4014. var
  4015. data: string;
  4016. RealICQUser: TRealICQUser;
  4017. Form: TVCardForm;
  4018. begin
  4019. Form := GetVCardForm(FReceiver);
  4020. Form.Top := (Screen.Height - Form.Height) div 2;
  4021. Form.Left := (Screen.Width - Form.Width) div 2;
  4022. Form.Show;
  4023. end;
  4024. procedure TTalkingForm.btReleaseControlClick(Sender: TObject);
  4025. begin
  4026. if Assigned(FRemoteControlMission) then
  4027. FRemoteControlMission.CancelControl;
  4028. end;
  4029. procedure TTalkingForm.btSendClick(Sender: TObject);
  4030. var
  4031. Face: TFace;
  4032. FaceMD5String, MessageStr: string;
  4033. BaseSelStart, iCount, iLoop: Integer;
  4034. FaceInRichEdit: TFaceInRichEdit;
  4035. FaceIndexes: TIndexes;
  4036. FRealICQUser: TRealICQUser;
  4037. saystr, AError: string;
  4038. AFaces: TStringList;
  4039. ATask: TFacesUploaderTask;
  4040. begin
  4041. if (GetTickCount - FLastSendMsgTicket) < 200 then
  4042. begin
  4043. ShowSendMessageTooQuickly(WebBrowser);
  4044. Exit;
  4045. end;
  4046. FRealICQUser := nil;
  4047. if FCategory = tcNormal then
  4048. begin
  4049. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4050. if not Assigned(FRealICQUser) then
  4051. Exit;
  4052. if AnsiSameText(RichEdInputer.Text, '/P2PType') then
  4053. begin
  4054. P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
  4055. ClearInputtingMessageTimer.Enabled := False;
  4056. ClearInputtingMessageTimer.Enabled := True;
  4057. RichEdInputer.Lines.Clear;
  4058. Exit;
  4059. end;
  4060. end;
  4061. if GetInputerLength > MaxMessageLength + 64 then
  4062. begin
  4063. MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
  4064. RichEdInputer.SetFocus;
  4065. Exit;
  4066. end;
  4067. MessageStr := '';
  4068. AFaces := TStringList.Create;
  4069. FaceIndexes := RichEdInputer.GetFaceIndexes;
  4070. BaseSelStart := 0;
  4071. RichEdInputer.OnChange := nil;
  4072. RichEdInputer.Visible := False;
  4073. try
  4074. iCount := 0;
  4075. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4076. begin
  4077. FaceInRichEdit := FaceIndexes[iLoop];
  4078. if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
  4079. Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
  4080. else
  4081. Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
  4082. if TLimitCondition.GreaterThanFaceMaxSize(Face.FileName, AError) then
  4083. begin
  4084. MessageBox(Handle, PChar(AError), '提示', MB_ICONINFORMATION);
  4085. Error(AError, 'TLimitCondition.GreaterThanFaceMaxSize');
  4086. RichEdInputer.SetFocus;
  4087. Exit;
  4088. end;
  4089. end;
  4090. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4091. begin
  4092. FaceInRichEdit := FaceIndexes[iLoop];
  4093. if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
  4094. Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
  4095. else
  4096. Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
  4097. if FaceInRichEdit.FaceIndex < MainForm.SystemFaceCount then
  4098. FaceMD5String := Face.ShortCut
  4099. else
  4100. begin
  4101. FaceMD5String := '[image-src="' + Face.MD5Code + '"]';
  4102. Inc(iCount);
  4103. AFaces.addObject(Face.FileName, Face);
  4104. end;
  4105. RichEdInputer.SelStart := BaseSelStart + FaceInRichEdit.FacePosition;
  4106. RichEdInputer.SelLength := 1;
  4107. RichEdInputer.SelText := FaceMD5String;
  4108. Inc(BaseSelStart, Length(FaceMD5String) - 1);
  4109. end;
  4110. MessageStr := Trim(RichEdInputer.Text);
  4111. if Length(MessageStr) = 0 then
  4112. begin
  4113. MessageBox(Handle, '不能发送空消息! ', '提示', MB_ICONINFORMATION);
  4114. Exit;
  4115. end;
  4116. if GetInputerLength > 4096 then
  4117. begin
  4118. MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
  4119. RichEdInputer.SetFocus;
  4120. Exit;
  4121. end;
  4122. finally
  4123. RichEdInputer.Visible := True;
  4124. RichEdInputer.SetFocus;
  4125. end;
  4126. RichEdInputer.MaxLength := MaxMessageLength;
  4127. RichEdInputer.Lines.Clear;
  4128. RichEdInputer.Clear;
  4129. RichEdInputer.OnChange := RichEdInputerChange;
  4130. RichEdInputer.Visible := True;
  4131. RichEdInputer.SetFocus;
  4132. while (ImagesList.Count > 0) do
  4133. begin
  4134. dispose(ImagesList.First);
  4135. ImagesList.Delete(0);
  4136. end;
  4137. if FCategory = tcNormal then
  4138. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SyncSendMessage((spbEncryMsg.Tag = 1), FontToString(RichEdInputer.Font), MessageStr, AFaces)
  4139. else
  4140. TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, AFaces, '');
  4141. FLastSendMsgTicket := GetTickCount;
  4142. end;
  4143. procedure TTalkingForm.btSetControlClick(Sender: TObject);
  4144. begin
  4145. if Assigned(FRemoteControlMission) then
  4146. FRemoteControlMission.ControlReAccept;
  4147. end;
  4148. //------------------------------------------------------------------------------
  4149. procedure TTalkingForm.RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  4150. var
  4151. chrPoint, vPoint, pt: TPoint;
  4152. FaceInRichEdit: TFaceInRichEdit;
  4153. FaceIndexes: TIndexes;
  4154. iLoop, iPos: integer;
  4155. face: TFace;
  4156. begin
  4157. if Button = mbRight then
  4158. begin
  4159. vPoint.X := X;
  4160. vPoint.Y := Y;
  4161. vPoint := RichEdInputer.ClientToScreen(vPoint);
  4162. chrPoint := Point(X, Y);
  4163. iPos := SendMessage(TRealICQRichEdit(Sender).Handle, EM_CHARFROMPOS, 0, Integer(@chrPoint)) and $0000FFFF; // 得到鼠标点击字符位置
  4164. pt := TRealICQRichEdit(Sender).GetCharPos(iPos);
  4165. if (RichEdInputer.SelLength <= 0) then
  4166. begin
  4167. if pt.x < chrPoint.X then
  4168. RichEdInputer.SetSelection(iPos, iPos + 1, false)
  4169. else
  4170. RichEdInputer.SetSelection(iPos - 1, iPos, true);
  4171. if TRealICQRichEdit(Sender).SelectionType <> [stObject] then
  4172. begin
  4173. RichEdInputer.SelLength := 0;
  4174. RichEdInputer.SelStart := iPos;
  4175. end;
  4176. end;
  4177. //判断
  4178. if TRealICQRichEdit(Sender).SelectionType = [stObject] then
  4179. begin
  4180. FaceIndexes := TRealICQRichEdit(Sender).GetFaceIndexes;
  4181. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4182. begin
  4183. FaceInRichEdit := FaceIndexes[iLoop];
  4184. if FaceInRichEdit.FacePosition = TRealICQRichEdit(Sender).SelStart then
  4185. begin
  4186. FRightMouseClickedFace := FaceInRichEdit;
  4187. miCopyImage.Visible := True;
  4188. actSaveImgAs.Visible := True;
  4189. actAddImageToCustomFaces.Visible := True;
  4190. ppForInputerImg.Popup(vPoint.X, vPoint.Y);
  4191. break;
  4192. end;
  4193. end;
  4194. RichEdInputer.SelLength := 0;
  4195. RichEdInputer.SelStart := iPos;
  4196. end
  4197. else
  4198. ppForInputer.Popup(vPoint.X, vPoint.Y);
  4199. end;
  4200. end;
  4201. procedure TTalkingForm.RichEdInputerSelectionChange(Sender: TObject);
  4202. begin
  4203. //Dialogs.ShowMessage('RichEdInputerSelectionChange');
  4204. end;
  4205. //------------------------------------------------------------------------------
  4206. procedure TTalkingForm.rndMyInfoResize(Sender: TObject);
  4207. begin
  4208. //Application.ProcessMessages;
  4209. end;
  4210. //------------------------------------------------------------------------------
  4211. procedure TTalkingForm.spbSelUIColorClick(Sender: TObject);
  4212. var
  4213. Point: TPoint;
  4214. begin
  4215. Point.X := 0;
  4216. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  4217. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4218. ppColors.Popup(Point.X, Point.Y);
  4219. end;
  4220. //------------------------------------------------------------------------------
  4221. procedure TTalkingForm.LblSendSMSClick(Sender: TObject);
  4222. var
  4223. FRealICQUser: TRealICQUser;
  4224. begin
  4225. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4226. if Length(FRealICQUser.Mobile) > 0 then
  4227. OpenSMSForm(Receiver, True)
  4228. else
  4229. OpenSMSForm('', True);
  4230. end;
  4231. procedure TTalkingForm.LblSendSMSMouseEnter(Sender: TObject);
  4232. begin
  4233. LblSendSMS.Font.Style := [fsUnderLine];
  4234. LblSendSMS1.Font.Style := [fsUnderLine];
  4235. end;
  4236. procedure TTalkingForm.LblSendSMSMouseLeave(Sender: TObject);
  4237. begin
  4238. LblSendSMS.Font.Style := [];
  4239. LblSendSMS1.Font.Style := [];
  4240. end;
  4241. procedure TTalkingForm.LoadAdvertisement;
  4242. begin
  4243. if (not FRealICQClient.TalkingFormAdversement.Visible) then
  4244. begin
  4245. if pnlForWebBrowserAdvertisement.Width > 0 then
  4246. pnlAdvertisement.Width := 0;
  4247. end
  4248. else
  4249. begin
  4250. WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
  4251. pnlForHideWebBrowserAdvertisement.Visible := True;
  4252. WebBrowserForAdvertisement.OnDocumentComplete := WebBrowserForAdvertisementDocumentComplete;
  4253. WebBrowserForAdvertisement.Navigate(FRealICQClient.TalkingFormAdversement.URL);
  4254. WebBrowserForAdvertisement.OnBeforeNavigate2 := WebBrowserForAdvertisementBeforeNavigate2;
  4255. pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
  4256. end;
  4257. end;
  4258. //------------------------------------------------------------------------------
  4259. procedure TTalkingForm.LoadNotReadMessagesFromDBHistory(DBHistorySearchResult: TDBHistorySearchResult);
  4260. var
  4261. iLoop: Integer;
  4262. MessageSearchResult: TMessageSearchResult;
  4263. SenderName, SplitHTML, FontStr, AMessageStr: string;
  4264. FRealICQUser: TRealICQUser;
  4265. TextFont: TFont;
  4266. iIndex: Integer;
  4267. MessageList: TList;
  4268. NotReadMessageCount: Integer;
  4269. OldAllowURL: Boolean;
  4270. begin
  4271. ClearHTML(self.WebBrowser);
  4272. for iLoop := DBHistorySearchResult.Messages.Count - 1 downto 0 do
  4273. begin
  4274. MessageSearchResult := DBHistorySearchResult.Messages[iLoop];
  4275. if MessageSearchResult.TeamID = '-5' then
  4276. begin
  4277. Continue;
  4278. end;
  4279. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
  4280. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  4281. SenderName := FRealICQUser.LoginName
  4282. else
  4283. SenderName := FRealICQUser.DisplayName;
  4284. // TextFont := TFont.Create;
  4285. // OldAllowURL := MainForm.AllowURL;
  4286. try
  4287. // MainForm.AllowURL := False;
  4288. // StringToFont(MessageSearchResult.Font, TextFont);
  4289. // TextFont.Color := $00686868;
  4290. // FontStr := FontToString(TextFont);
  4291. if MessageSearchResult.IsEncryMessage then
  4292. AMessageStr := IntToStr(MessageSearchResult.ID)
  4293. else
  4294. AMessageStr := MessageSearchResult.MessageStr;
  4295. AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
  4296. finally
  4297. // MainForm.AllowURL := OldAllowURL;
  4298. // TextFont.Free;
  4299. end;
  4300. end;
  4301. end;
  4302. procedure TTalkingForm.LoadOfflinefilesConfig;
  4303. var
  4304. XMLDocument: TXMLDocument;
  4305. ServerConfigNode: IXMLNode;
  4306. begin
  4307. XMLDocument := TXMLDocument.Create(Self);
  4308. try
  4309. XMLDocument.Active := True;
  4310. if csDesigning in ComponentState then
  4311. exit;
  4312. XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName) + ConfigXMLFilePath + 'OfflinefilesServerConfig.xml');
  4313. ServerConfigNode := XMLDocument.DocumentElement;
  4314. FOfflinefilesAddr := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Address'];
  4315. FOfflinefilesPort := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Port'];
  4316. FPackageSize := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['PackageSize'];
  4317. finally
  4318. XMLDocument.Free;
  4319. end;
  4320. end;
  4321. //------------------------------------------------------------------------------
  4322. procedure TTalkingForm.LoadHistoryMessages;
  4323. var
  4324. iLoop: Integer;
  4325. MessageSearchResult: TMessageSearchResult;
  4326. SenderName, SplitHTML, FontStr, AMessageStr: string;
  4327. FRealICQUser: TRealICQUser;
  4328. iIndex: Integer;
  4329. MessageList: TList;
  4330. Alias: string;
  4331. begin
  4332. if FCategory = tcNormal then
  4333. MessageList := MainForm.DBHistory.GetMessage('-1', FReceiver, FRealICQClient.LoginName, FMaxID, 8)
  4334. else
  4335. MessageList := MainForm.DBHistory.GetMessage(FTeamID, FReceiver, FRealICQClient.LoginName, FMaxID, 8);
  4336. for iLoop := 0 to MessageList.Count - 1 do
  4337. begin
  4338. MessageSearchResult := MessageList[iLoop];
  4339. if MessageSearchResult.TeamID = '-5' then
  4340. begin
  4341. Continue;
  4342. end;
  4343. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
  4344. Alias := TTeamsAdapter.GetAlias(FTeamID, FRealICQUser.LoginName);
  4345. if trim(Alias) = '' then
  4346. begin
  4347. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  4348. SenderName := FRealICQUser.LoginName
  4349. else
  4350. SenderName := FRealICQUser.DisplayName;
  4351. end
  4352. else
  4353. SenderName := Alias;
  4354. if MessageSearchResult.IsEncryMessage then
  4355. AMessageStr := IntToStr(MessageSearchResult.ID)
  4356. else
  4357. AMessageStr := MessageSearchResult.MessageStr;
  4358. AddMessageToWebBrowserTop(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
  4359. end;
  4360. if MessageList.Count > 0 then
  4361. FMaxID := TMessageSearchResult(MessageList[MessageList.Count - 1]).ID;
  4362. TRealICQUtility.FreeList(MessageList);
  4363. end;
  4364. //------------------------------------------------------------------------------
  4365. procedure TTalkingForm.LoadNotReadMessages;
  4366. var
  4367. iIndex: Integer;
  4368. MessageList: TList;
  4369. NotReadMessage: TNotReadMessage;
  4370. NotReadTeamMessage: TNotReadTeamMessage;
  4371. begin
  4372. try
  4373. Application.ProcessMessages;
  4374. LoadHistoryMessages;
  4375. except
  4376. end;
  4377. GoBottom(Webbrowser);
  4378. if FCategory = tcNormal then
  4379. begin
  4380. iIndex := MainForm.NotReadMessages.IndexOf(Receiver);
  4381. if iIndex < 0 then
  4382. Exit;
  4383. MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
  4384. MainForm.NotReadMessages.Delete(iIndex);
  4385. try
  4386. NotReadMessageBoxForm.ShowNotReadMessage;
  4387. NotReadMessageBoxForm.Height := 0;
  4388. NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
  4389. except
  4390. end;
  4391. // MainForm.DBHistory.SetReadFlag('-1', Receiver);
  4392. //
  4393. // while MessageList.Count > 0 do
  4394. // begin
  4395. // NotReadMessage := TNotReadMessage(MessageList[0]);
  4396. // ShowMessage(NotReadMessage.RealICQMessage, NotReadMessage.ShowSendFailed);
  4397. // MessageList.Delete(0);
  4398. // FreeAndNil(NotReadMessage);
  4399. // end;
  4400. // FreeAndNil(MessageList);
  4401. TRealICQUtility.FreeList(MessageList);
  4402. MainForm.StopFlash(Receiver);
  4403. end
  4404. else
  4405. begin
  4406. iIndex := MainForm.NotReadMessages.IndexOf(TeamMessageID + FTeamID);
  4407. if iIndex < 0 then
  4408. Exit;
  4409. MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
  4410. MainForm.NotReadMessages.Delete(iIndex);
  4411. MainForm.DBHistory.SetReadFlag(FTeamID, '');
  4412. try
  4413. NotReadMessageBoxForm.ShowNotReadMessage;
  4414. NotReadMessageBoxForm.Height := 0;
  4415. NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
  4416. except
  4417. end;
  4418. // while MessageList.Count > 0 do
  4419. // begin
  4420. // NotReadTeamMessage := TNotReadTeamMessage(MessageList[0]);
  4421. //
  4422. // ShowTeamMessage(NotReadTeamMessage.RealICQTeamMessage, NotReadTeamMessage.ShowSendFailed);
  4423. // MessageList.Delete(0);
  4424. // FreeAndNil(NotReadTeamMessage);
  4425. // end;
  4426. // FreeAndNil(MessageList);
  4427. TRealICQUtility.FreeList(MessageList);
  4428. MainForm.StopFlashTeam(FTeamID);
  4429. end;
  4430. end;
  4431. {设置WebBrowser的样式}
  4432. //------------------------------------------------------------------------------
  4433. procedure TTalkingForm.SetDOMStyle(Doc: IHTMLDocument2);
  4434. var
  4435. v: Variant;
  4436. CurrentColor, CssColor: string;
  4437. AHtmlFile: TFileStream;
  4438. AStrStream: TStringStream;
  4439. begin
  4440. // if pnlForHideWebBrowser.Visible then
  4441. // begin
  4442. // try
  4443. // AHtmlFile := TFileStream.Create('E:\\DelphiProjects\\IMClient-Root-CMG\\html\\chat.html', fmOpenRead);
  4444. // AStrStream := TStringStream.Create('');
  4445. // AStrStream.CopyFrom(AHtmlFile, AHtmlFile.Size);
  4446. // v := VarArrayCreate([0, 0], varVariant);
  4447. // v[0] := AStrStream.DataString;
  4448. // // v[0] := '<html dir="ltr" lang="zh">'
  4449. // // + '<head>'
  4450. // // + '<META http-equiv="Content-Type" content="text/html; charset=gb2312">'
  4451. // // + '<body link="#0000FF" vlink="#0000FF" alink="#0000FF" hlink="#0000FF" bgcolor="#fdfdfd" oncontextmenu="location.href=''PopMenu'';return false;">'
  4452. // // + '</body>'
  4453. // // + '</head>'; //????????????????????????
  4454. // doc.write(PSafeArray(TVarData(v).VArray));
  4455. // finally
  4456. // AHtmlFile.Free;
  4457. // AStrStream.Free;
  4458. // end;
  4459. // end;
  4460. try
  4461. CurrentColor := IntToHex(ConvertColorToColor($00CDCDCD, FWindowColor), 6);
  4462. CssColor := '#' + Copy(CurrentColor, 5, 2) + Copy(CurrentColor, 3, 2) + Copy(CurrentColor, 1, 2);
  4463. except
  4464. end;
  4465. Doc.body.language := 'gb2312';
  4466. 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;}';
  4467. Doc.body.style.overflow := 'auto';
  4468. Doc.body.style.border := '0px solid';
  4469. Doc.body.style.margin := '2px';
  4470. Doc.body.style.fontFamily := '宋体';
  4471. Doc.body.style.fontSize := '9pt';
  4472. Doc.body.style.backgroundImage := 'url(' + FBackGroundImage + ')';
  4473. end;
  4474. //------------------------------------------------------------------------------
  4475. procedure TTalkingForm.WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4476. begin
  4477. // Dialogs.ShowMessage(IntToStr(Pos(FBaseURL, UpperCase(String(URL)))));
  4478. // Dialogs.ShowMessage(IntToStr(Pos('about:blank', UpperCase(String(URL)))));
  4479. if (Pos(FBaseURL, UpperCase(string(URL))) >= 1) or (Pos('about:blank', string(URL)) >= 1) then
  4480. begin
  4481. URL := Trim(AnsiReplaceText(string(URL), FBaseURL, ''));
  4482. if TFileTransmitAdapter.HandleMessage(Self, URL, Cancel) then
  4483. Exit;
  4484. IEBeforeNavigate2(Self, ASender, pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel);
  4485. end
  4486. else
  4487. begin
  4488. if Category = tcNormal then
  4489. begin
  4490. if FileExists(string(URL)) then
  4491. begin
  4492. if FRealICQClient.Connected and FRealICQClient.Logined then
  4493. begin
  4494. SendDropFile(string(URL));
  4495. Cancel := True;
  4496. end;
  4497. end;
  4498. if DirectoryExists(string(URL)) then
  4499. begin
  4500. if FRealICQClient.Connected and FRealICQClient.Logined then
  4501. begin
  4502. OpenSendFolderForm(string(URL));
  4503. Cancel := True;
  4504. end;
  4505. end;
  4506. end
  4507. else
  4508. begin
  4509. if FileExists(string(URL)) then
  4510. begin
  4511. if FRealICQClient.Connected and FRealICQClient.Logined then
  4512. begin
  4513. SendDropFile(string(URL));
  4514. Cancel := True;
  4515. end;
  4516. end;
  4517. end;
  4518. end;
  4519. end;
  4520. //------------------------------------------------------------------------------
  4521. function TTalkingForm.GetCanWriteMessage: Boolean;
  4522. begin
  4523. Result := not pnlForHideWebBrowser.Visible;
  4524. end;
  4525. //------------------------------------------------------------------------------
  4526. procedure TTalkingForm.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4527. begin
  4528. try
  4529. Log('WebBrowserDocumentComplete', 'WebBrowser');
  4530. WebBrowser.OnDocumentComplete := nil;
  4531. try
  4532. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  4533. finally
  4534. pnlForHideWebBrowser.Visible := False;
  4535. end;
  4536. except
  4537. end;
  4538. end;
  4539. //------------------------------------------------------------------------------
  4540. procedure TTalkingForm.WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4541. begin
  4542. if not AnsiSameText(URL, FRealICQClient.TalkingFormAdversement.URL) then
  4543. begin
  4544. ShellExecute(handle, 'open', PChar(MainForm.GetDefaultBrowser), PChar('"' + string(URL) + '"'), nil, SW_SHOWNORMAL);
  4545. Cancel := True;
  4546. end;
  4547. end;
  4548. //------------------------------------------------------------------------------
  4549. procedure TTalkingForm.WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4550. begin
  4551. try
  4552. WebBrowserForAdvertisement.OnDocumentComplete := nil;
  4553. MainForm.SetDomStyle(WebBrowserForAdvertisement.Document as IHtmlDocument2);
  4554. except
  4555. end;
  4556. Application.ProcessMessages;
  4557. pnlForHideWebBrowserAdvertisement.Visible := False;
  4558. pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
  4559. Constraints.MinWidth := 288 + pnlAdvertisement.Width;
  4560. ClearMemory;
  4561. end;
  4562. procedure TTalkingForm.WebBrowserForTeamDiskBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4563. begin
  4564. if FileExists(string(URL)) then
  4565. TTeamShareAdapter.UploadFile(TeamID, string(URL), Self, Self.FRealICQClient, False);
  4566. end;
  4567. procedure TTalkingForm.WebBrowserForTeamDiskoldBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4568. var
  4569. strMissionID, strFileName, js: string;
  4570. begin
  4571. if FileExists(string(URL)) then
  4572. begin
  4573. if FRealICQClient.Connected and Self.FRealICQClient.Logined then
  4574. begin
  4575. try
  4576. strMissionID := '1|' + IntToStr(GetTickCount) + ',' + TeamID + ',' + MainForm.RealICQClient.LoginName;
  4577. strFileName := string(URL);
  4578. js := format('ReadyToUpload("%s", "%s", %d)', [strMissionID, ReplaceStr(strFileName, '\', '\\'), GetTheFileSize(strFileName)]);
  4579. try
  4580. WebBrowserForTeamDisk.OleObject.Document.parentWindow.execScript(js, 'JavaScript');
  4581. except
  4582. end;
  4583. except
  4584. on E: Exception do
  4585. MessageBox(0, PChar(E.Message), '上传文件出错! ', MB_ICONINFORMATION);
  4586. end;
  4587. end;
  4588. Cancel := True;
  4589. end;
  4590. end;
  4591. procedure TTalkingForm.WebBrowserForTeamDiskoldDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4592. begin
  4593. pnlForHideTeamDisk.Visible := False;
  4594. WebBrowserForTeamDisk.OnDocumentComplete := nil;
  4595. end;
  4596. //------------------------------------------------------------------------------
  4597. procedure TTalkingForm.OnKeyDown(var Msg: TMessage);
  4598. begin
  4599. if RemoteControlForm = nil then
  4600. Exit;
  4601. if RemoteControlForm.Parent <> pnlRC then
  4602. Exit;
  4603. if FRemoteControlMission <> nil then
  4604. FRemoteControlMission.SendMessage(Msg);
  4605. end;
  4606. //------------------------------------------------------------------------------
  4607. procedure TTalkingForm.OnKeyUp(var Msg: TMessage);
  4608. begin
  4609. if RemoteControlForm = nil then
  4610. Exit;
  4611. if RemoteControlForm.Parent <> pnlRC then
  4612. Exit;
  4613. if FRemoteControlMission <> nil then
  4614. FRemoteControlMission.SendMessage(Msg);
  4615. end;
  4616. //------------------------------------------------------------------------------
  4617. procedure TTalkingForm.CMWininichange(var Message: TWMWinIniChange);
  4618. begin
  4619. ChangeUIColor(MainForm.UIMainColor);
  4620. DisableAlign;
  4621. try
  4622. PostMessage(Handle, WM_SIZE, 0, 0);
  4623. finally
  4624. EnableAlign;
  4625. end;
  4626. end;
  4627. //------------------------------------------------------------------------------
  4628. procedure TTalkingForm.CreateParams(var Params: TCreateParams);
  4629. begin
  4630. inherited;
  4631. with Params do
  4632. begin
  4633. Params.WndParent := 0;
  4634. end;
  4635. end;
  4636. //------------------------------------------------------------------------------
  4637. procedure TTalkingForm.SendDropFile(AFileName: string);
  4638. var
  4639. FRealICQUser: TRealICQUser;
  4640. AFileStream: TFileStream;
  4641. AModalResult: Integer;
  4642. UpUrl: string;
  4643. AFileSize: int64;
  4644. AError: string;
  4645. begin
  4646. if not FRealICQClient.Connected or not FRealICQClient.Logined then
  4647. Exit;
  4648. //Success('1', 'TTalkingForm.SendDropFile');
  4649. try
  4650. if FCategory = tcTeam then
  4651. begin
  4652. if DirectoryExists(AFileName) then
  4653. begin
  4654. MessageBox(0, PChar('不支持直接上传目录,请压缩后上传! '), '提示', MB_ICONINFORMATION);
  4655. Exit;
  4656. end;
  4657. if FileExists(AFileName) then
  4658. TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
  4659. Exit;
  4660. end;
  4661. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4662. if not Assigned(FRealICQUser) then
  4663. Exit;
  4664. //Success('2', 'TTalkingForm.SendDropFile');
  4665. if not (FRealICQUser.LoginState = stOffline) and not (FRealICQUser.LoginState = stHidden) then
  4666. begin
  4667. SendFile(AFileName);
  4668. Exit;
  4669. end;
  4670. //Success('3', 'TTalkingForm.SendDropFile');
  4671. if TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient) then
  4672. begin
  4673. MessageBox(0, PChar(AError), '提示', MB_ICONINFORMATION);
  4674. PostMessage(Handle, WM_SETFOCUS, 0, 0);
  4675. Exit;
  4676. end;
  4677. //Success('3', 'TTalkingForm.SendDropFile');
  4678. TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
  4679. except
  4680. on E: Exception do
  4681. Error(E.Message, 'TTalkingForm.SendDropFile(' + AFileName + ')');
  4682. end;
  4683. end;
  4684. procedure TTalkingForm.RichEdInputerDropFiles(Sender: TObject; AFiles: TStringList);
  4685. var
  4686. iLoop: Integer;
  4687. iTimes: Integer;
  4688. UpUrl: string;
  4689. AFileSize: int64;
  4690. begin
  4691. iTimes := 0;
  4692. for iLoop := 0 to AFiles.Count - 1 do
  4693. begin
  4694. try
  4695. if FileExists(AFiles[iLoop]) and (RichEdInputer.InsertDIB) then
  4696. begin
  4697. if (AFiles.Count = 1) then
  4698. begin
  4699. AddImageToInput(AFiles[iLoop], RichEdInputer);
  4700. Break;
  4701. end;
  4702. end;
  4703. except
  4704. on E: Exception do
  4705. Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles-RichEdInputer.InsertDIB');
  4706. end;
  4707. try
  4708. if FCategory = tcTeam then
  4709. begin
  4710. if TGroupConfig.GetConfig.GroupVersion = gvIntegration then
  4711. begin
  4712. if not (MessageBox(0, '确定要群发该文件吗? ', '提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK) then
  4713. Exit;
  4714. TFileTransmitAdapter.Send(Self, tdSender, AFiles[iLoop], 1, FTeamID, '', Now, FRealICQClient);
  4715. end
  4716. else
  4717. TTeamShareAdapter.UploadFile(TeamID, AFiles[iLoop], Self, FRealICQClient, True);
  4718. end
  4719. else
  4720. begin
  4721. if DirectoryExists(AFiles[iLoop]) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4722. begin
  4723. OpenSendFolderForm(AFiles[iLoop]);
  4724. Exit;
  4725. end;
  4726. if (iTimes < 10) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4727. begin
  4728. SendDropFile(AFiles[iLoop]);
  4729. Inc(iTimes);
  4730. end;
  4731. end;
  4732. except
  4733. on E: Exception do
  4734. Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles');
  4735. end;
  4736. end;
  4737. end;
  4738. procedure TTalkingForm.RichEdInputerInsertObject(Sender: TObject);
  4739. begin
  4740. TimerForCheckPastedContent.Enabled := False;
  4741. TimerForCheckPastedContent.Tag := 0;
  4742. TimerForCheckPastedContent.Enabled := True;
  4743. end;
  4744. { TODO -olqq -c : 群共享文件发送完成后,通知群成员 2014/12/18 14:45:09 }
  4745. procedure TTalkingForm.DownFileComplete(ASource, ADest, ARemark: string; AStatus: boolean; AFileSize: Integer; IsNeedNotify: Boolean);
  4746. var
  4747. MessageStr: string;
  4748. FaceFileName: TStringList;
  4749. IsAdmin: string;
  4750. begin
  4751. if not AStatus then
  4752. begin
  4753. spbUploadTeamFileProcess.Visible := False;
  4754. Messagebox(handle, PAnsiChar(ARemark), '提示', MB_OK);
  4755. Exit;
  4756. end;
  4757. if IsNeedNotify then
  4758. TTeamShareAdapter.UploadedNotifyToMembers(FRealICQClient.LoginName, TTeamsAdapter.GetTeam(FTeamID).TeamMembers, ARemark, ExtractFileName(ADest), AFileSize, FRealICQClient);
  4759. if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
  4760. IsAdmin := '1'
  4761. else
  4762. IsAdmin := '0';
  4763. spbUploadTeamFileProcess.Visible := False;
  4764. spbUploadTeamFileProcess.Caption := '%0';
  4765. FaceFileName := TStringList.Create;
  4766. try
  4767. MessageStr := '<TeamShare>' + ExtractFileName(ADest) + '</TeamShare>';
  4768. TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, FaceFileName, '');
  4769. finally
  4770. FaceFileName.Free;
  4771. end;
  4772. WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
  4773. end;
  4774. procedure TTalkingForm.DropFiles(var Message: TMessage);
  4775. var
  4776. i: Integer;
  4777. p: array[0..254] of Char;
  4778. ALocalFile, AFileExt, ALocalPath, ALocalFilePath: string;
  4779. iTimes: Integer;
  4780. UpUrl: string;
  4781. AFileSize: Int64;
  4782. begin
  4783. iTimes := 0;
  4784. try
  4785. i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
  4786. for i := 0 to i - 1 do
  4787. begin
  4788. DragQueryFile(Message.wParam, i, p, 255);
  4789. if FileExists(StrPas(p)) then
  4790. begin
  4791. ALocalFile := StrPas(p);
  4792. //Success(ALocalFile, 'TTalkingForm.DropFiles');
  4793. AFileExt := ExtractFileExt(ALocalFile);
  4794. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  4795. begin
  4796. ALocalPath := ExtractFilePath(Application.ExeName);
  4797. ALocalFilePath := ExtractFilePath(ALocalFile);
  4798. ALocalFilePath := Copy(ALocalFilePath, 1, Length(ALocalPath));
  4799. if AnsiSameText(ALocalPath, ALocalFilePath) then
  4800. begin
  4801. Continue;
  4802. end;
  4803. end;
  4804. if FCategory = tcTeam then
  4805. begin
  4806. TTeamShareAdapter.UploadFile(TeamID, StrPas(p), Self, FRealICQClient, False);
  4807. end
  4808. else if FCategory = tcNormal then
  4809. begin
  4810. if DirectoryExists(StrPas(p)) then
  4811. begin
  4812. if MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4813. OpenSendFolderForm(StrPas(p));
  4814. end;
  4815. end;
  4816. end;
  4817. end;
  4818. except
  4819. on E: Exception do
  4820. begin
  4821. Error(E.Message, 'TTalkingForm.DropFiles');
  4822. DragFinish(Message.wParam);
  4823. Message.Result := 1;
  4824. end;
  4825. end;
  4826. DragFinish(Message.wParam);
  4827. Message.Result := 1;
  4828. end;
  4829. //------------------------------------------------------------------------------
  4830. procedure TTalkingForm.ShowInputting(AInputting: Boolean);
  4831. var
  4832. UserName: string;
  4833. RealICQUser: TRealICQUser;
  4834. begin
  4835. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4836. if not Assigned(RealICQUser) then
  4837. UserName := FReceiver
  4838. else if RealICQUser.DisplayName = '' then
  4839. UserName := RealICQUser.LoginName
  4840. else
  4841. UserName := RealICQUser.DisplayName;
  4842. if AInputting then
  4843. begin
  4844. lblState.Caption := UserName + ' 正在输入消息...';
  4845. Caption := UserName + ' 正在输入';
  4846. ClearInputtingMessageTimer.Enabled := False;
  4847. ClearInputtingMessageTimer.Enabled := True;
  4848. end
  4849. else
  4850. begin
  4851. lblState.Caption := '';
  4852. Caption := UserName;
  4853. ClearInputtingMessageTimer.Enabled := False;
  4854. end;
  4855. PostMessage(Handle, WM_SIZE, 0, 0);
  4856. end;
  4857. //------------------------------------------------------------------------------
  4858. procedure TTalkingForm.P2PTypeChanged(Sender: TObject);
  4859. var
  4860. RealICQPtoPBox: TRealICQPtoPBox;
  4861. begin
  4862. if not (Sender is TRealICQPtoPBox) then
  4863. Exit;
  4864. try
  4865. RealICQPtoPBox := Sender as TRealICQPtoPBox;
  4866. case RealICQPtoPBox.P2PType of
  4867. ppTransByServerTCP:
  4868. lblState.Caption := '连接方式: 服务器中转';
  4869. ppPtoPByTCPServer:
  4870. lblState.Caption := '连接方式: TCP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ' -> 本机)';
  4871. ppPtoPByTCPClient:
  4872. lblState.Caption := '连接方式: TCP直连(本机 -> ' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
  4873. ppPtoPByUDP:
  4874. lblState.Caption := '连接方式: UDP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
  4875. end;
  4876. except
  4877. end;
  4878. end;
  4879. procedure TTalkingForm.OpenSendFolderForm(FolderName: string);
  4880. var
  4881. SendFolderForm: TSendFolderForm;
  4882. RealICQUser: TRealICQUser;
  4883. iLoop: Integer;
  4884. ReceiverName: string;
  4885. begin
  4886. if not MainForm.RealICQClient.Connected or not MainForm.RealICQClient.Logined then
  4887. Exit;
  4888. SendFolderForm := TSendFolderForm.Create(MainForm);
  4889. if Category = tcNormal then
  4890. begin
  4891. if AnsiSameText(Receiver, MainForm.RealICQClient.LoginName) then
  4892. Exit;
  4893. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4894. if not Assigned(RealICQUser) then
  4895. Exit;
  4896. with SendFolderForm.lvUsers.Items.Add do
  4897. begin
  4898. Caption := RealICQUser.LoginName;
  4899. SubItems.Add(RealICQUser.DisplayName);
  4900. end;
  4901. end
  4902. else
  4903. begin
  4904. Exit;
  4905. end;
  4906. SendFolderForm.Show;
  4907. // SendFolderForm.BringToFront;
  4908. if DirectoryExists(FolderName) then
  4909. begin
  4910. SendFolderForm.AddFolderMission(FolderName);
  4911. end;
  4912. end;
  4913. //------------------------------------------------------------------------------
  4914. procedure TTalkingForm.spbSendFolderClick(Sender: TObject);
  4915. begin
  4916. OpenSendFolderForm('');
  4917. end;
  4918. //------------------------------------------------------------------------------
  4919. procedure TTalkingForm.spbAboutClick(Sender: TObject);
  4920. begin
  4921. MainForm.actAbout.Execute;
  4922. end;
  4923. procedure TTalkingForm.spbBackgroundClick(Sender: TObject);
  4924. var
  4925. Point: TPoint;
  4926. begin
  4927. if SelBackForm = nil then
  4928. begin
  4929. SelBackForm := TSelBackForm.Create(MainForm);
  4930. end;
  4931. SelBackForm.ParentForm := Self;
  4932. Point.X := 0;
  4933. Point.Y := (Sender as TRealICQSpeedButton).Height;
  4934. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4935. Point.X := Point.X - (SelBackForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
  4936. if Point.X <= 0 then
  4937. SelBackForm.Left := 1
  4938. else if Screen.WorkAreaWidth - Point.X >= SelBackForm.Width then
  4939. SelBackForm.Left := Point.X
  4940. else
  4941. SelBackForm.Left := Screen.WorkAreaWidth - SelBackForm.Width - 1;
  4942. if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelBackForm.Height) then
  4943. SelBackForm.Top := Point.Y - SelBackForm.Height - (Sender as TRealICQSpeedButton).Height
  4944. else
  4945. SelBackForm.Top := Point.Y;
  4946. SelBackForm.Show;
  4947. end;
  4948. procedure ShowCopyScreenForm(ATalkingForm: TTalkingForm);
  4949. begin
  4950. if Assigned(CopyScreenForm) then
  4951. Exit;
  4952. if ATalkingForm <> nil then
  4953. CopyScreenForm := TCopyScreenForm.Create(ATalkingForm)
  4954. else
  4955. CopyScreenForm := TCopyScreenForm.Create(MainForm);
  4956. try
  4957. CopyScreenForm.TalkingForm := ATalkingForm;
  4958. CopyScreenForm.WindowState := wsMaximized;
  4959. CopyScreenForm.ShowModal; //显示窗口
  4960. finally
  4961. FreeAndNil(CopyScreenForm);
  4962. end;
  4963. end;
  4964. //------------------------------------------------------------------------------
  4965. procedure TTalkingForm.spbFaceClick(Sender: TObject);
  4966. var
  4967. Point: TPoint;
  4968. begin
  4969. if SelFaceForm = nil then
  4970. begin
  4971. SelFaceForm := TSelFaceForm.Create(MainForm);
  4972. end;
  4973. SelFaceForm.TalkingForm := Self;
  4974. Point.X := 0;
  4975. Point.Y := (Sender as TRealICQSpeedButton).Height;
  4976. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4977. Point.X := Point.X - (SelFaceForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
  4978. if Point.X <= 0 then
  4979. SelFaceForm.Left := 1
  4980. else if Screen.WorkAreaWidth - Point.X >= SelFaceForm.Width then
  4981. SelFaceForm.Left := Point.X
  4982. else
  4983. SelFaceForm.Left := Screen.WorkAreaWidth - SelFaceForm.Width - 1;
  4984. if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelFaceForm.Height) then
  4985. SelFaceForm.Top := Point.Y - SelFaceForm.Height - (Sender as TRealICQSpeedButton).Height
  4986. else
  4987. SelFaceForm.Top := Point.Y;
  4988. SelFaceForm.Show;
  4989. end;
  4990. //------------------------------------------------------------------------------
  4991. procedure TTalkingForm.spbFontClick(Sender: TObject);
  4992. begin
  4993. EditFontSet.Execute;
  4994. end;
  4995. //------------------------------------------------------------------------------
  4996. procedure TTalkingForm.SpbForMyInfoClick(Sender: TObject);
  4997. var
  4998. Point: TPoint;
  4999. begin
  5000. Point.X := 0;
  5001. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5002. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5003. if FRealICQClient = MainForm.RealICQClient then
  5004. ppMyOptions.Popup(Point.X, Point.Y)
  5005. else
  5006. MainForm.ppChangeCustomerState.Popup(Point.X, Point.Y);
  5007. end;
  5008. //------------------------------------------------------------------------------
  5009. procedure TTalkingForm.SpbForYourInfoClick(Sender: TObject);
  5010. var
  5011. Point: TPoint;
  5012. begin
  5013. Point.X := 0;
  5014. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5015. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5016. ppYourOptions.Popup(Point.X, Point.Y);
  5017. end;
  5018. //------------------------------------------------------------------------------
  5019. procedure TTalkingForm.ShakeWindow;
  5020. var
  5021. iLoop: Integer;
  5022. OldLeft: Integer;
  5023. begin
  5024. PlayEventSound(ExtractFilePath(Application.ExeName) + '\' + ShakeWindowSound);
  5025. OldLeft := Left;
  5026. try
  5027. for iLoop := 12 downto 0 do
  5028. begin
  5029. if iLoop mod 2 = 0 then
  5030. Left := OldLeft + iLoop * 1
  5031. else
  5032. Left := OldLeft - iLoop * 1;
  5033. Sleep(10);
  5034. Application.ProcessMessages;
  5035. Sleep(10);
  5036. end;
  5037. finally
  5038. Left := OldLeft;
  5039. end;
  5040. end;
  5041. //------------------------------------------------------------------------------
  5042. procedure TTalkingForm.spbShakeWindowClick(Sender: TObject);
  5043. var
  5044. FRealICQUser: TRealICQUser;
  5045. begin
  5046. if GetTickCount - FLastSendShakeWindowTicket < 150000 then
  5047. begin
  5048. MessageBox(Handle, '请勿频繁发送窗口抖动! ', '提示', MB_ICONINFORMATION);
  5049. Exit;
  5050. end;
  5051. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  5052. if Assigned(FRealICQUser) then
  5053. begin
  5054. if (FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden) then
  5055. begin
  5056. MessageBox(Handle, '对方离线或隐身,无法接收窗口抖动! ', '提示', MB_ICONINFORMATION);
  5057. Exit;
  5058. end;
  5059. FLastSendShakeWindowTicket := GetTickCount;
  5060. ShowShakeWindow(True);
  5061. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SendShakeWindow;
  5062. end;
  5063. end;
  5064. //------------------------------------------------------------------------------
  5065. procedure TTalkingForm.SetBrowserBg(BackImage: string);
  5066. begin
  5067. FBackGroundImage := BackImage;
  5068. try
  5069. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  5070. except
  5071. end;
  5072. SaveBackGround;
  5073. end;
  5074. //------------------------------------------------------------------------------
  5075. procedure TTalkingForm.ShowShakeWindow(AIsSource: Boolean);
  5076. var
  5077. HTML: string;
  5078. UserName: string;
  5079. RealICQUser: TRealICQUser;
  5080. begin
  5081. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
  5082. if not Assigned(RealICQUser) then
  5083. UserName := FReceiver
  5084. else if RealICQUser.DisplayName = '' then
  5085. UserName := RealICQUser.LoginName
  5086. else
  5087. UserName := RealICQUser.DisplayName;
  5088. HTML := '<table width="100%" style="font-size:9pt;border:0px; padding:2px; color:#0000ff; margin-top:2px;margin-bottom:5px;"><tr><td>';
  5089. HTML := HTML + '<img src="' + ExtractFilePath(Application.ExeName) + InfomationPicture + '" align="absBottom"> ';
  5090. HTML := HTML + '<span>';
  5091. if AIsSource then
  5092. HTML := HTML + '您抖动了 ' + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 的对话窗口。'
  5093. else
  5094. HTML := HTML + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 抖动了您的对话窗口。';
  5095. HTML := HTML + '</span>';
  5096. HTML := HTML + '</td></tr></table>';
  5097. InsertHTML(WebBrowser, HTML);
  5098. Application.ProcessMessages;
  5099. ShakeWindow;
  5100. Sleep(450);
  5101. ShakeWindow;
  5102. end;
  5103. //------------------------------------------------------------------------------
  5104. procedure TTalkingForm.spbSpkClick(Sender: TObject);
  5105. var
  5106. Point: TPoint;
  5107. begin
  5108. Point.X := 0;
  5109. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5110. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5111. miOpenMic.Visible := False;
  5112. miCloseMic.Visible := False;
  5113. miOpenSpeak.Visible := True;
  5114. miCloseSpeak.Visible := True;
  5115. miOpenSpeak.Enabled := not TAudioTransmitter.GetRecvAudio;
  5116. miCloseSpeak.Enabled := TAudioTransmitter.GetRecvAudio;
  5117. ppAudioSet.Popup(Point.X, Point.Y);
  5118. end;
  5119. procedure TTalkingForm.spbTeamNetWorkDiskClick(Sender: TObject);
  5120. var
  5121. STR: string;
  5122. IsAdmin: string;
  5123. begin
  5124. if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
  5125. IsAdmin := '1'
  5126. else
  5127. IsAdmin := '0';
  5128. LockWindowUpdate(GetDesktopWindow);
  5129. try
  5130. Width := 800;
  5131. PnlTeamCallBoard.Visible := False;
  5132. rndTeamMembers.Visible := False;
  5133. pnlUserInformation.Width := 450;
  5134. pnlTeamWebDisk.Visible := True;
  5135. WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
  5136. //WebBrowserForTeamDisk.OnDocumentComplete := WebBrowserForTeamDiskDocumentComplete;
  5137. //STR := 'http://192.168.16.202:8083/home/index?loginname='+MainForm.RealICQClient.LoginName+'&teamid='+TeamID+'&displayname='+HttpEncode(Ansitoutf8(MainForm.RealICQClient.Me.DisplayName)+'&isAdmin='+IsAdmin);
  5138. // STR := MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount);
  5139. // WebBrowserForTeamDisk.Navigate(MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
  5140. //WebBrowserForTeamDisk.Navigate('http://172.28.1.76/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
  5141. finally
  5142. LockWindowUpdate(0);
  5143. end;
  5144. end;
  5145. procedure TTalkingForm.spbCloseTeamWebDiskClick(Sender: TObject);
  5146. var
  5147. iLoop: Integer;
  5148. AFileMission: TUploadOrDownloadFileMission;
  5149. AFinded: Boolean;
  5150. begin
  5151. AFinded := False;
  5152. if FUpDownFileMissions.Count > 0 then
  5153. begin
  5154. {for iLoop := UpDownFileMissions.Count - 1 downto 0 do
  5155. begin
  5156. AFileMission := UpDownFileMissions[iLoop];
  5157. if AFileMission.Category = 3 then
  5158. begin
  5159. AFinded := True;
  5160. Break;
  5161. end;
  5162. end;
  5163. if MessageBox(Handle, '有文件正在上传,确定要关闭吗?',
  5164. '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  5165. begin
  5166. Exit;
  5167. end; }
  5168. for iLoop := UpDownFileMissions.Count - 1 downto 0 do
  5169. begin
  5170. AFileMission := UpDownFileMissions[iLoop];
  5171. if AFileMission.Category = 3 then
  5172. begin
  5173. try
  5174. try
  5175. AFileMission.Stop;
  5176. finally
  5177. FreeAndNil(AFileMission);
  5178. end;
  5179. except
  5180. end;
  5181. end;
  5182. end;
  5183. end;
  5184. LockWindowUpdate(GetDesktopWindow);
  5185. try
  5186. PnlTeamCallBoard.Visible := True;
  5187. pnlTeamMembers.Visible := True;
  5188. rndTeamMembers.Visible := True;
  5189. pnlUserInformation.Width := 200;
  5190. pnlTeamWebDisk.Visible := False;
  5191. WindowState := wsNormal;
  5192. Width := 580;
  5193. finally
  5194. LockWindowUpdate(0);
  5195. end;
  5196. end;
  5197. procedure TTalkingForm.SendOfflineFile(AFileName: string);
  5198. var
  5199. //FRealICQUser: TRealICQUser;
  5200. AFileStream: TFileStream;
  5201. ALoginName: string;
  5202. RealICQUser: TRealICQUser;
  5203. ItemIndex: Integer;
  5204. RealICQContacterListItem: TRealICQContacterListItem;
  5205. AError: string;
  5206. begin
  5207. try
  5208. if (TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient)) then
  5209. raise Exception.Create(AError);
  5210. if FCategory = tcNormal then
  5211. begin
  5212. if not (MessageBox(Handle, PChar('确定要发送“' + AFileName + '”吗? '), '提示', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = IDYES) then
  5213. Exit;
  5214. TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
  5215. {$region '更新“最近联系人列表”中的数据'}
  5216. ALoginName := FReceiver;
  5217. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
  5218. if RealICQUser <> nil then
  5219. begin
  5220. ItemIndex := MainForm.ListViewLatests.Items.IndexOf(ALoginName);
  5221. if ItemIndex = -1 then
  5222. ItemIndex := MainForm.ListViewLatests.Items.Add(ALoginName);
  5223. RealICQContacterListItem := MainForm.ListViewLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5224. MainForm.BindUserDataToItem(RealICQContacterListItem, RealICQUser);
  5225. RealICQContacterListItem.MoveToTop;
  5226. end;
  5227. {$endregion}
  5228. end
  5229. else
  5230. begin
  5231. TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
  5232. end;
  5233. except
  5234. on E: Exception do
  5235. MessageBox(0, PChar(E.Message), '发送文件出错', MB_ICONINFORMATION);
  5236. end;
  5237. end;
  5238. //------------------------------------------------------------------------------
  5239. procedure TTalkingForm.spbUploadFileClick(Sender: TObject);
  5240. var
  5241. //FRealICQUser: TRealICQUser;
  5242. AFileStream: TFileStream;
  5243. ALoginName, AFileName: string;
  5244. RealICQUser: TRealICQUser;
  5245. ItemIndex: Integer;
  5246. RealICQContacterListItem: TRealICQContacterListItem;
  5247. begin
  5248. if not FRealICQClient.Connected or not FRealICQClient.Logined then
  5249. Exit;
  5250. OpenDialog.Title := '传输离线文件';
  5251. if OpenDialog.Execute then
  5252. begin
  5253. SendOfflineFile(OpenDialog.FileName);
  5254. end;
  5255. end;
  5256. //------------------------------------------------------------------------------
  5257. //procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
  5258. //begin
  5259. // if FCategory = tcTeam then
  5260. // begin
  5261. // MainForm.actMsgManagerExecute(nil);
  5262. // Application.ProcessMessages;
  5263. // MessagesManagerForm.ShowTeamsMessages(FTeamID);
  5264. // end
  5265. // else
  5266. // if FCategory = tcNormal then
  5267. // begin
  5268. // if FReceiver <> '' then
  5269. // begin
  5270. // MainForm.actMsgManagerExecute(nil);
  5271. // Application.ProcessMessages;
  5272. // MessagesManagerForm.ShowUsersMessages(FReceiver);
  5273. // end;
  5274. // end;
  5275. //end;
  5276. //------------------------------------------------------------------------------
  5277. procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
  5278. var
  5279. Point1, Point2: TPoint;
  5280. begin
  5281. point1 := Point(0, 0);
  5282. point2 := Point(0, 0);
  5283. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  5284. GetCursorPos(point2);
  5285. if (point2.X - point1.X) <= 17 then
  5286. begin
  5287. if FCategory = tcTeam then
  5288. begin
  5289. MainForm.actMsgManagerExecute(nil);
  5290. Application.ProcessMessages;
  5291. MessagesManagerForm.ShowTeamsMessages(FTeamID);
  5292. end
  5293. else if FCategory = tcNormal then
  5294. begin
  5295. if FReceiver <> '' then
  5296. begin
  5297. MainForm.actMsgManagerExecute(nil);
  5298. Application.ProcessMessages;
  5299. MessagesManagerForm.ShowUsersMessages(FReceiver);
  5300. end
  5301. end
  5302. end
  5303. else
  5304. begin
  5305. Point1.X := 0;
  5306. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5307. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  5308. ppForMsg.Popup(Point1.X, Point1.Y);
  5309. end;
  5310. end;
  5311. procedure TTalkingForm.spbMicClick(Sender: TObject);
  5312. var
  5313. Point: TPoint;
  5314. begin
  5315. Point.X := 0;
  5316. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5317. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5318. miOpenMic.Visible := True;
  5319. miCloseMic.Visible := True;
  5320. miOpenMic.Enabled := not TAudioTransmitter.GetSendAudio;
  5321. miCloseMic.Enabled := TAudioTransmitter.GetSendAudio;
  5322. miOpenSpeak.Visible := False;
  5323. miCloseSpeak.Visible := False;
  5324. ppAudioSet.Popup(Point.X, Point.Y);
  5325. end;
  5326. procedure TTalkingForm.spbRemoteControlClick(Sender: TObject);
  5327. begin
  5328. if FRemoteControlMission <> nil then
  5329. begin
  5330. MessageBox(Handle, '请先结束已存在的远程协助任务! ', '提示', MB_ICONINFORMATION);
  5331. Exit;
  5332. end;
  5333. FRealICQClient.CreateRemoteControlTransmitter(Receiver);
  5334. end;
  5335. //------------------------------------------------------------------------------
  5336. procedure TTalkingForm.TeamUpFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: string);
  5337. var
  5338. Completed: Integer;
  5339. begin
  5340. if ulProgressMax = 0 then
  5341. Exit;
  5342. Completed := ulProgress * 100 div ulProgressMax;
  5343. spbUploadTeamFileProcess.Caption := IntToStr(Completed) + '%';
  5344. end;
  5345. procedure TTalkingForm.TimerForCheckPastedContentTimer(Sender: TObject);
  5346. begin
  5347. TimerForCheckPastedContent.Tag := TimerForCheckPastedContent.Tag + 1;
  5348. if TimerForCheckPastedContent.Tag >= 2 then
  5349. TimerForCheckPastedContent.Enabled := False;
  5350. CheckPastedContent(False);
  5351. end;
  5352. procedure TTalkingForm.TimerForGetUserInformationTimer(Sender: TObject);
  5353. var
  5354. FRealICQUser: TRealICQUser;
  5355. begin
  5356. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  5357. if not Assigned(FRealICQUser) then
  5358. Exit;
  5359. TimerForGetUserInformation.Enabled := False;
  5360. if FRealICQUser.DisplayName = '' then
  5361. TUsersService.GetUsersService.GetOrRequestUser(FRealICQUser.LoginName, FRealICQClient);
  5362. if not FRealICQUser.GettedOffliceAutoResponseSet then
  5363. FRealICQClient.GetOffliceAutoResponseSet(FRealICQUser.LoginName);
  5364. end;
  5365. //------------------------------------------------------------------------------
  5366. procedure TTalkingForm.tsMyHeadImageShow(Sender: TObject);
  5367. begin
  5368. if FMinWidthOfYourPanel < pnlUserInformation.Width then
  5369. pnlUserInformation.Width := FMinWidthOfYourPanel;
  5370. if (FMinWidthOfYourPanel <= 114) then
  5371. begin
  5372. pnlUserInformation.Width := 114;
  5373. end;
  5374. FMinWidthOfMyPanel := 114;
  5375. lblMyInfo.Caption := '我的头像';
  5376. pnlMyInfo.Constraints.MinHeight := 146;
  5377. pnlMyInfo.Height := 146;
  5378. rndMyInfo.Top := 0;
  5379. rndMyInfo.Height := 140;
  5380. rndMy.Height := 100;
  5381. end;
  5382. //------------------------------------------------------------------------------
  5383. procedure TTalkingForm.tsMyCardShow(Sender: TObject);
  5384. begin
  5385. if (FMinWidthOfYourPanel <= 200) then
  5386. begin
  5387. pnlUserInformation.Width := 200;
  5388. end;
  5389. FMinWidthOfMyPanel := 200;
  5390. lblMyInfo.Caption := '我的名片';
  5391. pnlMyInfo.Constraints.MinHeight := 174;
  5392. pnlMyInfo.Height := 174;
  5393. rndMyInfo.Top := 0;
  5394. rndMyInfo.Height := 168;
  5395. rndMy.Height := 128;
  5396. end;
  5397. //------------------------------------------------------------------------------
  5398. procedure TTalkingForm.tsMyVideoShow(Sender: TObject);
  5399. begin
  5400. lblMyInfo.Caption := '我的视频';
  5401. if miMyVideoBigSize.Checked then
  5402. begin
  5403. if (FMinWidthOfYourPanel <= 180 + 160) then
  5404. begin
  5405. pnlUserInformation.Width := 180 + 160;
  5406. end;
  5407. FMinWidthOfMyPanel := 180 + 160;
  5408. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 244;
  5409. pnlMyInfo.Height := 40 + 6 + 244;
  5410. rndMyInfo.Top := 0;
  5411. rndMyInfo.Height := 284;
  5412. rndMy.Height := 244;
  5413. imgMyVideo.Width := 320;
  5414. imgMyVideo.Height := 240;
  5415. end
  5416. else if miMyVideoMiddleSize.Checked then
  5417. begin
  5418. if (FMinWidthOfYourPanel <= 180 + 80) then
  5419. begin
  5420. pnlUserInformation.Width := 180 + 80;
  5421. end;
  5422. FMinWidthOfMyPanel := 180 + 80;
  5423. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 184;
  5424. pnlMyInfo.Height := 40 + 6 + 184;
  5425. rndMyInfo.Top := 0;
  5426. rndMyInfo.Height := 224;
  5427. rndMy.Height := 184;
  5428. imgMyVideo.Width := 240;
  5429. imgMyVideo.Height := 180;
  5430. end
  5431. else
  5432. begin
  5433. if (FMinWidthOfYourPanel <= 180) then
  5434. begin
  5435. pnlUserInformation.Width := 180;
  5436. end;
  5437. FMinWidthOfMyPanel := 180;
  5438. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 124;
  5439. pnlMyInfo.Height := 40 + 6 + 124;
  5440. rndMyInfo.Top := 0;
  5441. rndMyInfo.Height := 164;
  5442. rndMy.Height := 124;
  5443. imgMyVideo.Width := 160;
  5444. imgMyVideo.Height := 120;
  5445. end;
  5446. end;
  5447. //------------------------------------------------------------------------------
  5448. procedure TTalkingForm.tsYourHeadImageShow(Sender: TObject);
  5449. begin
  5450. if FMinWidthOfMyPanel < pnlUserInformation.Width then
  5451. pnlUserInformation.Width := FMinWidthOfMyPanel;
  5452. if (FMinWidthOfMyPanel <= 114) then
  5453. begin
  5454. pnlUserInformation.Width := 114;
  5455. end;
  5456. FMinWidthOfYourPanel := 114;
  5457. lblYourInfo.Caption := '他的头像';
  5458. pnlYourInfo.Constraints.MinHeight := 146;
  5459. pnlYourInfo.Height := 146;
  5460. rndYourInfo.Top := 0;
  5461. rndYourInfo.Height := 140;
  5462. rndYour.Height := 100;
  5463. end;
  5464. //------------------------------------------------------------------------------
  5465. procedure TTalkingForm.tsYourCardShow(Sender: TObject);
  5466. begin
  5467. if (FMinWidthOfMyPanel <= 200) then
  5468. begin
  5469. pnlUserInformation.Width := 200;
  5470. end;
  5471. FMinWidthOfYourPanel := 200;
  5472. lblYourInfo.Caption := '他的名片';
  5473. pnlYourInfo.Constraints.MinHeight := 174;
  5474. pnlYourInfo.Height := 174;
  5475. rndYourInfo.Top := 0;
  5476. rndYourInfo.Height := 168;
  5477. rndYour.Height := 128;
  5478. end;
  5479. procedure TTalkingForm.tsYourVideoShow(Sender: TObject);
  5480. begin
  5481. lblMyInfo.Caption := '他的视频';
  5482. if miYourVideoBigSize.Checked then
  5483. begin
  5484. if (FMinWidthOfMyPanel <= 180 + 160) then
  5485. begin
  5486. pnlUserInformation.Width := 180 + 160;
  5487. end;
  5488. FMinWidthOfYourPanel := 180 + 160;
  5489. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 244;
  5490. pnlYourInfo.Height := 40 + 6 + 244;
  5491. rndYourInfo.Top := 0;
  5492. rndYourInfo.Height := 284;
  5493. rndYour.Height := 244;
  5494. imgYourVideo.Width := 320;
  5495. imgYourVideo.Height := 240;
  5496. end
  5497. else if miYourVideoMiddleSize.Checked then
  5498. begin
  5499. if (FMinWidthOfMyPanel <= 180 + 80) then
  5500. begin
  5501. pnlUserInformation.Width := 180 + 80;
  5502. end;
  5503. FMinWidthOfYourPanel := 180 + 80;
  5504. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 184;
  5505. pnlYourInfo.Height := 40 + 6 + 184;
  5506. rndYourInfo.Top := 0;
  5507. rndYourInfo.Height := 224;
  5508. rndYour.Height := 184;
  5509. imgYourVideo.Width := 240;
  5510. imgYourVideo.Height := 180;
  5511. end
  5512. else
  5513. begin
  5514. if (FMinWidthOfMyPanel <= 180) then
  5515. begin
  5516. pnlUserInformation.Width := 180;
  5517. end;
  5518. FMinWidthOfYourPanel := 180;
  5519. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 124;
  5520. pnlYourInfo.Height := 40 + 6 + 124;
  5521. rndYourInfo.Top := 0;
  5522. rndYourInfo.Height := 164;
  5523. rndYour.Height := 124;
  5524. imgYourVideo.Width := 160;
  5525. imgYourVideo.Height := 120;
  5526. end;
  5527. end;
  5528. //------------------------------------------------------------------------------
  5529. procedure TTalkingForm.miShowYourCardClick(Sender: TObject);
  5530. begin
  5531. Application.ProcessMessages;
  5532. Sleep(200);
  5533. (Sender as TMenuItem).Checked := True;
  5534. pgcYourInfo.ActivePageIndex := 1;
  5535. Application.ProcessMessages;
  5536. end;
  5537. //------------------------------------------------------------------------------
  5538. procedure TTalkingForm.miShowYourHeadImageClick(Sender: TObject);
  5539. begin
  5540. Application.ProcessMessages;
  5541. Sleep(200);
  5542. (Sender as TMenuItem).Checked := True;
  5543. pgcYourInfo.ActivePageIndex := 0;
  5544. Application.ProcessMessages;
  5545. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5546. end;
  5547. procedure TTalkingForm.miShowYourVideoClick(Sender: TObject);
  5548. begin
  5549. Application.ProcessMessages;
  5550. Sleep(200);
  5551. (Sender as TMenuItem).Checked := True;
  5552. pgcYourInfo.ActivePageIndex := 2;
  5553. Application.ProcessMessages;
  5554. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5555. end;
  5556. //------------------------------------------------------------------------------
  5557. procedure TTalkingForm.miStopAudioTransmiteClick(Sender: TObject);
  5558. begin
  5559. if FAudioMission <> nil then
  5560. FAudioMission.Stop;
  5561. end;
  5562. procedure TTalkingForm.miTeamAddFriendClick(Sender: TObject);
  5563. begin
  5564. miAddFriendClick(nil);
  5565. end;
  5566. procedure TTalkingForm.miTeamSeeUserInfoClick(Sender: TObject);
  5567. begin
  5568. SeeUserInformation(ALoginName);
  5569. end;
  5570. procedure TTalkingForm.miTeamSendMessageClick(Sender: TObject);
  5571. begin
  5572. if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
  5573. begin
  5574. //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
  5575. Exit;
  5576. end;
  5577. OpenTalkingForm(ALoginName);
  5578. end;
  5579. procedure TTalkingForm.miTeamSMSClick(Sender: TObject);
  5580. begin
  5581. OpenSMSForm(ALoginName);
  5582. end;
  5583. procedure TTalkingForm.miVideoSetClick(Sender: TObject);
  5584. var
  5585. SysDev: TSysDevEnum;
  5586. begin
  5587. SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  5588. try
  5589. try
  5590. VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(FRealICQClient.VideoDeviceID);
  5591. except
  5592. VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(0);
  5593. end;
  5594. CaptureGraph.Active := True;
  5595. ShowFilterPropertyPage(Self.Handle, VideoSourceFilter as IBaseFilter);
  5596. finally
  5597. FreeAndNil(SysDev);
  5598. end;
  5599. end;
  5600. //------------------------------------------------------------------------------
  5601. procedure TTalkingForm.miYourVideoSmallSizeClick(Sender: TObject);
  5602. begin
  5603. if pgcYourInfo.ActivePage = tsYourVideo then
  5604. begin
  5605. Application.ProcessMessages;
  5606. Sleep(200);
  5607. tsYourVideoShow(tsYourVideo);
  5608. Application.ProcessMessages;
  5609. end;
  5610. end;
  5611. //------------------------------------------------------------------------------
  5612. procedure TTalkingForm.miMyVideoSmallSizeClick(Sender: TObject);
  5613. begin
  5614. if pgcMyInfo.ActivePage = tsMyVideo then
  5615. begin
  5616. Application.ProcessMessages;
  5617. Sleep(200);
  5618. tsMyVideoShow(tsMyVideo);
  5619. Application.ProcessMessages;
  5620. end;
  5621. end;
  5622. //------------------------------------------------------------------------------
  5623. procedure TTalkingForm.InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
  5624. const
  5625. CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
  5626. var
  5627. CmdTarget: IOleCommandTarget;
  5628. PtrGUID: PGUID;
  5629. begin
  5630. New(PtrGUID);
  5631. if InvokeIE then
  5632. PtrGUID^ := CLSID_WebBrowser
  5633. else
  5634. PtrGuid := PGUID(nil);
  5635. if WebBrowser.Document <> nil then
  5636. try
  5637. WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget);
  5638. if CmdTarget <> nil then
  5639. try
  5640. CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
  5641. finally
  5642. CmdTarget._Release;
  5643. end;
  5644. except
  5645. end;
  5646. Dispose(PtrGUID);
  5647. end;
  5648. //------------------------------------------------------------------------------
  5649. procedure TTalkingForm.miAddFriendClick(Sender: TObject);
  5650. var
  5651. iIndex: Integer;
  5652. ListItem: TRealICQContacterListItem;
  5653. ADisplayName: string;
  5654. begin
  5655. ADisplayName := '';
  5656. if AnsiSameText(FRealICQClient.LoginName, ALoginName) then
  5657. begin
  5658. //MessageBox(Handle, '不能添加自己为好友! ', '提示', MB_ICONINFORMATION);
  5659. Exit;
  5660. end;
  5661. iIndex := FLVTeamMembers.Items.IndexOf(ALoginName);
  5662. if iIndex > -1 then
  5663. begin
  5664. ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
  5665. ADisplayName := ListItem.DisplayName;
  5666. end;
  5667. ShowAddFriendWindow(Self, ALoginName, ADisplayName);
  5668. end;
  5669. //------------------------------------------------------------------------------
  5670. //添加聊天内容到工单系统
  5671. //------------------------------------------------------------------------------
  5672. procedure TTalkingForm.miAddWorkOrderClick(Sender: TObject);
  5673. begin
  5674. miCopyFromIEClick(nil);
  5675. MainForm.WebBrowserForPostWorkOrder.Navigate('about:blank');
  5676. // TThreadPost.Create(FRealICQClient.WebAppBaseURL+'/PostWordOrder.aspx',ClipBoard.AsText);
  5677. end;
  5678. //------------------------------------------------------------------------------
  5679. procedure TTalkingForm.miCloseMicClick(Sender: TObject);
  5680. begin
  5681. ImgLstForAudio.GetIcon(1, spbMic.Icon);
  5682. TAudioTransmitter.SetSendAudio(False);
  5683. MicrophoneVolume.PeakValue := 0;
  5684. end;
  5685. //------------------------------------------------------------------------------
  5686. procedure TTalkingForm.miOpenMicClick(Sender: TObject);
  5687. begin
  5688. ImgLstForAudio.GetIcon(0, spbMic.Icon);
  5689. TAudioTransmitter.SetSendAudio(True);
  5690. end;
  5691. //------------------------------------------------------------------------------
  5692. procedure TTalkingForm.miCloseSpeakClick(Sender: TObject);
  5693. begin
  5694. ImgLstForAudio.GetIcon(3, spbSpk.Icon);
  5695. TAudioTransmitter.SetRecvAudio(False);
  5696. MasterVolume.PeakValue := 0;
  5697. end;
  5698. //------------------------------------------------------------------------------
  5699. procedure TTalkingForm.miOpenSpeakClick(Sender: TObject);
  5700. begin
  5701. ImgLstForAudio.GetIcon(2, spbSpk.Icon);
  5702. TAudioTransmitter.SetRecvAudio(True);
  5703. end;
  5704. procedure TTalkingForm.miPasteImgClick(Sender: TObject);
  5705. begin
  5706. end;
  5707. //------------------------------------------------------------------------------
  5708. procedure TTalkingForm.miCopyFromIEClick(Sender: TObject);
  5709. var
  5710. vaIn, vaOut: Olevariant;
  5711. begin
  5712. if actSaveImgAs.Enabled then
  5713. begin
  5714. CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + FFaceMenuAtFileName + '">'));
  5715. end
  5716. else
  5717. begin
  5718. InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  5719. end;
  5720. end;
  5721. //----------复制图片到剪贴版------------------------------
  5722. procedure TTalkingForm.miCopyImageClick(Sender: TObject);
  5723. var
  5724. Face: TFace;
  5725. begin
  5726. if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
  5727. Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace
  5728. else
  5729. Face := MainForm.FaceList.Objects[FRightMouseClickedFace.FaceIndex] as TFace;
  5730. CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + Face.FileName + '">'));
  5731. //CopyFilesToClipboard(Face.FileName);
  5732. end;
  5733. //------------------------------------------------------------------------------
  5734. procedure TTalkingForm.miSelAllFromIEClick(Sender: TObject);
  5735. var
  5736. vaIn, vaOut: Olevariant;
  5737. begin
  5738. InvokeCmd(FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  5739. end;
  5740. procedure TTalkingForm.miSendMessageClick(Sender: TObject);
  5741. begin
  5742. if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
  5743. begin
  5744. //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
  5745. Exit;
  5746. end;
  5747. OpenTalkingForm(ALoginName);
  5748. end;
  5749. procedure TTalkingForm.miSendSmsClick(Sender: TObject);
  5750. begin
  5751. OpenSmsForm(ALoginName);
  5752. end;
  5753. //------------------------------------------------------------------------------
  5754. procedure TTalkingForm.miSaveMyVideoImageAsClick(Sender: TObject);
  5755. begin
  5756. SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
  5757. if SaveDialog.Execute then
  5758. begin
  5759. ImgMyVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
  5760. end;
  5761. end;
  5762. procedure TTalkingForm.miSaveToWebClick(Sender: TObject);
  5763. begin
  5764. miCopyFromIEClick(nil);
  5765. Application.ProcessMessages;
  5766. Sleep(100);
  5767. Application.ProcessMessages;
  5768. MainForm.RealICQClient.CallServerDBProcedure('YJ_AddTempRemark', ClipBoard.AsText);
  5769. end;
  5770. //------------------------------------------------------------------------------
  5771. procedure TTalkingForm.miSaveYourVideoImageAsClick(Sender: TObject);
  5772. begin
  5773. SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
  5774. if SaveDialog.Execute then
  5775. begin
  5776. ImgYourVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
  5777. end;
  5778. end;
  5779. //------------------------------------------------------------------------------
  5780. procedure TTalkingForm.miSeeTeamDetailInformationClick(Sender: TObject);
  5781. var
  5782. iIndex: Integer;
  5783. ATeam: TRealICQTeam;
  5784. begin
  5785. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  5786. if ATeam <> nil then
  5787. OpenTeamOptionsForm(ATeam);
  5788. end;
  5789. //------------------------------------------------------------------------------
  5790. procedure TTalkingForm.miSeeUserInformationClick(Sender: TObject);
  5791. begin
  5792. SeeUserInformation(ALoginName);
  5793. end;
  5794. //------------------------------------------------------------------------------
  5795. procedure TTalkingForm.miSeeYourDetailInformationClick(Sender: TObject);
  5796. begin
  5797. SeeUserInformation(Receiver);
  5798. end;
  5799. //------------------------------------------------------------------------------
  5800. procedure TTalkingForm.miShowMyCardClick(Sender: TObject);
  5801. begin
  5802. Application.ProcessMessages;
  5803. Sleep(200);
  5804. (Sender as TMenuItem).Checked := True;
  5805. pgcMyInfo.ActivePageIndex := 1;
  5806. Application.ProcessMessages;
  5807. end;
  5808. //------------------------------------------------------------------------------
  5809. procedure TTalkingForm.miShowMyHeadImageClick(Sender: TObject);
  5810. begin
  5811. Application.ProcessMessages;
  5812. Sleep(200);
  5813. (Sender as TMenuItem).Checked := True;
  5814. pgcMyInfo.ActivePageIndex := 0;
  5815. Application.ProcessMessages;
  5816. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5817. end;
  5818. procedure TTalkingForm.miShowMyVideoClick(Sender: TObject);
  5819. begin
  5820. Application.ProcessMessages;
  5821. Sleep(200);
  5822. (Sender as TMenuItem).Checked := True;
  5823. pgcMyInfo.ActivePageIndex := 2;
  5824. Application.ProcessMessages;
  5825. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5826. end;
  5827. //------------------------------------------------------------------------------
  5828. procedure TTalkingForm.miShowVideoFormClick(Sender: TObject);
  5829. begin
  5830. miShowVideoForm.Checked := not miShowVideoForm.Checked;
  5831. if miShowVideoForm.Checked then
  5832. begin
  5833. miShowYourHeadImageClick(miShowYourHeadImage);
  5834. if VideoForm = nil then
  5835. VideoForm := TVideoForm.Create(Self);
  5836. VideoForm.TalkingForm := Self;
  5837. VideoForm.Show;
  5838. miShowYourVideo.Enabled := False;
  5839. end
  5840. else
  5841. begin
  5842. miShowYourVideoClick(miShowYourVideo);
  5843. FreeAndNil(VideoForm);
  5844. miShowYourVideo.Enabled := True;
  5845. end;
  5846. end;
  5847. //------------------------------------------------------------------------------
  5848. procedure TTalkingForm.UpdateMyInfo;
  5849. var
  5850. GIFImage: TGIFImage;
  5851. begin
  5852. if FRealICQClient.Me = nil then
  5853. Exit;
  5854. Application.ProcessMessages;
  5855. if FileExists(FRealICQClient.Me.HeadImageFile) then
  5856. begin
  5857. try
  5858. if (FRealICQClient.Me.HeadImageFileType = htGIF) then
  5859. begin
  5860. GIFImage := TGIFImage.Create;
  5861. GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
  5862. try
  5863. GIFImage.LoadFromFile(FRealICQClient.Me.HeadImageFile);
  5864. if GIFImage.Animate then
  5865. ImgHeadForMyInfo.Picture.Assign(GIFImage)
  5866. else
  5867. ImgHeadForMyInfo.Picture.Bitmap.Assign(GIFImage);
  5868. finally
  5869. GIFImage.Free;
  5870. end;
  5871. end
  5872. else
  5873. ImgHeadForMyInfo.Picture.LoadFromFile(FRealICQClient.Me.HeadImageFile);
  5874. except
  5875. ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  5876. end;
  5877. end
  5878. else
  5879. begin
  5880. ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  5881. end;
  5882. cardMine.IsSeeRight := True;
  5883. cardMine.RealICQUser := FRealICQClient.Me;
  5884. // FRealICQClient.GetUserExInformation(cardMine.RealICQUser.LoginName);
  5885. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  5886. end;
  5887. procedure TTalkingForm.UpdateAliasClick(Sender: TObject);
  5888. var
  5889. AliasName: string;
  5890. begin
  5891. AliasName := ShowMyInputBox('更改别名', '请输入您喜欢的别名', '', 20);
  5892. if AliasName <> '' then
  5893. TTeamsAdapter.SetAlias(FTeamID, ALoginName, AliasName);
  5894. end;
  5895. //------------------------------------------------------------------------------
  5896. procedure TTalkingForm.UpdateTeamMember(ARealICQUser: TRealICQUser);
  5897. var
  5898. ItemIndex: Integer;
  5899. AListItem: TRealICQContacterListItem;
  5900. AAlias: string;
  5901. begin
  5902. ItemIndex := FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName);
  5903. if ItemIndex = -1 then
  5904. Exit;
  5905. AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5906. // MainForm.BindUserDataToItem(AListItem, ARealICQUser);
  5907. //TODO 解决第一次都是LoginName的问题
  5908. AAlias := TTeamsAdapter.GetAlias(FTeamID, AListItem.LoginName);
  5909. if AAlias = '' then
  5910. AAlias := ARealICQUser.DisplayName;
  5911. MainForm.BindUserDataToItemForGroup(AListItem, ARealICQUser, AAlias);
  5912. lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
  5913. //FLVTeamMembers.Invalidate;
  5914. end;
  5915. //------------------------------------------------------------------------------
  5916. procedure TTalkingForm.UpdateTeamMembers;
  5917. var
  5918. iIndex, ItemIndex, iLoop: Integer;
  5919. LoginName: string;
  5920. MemberList: TStringList;
  5921. // ATeam: TRealICQTeam;
  5922. ATeam: TRealICQTeam;
  5923. RealICQUser: TRealICQUser;
  5924. AListItem: TRealICQContacterListItem;
  5925. TeamName, AGroupAlias: string;
  5926. ActionGetMembers: TAsynGetTeamMembers;
  5927. begin
  5928. { iIndex := FRealICQClient.Teams.IndexOf(FTeamID);
  5929. if iIndex = -1 then Exit;
  5930. ATeam := FRealICQClient.Teams.Objects[iIndex] as TRealICQTeam; }
  5931. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  5932. MemberList := SplitString(ATeam.TeamMembers, Chr(10));
  5933. ActionGetMembers := TAsynGetTeamMembers.Create(Self, MemberList);
  5934. { try
  5935. for iLoop := 0 to MemberList.Count - 1 do
  5936. begin
  5937. LoginName := Trim(MemberList[iLoop]);
  5938. if Length(LoginName) = 0 then continue;
  5939. AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
  5940. RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
  5941. if not Assigned(RealICQUser) then continue;
  5942. //TODO: 获取手机信息和用户状态
  5943. // if Trim(RealICQUser.DisplayName)='' then
  5944. // MainForm.RealICQClient.GetUserInformation(LoginName,True)
  5945. // else
  5946. // MainForm.RealICQClient.GetUserLoginState(LoginName);
  5947. // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
  5948. // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
  5949. ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  5950. if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
  5951. AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5952. if Trim(AGroupAlias)='' then
  5953. MainForm.BindUserDataToItem(AListItem, RealICQUser)
  5954. else
  5955. MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
  5956. end;
  5957. ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
  5958. for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
  5959. begin
  5960. LoginName := FLVTeamMembers.Items[iLoop];
  5961. if MemberList.IndexOf(LoginName) = -1 then
  5962. begin
  5963. FLVTeamMembers.Items.Delete(iLoop);
  5964. end;
  5965. end;
  5966. finally
  5967. MemberList.Free;
  5968. end; }
  5969. // try
  5970. // for iLoop := 0 to MemberList.Count - 1 do
  5971. // begin
  5972. // LoginName := Trim(MemberList[iLoop]);
  5973. // if Length(LoginName) = 0 then continue;
  5974. // AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
  5975. //
  5976. // RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
  5977. // if not Assigned(RealICQUser) then continue;
  5978. // //TODO: 获取手机信息和用户状态
  5979. // if Trim(RealICQUser.DisplayName)='' then
  5980. // MainForm.RealICQClient.GetUserInformation(LoginName,True)
  5981. // else
  5982. // MainForm.RealICQClient.GetUserLoginState(LoginName);
  5983. // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
  5984. // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
  5985. //
  5986. // ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  5987. // if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
  5988. // AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5989. // if Trim(AGroupAlias)='' then
  5990. // MainForm.BindUserDataToItem(AListItem, RealICQUser)
  5991. // else
  5992. // MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
  5993. // end;
  5994. // //ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
  5995. // for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
  5996. // begin
  5997. // LoginName := FLVTeamMembers.Items[iLoop];
  5998. // if MemberList.IndexOf(LoginName) = -1 then
  5999. // begin
  6000. // FLVTeamMembers.Items.Delete(iLoop);
  6001. // end;
  6002. // end;
  6003. // finally
  6004. // MemberList.Free;
  6005. // end;
  6006. if ATeam.TeamCaption = '' then
  6007. TeamName := ATeam.TeamID
  6008. else
  6009. TeamName := ATeam.TeamCaption;
  6010. if ATeam.IsTempTeam then
  6011. TeamName := '多人会话'
  6012. else
  6013. TeamName := TeamName + ' - 群组会话';
  6014. Caption := TeamName;
  6015. lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
  6016. end;
  6017. //------------------------------------------------------------------------------
  6018. procedure TTalkingForm.SetTeamID(Value: string);
  6019. var
  6020. iIndex: Integer;
  6021. ATeam: TRealICQTeam;
  6022. begin
  6023. //SpbEncryMessage.Visible := False;
  6024. //chkEncryMessage.Visible := False;
  6025. spbEncryMsg.Visible := False;
  6026. spbNormalMsg.Visible := False;
  6027. //spbUploadFile.Caption:='群发文件';
  6028. spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
  6029. //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
  6030. miSeeTeamDetailInformation.Visible := True;
  6031. miSeeYourDetailInformation.Visible := False;
  6032. miShowYourHeadImage.Visible := False;
  6033. miShowYourCard.Visible := False;
  6034. actSendFile.Visible := False;
  6035. actAudio.Visible := False;
  6036. actVideo.Visible := False;
  6037. actSeeTeamOptions.Visible := True;
  6038. actQuitTeam.Visible := False;
  6039. actDisbandTeam.Visible := False;
  6040. spbSendFile.Visible := False;
  6041. spbAudio.Visible := False;
  6042. spbVideo.Visible := False;
  6043. spbRemoteControl.Visible := False;
  6044. spbSendFolder.Visible := False;
  6045. spbUserInfo.Visible := False;
  6046. spbPostSMS.Visible := False;
  6047. spbSeeTeamOptions.Visible := True;
  6048. spbAddUser.Visible := True;
  6049. spbQuitTeam.Visible := False;
  6050. spbDisbandTeam.Visible := False;
  6051. spbSendSMS.Visible := True;
  6052. pnlYourInfo.Visible := False;
  6053. // pnlMyInfo.Visible := False;
  6054. pnlTeamCallBoard.Visible := True;
  6055. pnlTeamMembers.Visible := True;
  6056. spbShakeWindow.Visible := False;
  6057. spbCopyScreen.left := spbShakeWindow.left;
  6058. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6059. btnQR.Visible := False;
  6060. spbSet.left := spbQuitTeam.left + spbQuitTeam.Width + 3;
  6061. spbAbout.left := spbSet.left + spbSet.Width;
  6062. if PnlTeamWebDisk.Visible then
  6063. begin
  6064. pnlTeamCallBoard.Visible := False;
  6065. pnlTeamMembers.Visible := False;
  6066. end
  6067. else
  6068. PnlTeamWebDisk.Visible := False;
  6069. //spbUploadFile.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
  6070. spbUploadFile.Visible := False;
  6071. //spbTeamNetWorkDisk.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
  6072. spbTeamNetWorkDisk.Caption := '群文件';
  6073. FTeamID := Value;
  6074. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  6075. if ATeam = nil then
  6076. begin
  6077. Caption := FTeamID + ' - 群组对话';
  6078. Log(Format('找不到群ID为%s的群', [FTeamID]), 'SetTeamID');
  6079. Exit;
  6080. end;
  6081. spbTeamNetWorkDisk.Visible := not ATeam.IsTempTeam;
  6082. if FLVTeamMembers.Tag = 0 then
  6083. begin
  6084. {$region '生成显示群组成员列表的ListView'}
  6085. if (FMinWidthOfMyPanel <= 200) then
  6086. pnlTeamMembers.Width := 200;
  6087. FMinWidthOfYourPanel := 200;
  6088. MainForm.UpdateContacterListView(FLVTeamMembers);
  6089. FLVTeamMembers.OnItemOnline := nil;
  6090. FLVTeamMembers.OnItemOffline := nil;
  6091. FLVTeamMembers.PopupMenu := ppUserItemRightMenu;
  6092. FLVTeamMembers.Style := lsSmallHeadImage;
  6093. FLVTeamMembers.CaptionStyle := csDisplayName;
  6094. FLVTeamMembers.OnItemMouseEnter := nil;
  6095. FLVTeamMembers.OnItemMouseLeave := nil;
  6096. FLVTeamMembers.OnItemIconButtonClick := nil;
  6097. //FLVTeamMembers.OnItemIconButtonDblClick := nil;
  6098. FLVTeamMembers.ShowHeadImageButton := True;
  6099. FLVTeamMembers.ChangeUIColor(FWindowColor);
  6100. FLVTeamMembers.Tag := 1;
  6101. {$endregion}
  6102. end;
  6103. UpdateTeamMembers;
  6104. actDisbandTeam.Visible := AnsiSameText(ATeam.TeamCreater, FRealICQClient.LoginName);
  6105. actQuitTeam.Visible := not actDisbandTeam.Visible;
  6106. spbQuitTeam.Visible := actQuitTeam.Visible;
  6107. spbDisbandTeam.Visible := actDisbandTeam.Visible;
  6108. mmTeamCallBoard.Text := Trim(ATeam.TeamCallBoard);
  6109. //spbSendImage.Left := spbShakeWindow.Left;
  6110. //spbCopyScreen.Left := spbSendImage.Left + spbSendImage.Width + 3;
  6111. //spbCopyScreen2.Left := spbCopyScreen.Left + spbCopyScreen.Width + 3;
  6112. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6113. PostMessage(Handle, WM_SIZE, 0, 0);
  6114. end;
  6115. procedure TTalkingForm.SetReceiver(Value: string);
  6116. var
  6117. UserName: WideString;
  6118. FRealICQUser: TRealICQUser;
  6119. GIFImage: TGIFImage;
  6120. ServerId: string;
  6121. iPos: Integer;
  6122. begin
  6123. //SpbEncryMessage.Visible := True;
  6124. //chkEncryMessage.Visible := True;
  6125. spbEncryMsg.Visible := False;
  6126. spbNormalMsg.Visible := True;
  6127. //spbUploadFile.Caption:='离线文件';
  6128. // MainForm.RealICQClient.GetUserExInformation(Value);
  6129. spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
  6130. //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
  6131. FReceiver := Value;
  6132. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  6133. if not Assigned(FRealICQUser) then
  6134. Exit;
  6135. if FRealICQUser.LoginAtWeb then
  6136. begin
  6137. miSeeTeamDetailInformation.Visible := False;
  6138. miSeeYourDetailInformation.Visible := True;
  6139. miShowYourHeadImage.Visible := True;
  6140. miShowYourCard.Visible := True;
  6141. actSendFile.Enabled := False;
  6142. actAudio.Enabled := False;
  6143. actVideo.Enabled := False;
  6144. actSeeTeamOptions.Visible := False;
  6145. actQuitTeam.Visible := False;
  6146. actDisbandTeam.Visible := False;
  6147. spbSendFile.Enabled := False;
  6148. spbAudio.Enabled := False;
  6149. spbVideo.Enabled := False;
  6150. spbUploadFile.Enabled := False;
  6151. spbRemoteControl.Enabled := False;
  6152. spbSendFolder.Enabled := False;
  6153. spbSendImage.Visible := False;
  6154. spbCopyScreen.Visible := False;
  6155. //spbCopyScreen2.Visible := False;
  6156. spbSeeTeamOptions.Visible := False;
  6157. spbAddUser.Visible := False;
  6158. spbQuitTeam.Visible := False;
  6159. spbDisbandTeam.Visible := False;
  6160. pnlYourInfo.Visible := True;
  6161. // pnlMyInfo.Visible := True;
  6162. pnlTeamCallBoard.Visible := False;
  6163. pnlTeamMembers.Visible := False;
  6164. spbShakeWindow.Visible := True;
  6165. btnQR.Visible := True;
  6166. spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
  6167. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6168. spbSet.left := spbAudio.left + spbAudio.Width;
  6169. btnQR.left := spbSet.left + spbSet.Width + 2;
  6170. spbAbout.left := btnQR.left + btnQR.Width + 2;
  6171. end
  6172. else
  6173. begin
  6174. miSeeTeamDetailInformation.Visible := False;
  6175. miSeeYourDetailInformation.Visible := True;
  6176. miShowYourHeadImage.Visible := True;
  6177. miShowYourCard.Visible := True;
  6178. actSendFile.Visible := True;
  6179. actAudio.Visible := True;
  6180. actVideo.Visible := True;
  6181. actSeeTeamOptions.Visible := False;
  6182. actQuitTeam.Visible := False;
  6183. actDisbandTeam.Visible := False;
  6184. spbSendFile.Visible := True;
  6185. spbAudio.Visible := True;
  6186. spbVideo.Visible := True;
  6187. spbRemoteControl.Visible := True;
  6188. spbSendFolder.Visible := True;
  6189. spbUserInfo.Visible := True;
  6190. spbPostSMS.Visible := True;
  6191. spbSeeTeamOptions.Visible := False;
  6192. spbAddUser.Visible := False;
  6193. spbQuitTeam.Visible := False;
  6194. spbDisbandTeam.Visible := False;
  6195. pnlYourInfo.Visible := True;
  6196. // pnlMyInfo.Visible := True;
  6197. pnlTeamCallBoard.Visible := False;
  6198. pnlTeamMembers.Visible := False;
  6199. spbShakeWindow.Visible := True;
  6200. btnQR.Visible := True;
  6201. spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
  6202. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6203. spbSet.left := spbAudio.left + spbAudio.Width;
  6204. btnQR.left := spbSet.left + spbSet.Width + 2;
  6205. spbAbout.left := btnQR.left + btnQR.Width + 2;
  6206. end;
  6207. PnlTeamWebDisk.Visible := False;
  6208. spbTeamNetWorkDisk.Visible := False;
  6209. if FileExists(FRealICQUser.HeadImageFile) then
  6210. begin
  6211. try
  6212. if (FRealICQUser.HeadImageFileType = htGIF) then
  6213. begin
  6214. GIFImage := TGIFImage.Create;
  6215. GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
  6216. try
  6217. GIFImage.LoadFromFile(FRealICQUser.HeadImageFile);
  6218. if GIFImage.Animate then
  6219. ImgHeadForYourInfo.Picture.Assign(GIFImage)
  6220. else
  6221. ImgHeadForYourInfo.Picture.Bitmap.Assign(GIFImage);
  6222. finally
  6223. GIFImage.Free;
  6224. end;
  6225. end
  6226. else
  6227. ImgHeadForYourInfo.Picture.LoadFromFile(FRealICQUser.HeadImageFile);
  6228. except
  6229. ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  6230. end;
  6231. end
  6232. else
  6233. begin
  6234. ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  6235. end;
  6236. TimerForGetUserInformation.Enabled := True;
  6237. if FRealICQUser.DisplayName = '' then
  6238. begin
  6239. UserName := FRealICQUser.LoginName;
  6240. end
  6241. else
  6242. UserName := FRealICQUser.DisplayName;
  6243. Caption := UserName;
  6244. iPos := AnsiPos('-', FRealICQUser.LoginName);
  6245. ServerId := Copy(FRealICQUser.LoginName, 1, iPos - 1);
  6246. if AnsiPos('+', ServerId) > 0 then
  6247. begin
  6248. ServerId := Copy(ServerId, AnsiPos('+', ServerId) + 1, Length(ServerId));
  6249. end;
  6250. cardYour.CompanyName := FRealICQUser.Company;
  6251. cardYour.BranchName := FRealICQUser.Branch;
  6252. // if Trim(FRealICQUser.Company)='' then cardYour.CompanyName:=MainForm.GetCompany;
  6253. // if Trim(FRealICQUser.Branch)='' then cardYour.BranchName:=MainForm.GetBranchName(FRealICQUser.LoginName);
  6254. if TConditionConfig.GetConfig.UserInfoController then
  6255. begin
  6256. cardYour.IsSeeRight := (ServerId = MainForm.RealICQClient.ServerID);
  6257. if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slAllCannotSee) then
  6258. begin
  6259. cardYour.IsSeeRight := False;
  6260. end;
  6261. if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slOnlyFriendCanSee) and not (TUsersService.GetUsersService.IsWorkmateOrFriend(FRealICQUser.LoginName)) then
  6262. begin
  6263. cardYour.IsSeeRight := False;
  6264. end;
  6265. end
  6266. else
  6267. cardYour.IsSeeRight := True;
  6268. cardYour.RealICQUser := FRealICQUser;
  6269. //FRealICQClient.GetUserExInformation(cardYour.RealICQUser.LoginName);
  6270. if FRealICQClient.Logined and FRealICQClient.Connected then
  6271. begin
  6272. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := nil;
  6273. //(FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := P2PTypeChanged;
  6274. //P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
  6275. end
  6276. else
  6277. begin
  6278. //lblState.Caption := '连接方式: 服务器中转';
  6279. end;
  6280. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6281. PostMessage(Handle, WM_SIZE, 0, 0);
  6282. if FVCardFrom.pb1.Parent = FVCardFrom then
  6283. begin
  6284. FVCardFrom.pb1.Parent := Self.pnlUserInformation;
  6285. FVCardFrom.pb1.Align := alTop;
  6286. FVCardFrom.pb1.Height := Self.pnlUserInformation.Width;
  6287. pnlYourInfo.Top := 0;
  6288. end;
  6289. FVCardFrom.LoginName := FReceiver;
  6290. end;
  6291. function RoundEx(R: Real): Integer;
  6292. begin
  6293. Result := Trunc(R);
  6294. if Frac(R) >= 0.5 then
  6295. Result := Result + 1;
  6296. end;
  6297. //-----设置LblSendSMS的位置----------------------------------
  6298. procedure TTalkingForm.SetLblSendSMSPosition(HIntMsg: string);
  6299. var
  6300. iPos, TextWidth, Rows: integer;
  6301. SubStr: string;
  6302. chrWidth: Integer;
  6303. begin
  6304. iPos := AnsiPos('手机短信', HIntMsg);
  6305. chrWidth := LblHint.Canvas.TextWidth('发');
  6306. SubStr := Copy(HIntMsg, 1, iPos);
  6307. TextWidth := LblHint.Canvas.TextWidth(SubStr + '手机短信');
  6308. if TextWidth <= LblHint.Width then
  6309. begin
  6310. LblSendSMS.Caption := '手机短信';
  6311. LblSendSMS.Left := LblHint.Left + LblHint.Canvas.TextWidth(SubStr) - 5;
  6312. LblSendSMS.Top := LblHint.Top - 1;
  6313. LblSendSMS1.Visible := false;
  6314. end
  6315. else
  6316. begin
  6317. Rows := TextWidth div LblHint.Width;
  6318. iPos := LblHint.Width * Rows - LblHint.Canvas.TextWidth(SubStr);
  6319. if iPos < (chrWidth div 2) then
  6320. begin
  6321. LblSendSMS.Caption := '手机短信';
  6322. if abs(iPos) < (chrWidth div 2) then
  6323. LblSendSMS.Left := lblHint.Left
  6324. else
  6325. begin
  6326. iPos := RoundEx(abs(iPos) / chrWidth);
  6327. LblSendSMS.Left := lblHint.Left + iPos * chrWidth;
  6328. end;
  6329. LblSendSMS.Top := LblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * (Rows);
  6330. LblSendSMS1.Visible := false;
  6331. end
  6332. else
  6333. begin
  6334. iPos := RoundEx(iPos / chrWidth);
  6335. LblSendSMS.Caption := Copy('手机短信', 1, iPos * 2);
  6336. LblSendSMS.Left := lblHint.Left + lblHint.Canvas.TextWidth(SubStr) - 5;
  6337. LblSendSMS.Top := lblHint.Top - 1;
  6338. LblSendSMS1.Caption := Copy('手机短信', iPos * 2 + 1, Length('手机短信') - iPos * 2);
  6339. LblSendSMS1.Left := lblHint.Left;
  6340. LblSendSMS1.Top := lblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * Rows;
  6341. LblSendSMS1.BringToFront;
  6342. LblSendSMS1.Visible := True;
  6343. end;
  6344. end;
  6345. LblSendSMS.BringToFront;
  6346. end;
  6347. //------------------------------------------------------------------------------
  6348. procedure TTalkingForm.pnlDisplayerResize(Sender: TObject);
  6349. var
  6350. UserName, TeamName, AStateMsg, HIntMsg, HDestIntMsg: WideString;
  6351. FRealICQUser: TRealICQUser;
  6352. iIndex: Integer;
  6353. ATeam: TRealICQTeam;
  6354. begin
  6355. FRealICQUser := nil;
  6356. if FRealICQClient = nil then
  6357. Exit;
  6358. if FCategory = tcNormal then
  6359. begin
  6360. {$region '一对一的对话窗口'}
  6361. if Length(FReceiver) = 0 then
  6362. Exit;
  6363. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
  6364. if Assigned(FRealICQUser) then
  6365. begin
  6366. if FRealICQUser.DisplayName = '' then
  6367. UserName := FRealICQUser.LoginName
  6368. else
  6369. UserName := FRealICQUser.DisplayName;
  6370. if (FRealICQUser.LoginState = stLeave) or (FRealICQUser.LoginState = stBusy) then
  6371. AStateMsg := FRealICQUser.LeaveMessage
  6372. else
  6373. AStateMsg := StateValues[Integer(FRealICQUser.LoginState) mod 5];
  6374. if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
  6375. HDestIntMsg := '发送至: ' + UserName + '(出差)'
  6376. else if FRealICQUser.Watchword = '' then
  6377. HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ')'
  6378. else
  6379. HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ') - ' + FRealICQUser.Watchword;
  6380. end
  6381. else //这种情况是与服务器的连接已断开了
  6382. begin
  6383. HDestIntMsg := LblDest.Hint;
  6384. end;
  6385. {$endregion}
  6386. end
  6387. else
  6388. begin
  6389. {$region '群组模式对话窗体'}
  6390. if Length(Trim(FTeamID)) <= 0 then
  6391. Exit;
  6392. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  6393. if ATeam = nil then //这种情况是与服务器的连接已断开了,或不再是这个群的成员了
  6394. begin
  6395. HDestIntMsg := LblDest.Hint;
  6396. Log('与服务器的连接已断开了,或不再是这个群的成员', 'TTalkingForm.pnlDisplayerResize');
  6397. end
  6398. else
  6399. begin
  6400. if ATeam.TeamCaption = '' then
  6401. TeamName := ATeam.TeamID
  6402. else
  6403. TeamName := ATeam.TeamCaption;
  6404. if ATeam.IsTempTeam then
  6405. TeamName := '多人对话'
  6406. else
  6407. TeamName := TeamName + '(群组对话)';
  6408. if ATeam.TeamIntro = '' then
  6409. HDestIntMsg := '参与群组: ' + TeamName
  6410. else
  6411. HDestIntMsg := '参与群组: ' + TeamName + ' - ' + AnsiReplaceStr(ATeam.TeamIntro, #$D#$A, ' ');
  6412. end;
  6413. {$endregion}
  6414. end;
  6415. {$region '相关提示信息'}
  6416. pnlClient.Enabled := True;
  6417. if (FRealICQClient.Me = nil) then
  6418. begin
  6419. AStateMsg := StateValues[Integer(stOffline)];
  6420. HIntMsg := '您当前处于“' + AStateMsg + '”状态,不能发送任何消息!';
  6421. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6422. // pnlHint.Visible := True;
  6423. pnlClient.Enabled := False;
  6424. end
  6425. else if FCategory = tcNormal then
  6426. begin
  6427. if FRealICQClient.Blacklists.IndexOf(FRealICQUser.LoginName) >= 0 then
  6428. begin
  6429. //检查是否在黑名单列表中
  6430. HIntMsg := '该用户已列入黑名单,将无法收到任何消息!';
  6431. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6432. // pnlHint.Visible := True;
  6433. end
  6434. else if FRealICQUser.LoginState <> stOnline then
  6435. begin
  6436. if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
  6437. HIntMsg := '对方处于“出差”状态,您可以发送手机短信联系他 - ' + FRealICQUser.OfflineAutoResponseText
  6438. else
  6439. HIntMsg := '对方处于“' + AStateMsg + '”状态,' + '您可以发送手机短信联系他。';
  6440. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6441. // pnlHint.Visible := True;
  6442. SetLblSendSMSPosition(HIntMsg);
  6443. end
  6444. else
  6445. pnlHint.Visible := False;
  6446. end
  6447. else if FCategory = tcTeam then
  6448. begin
  6449. if TTeamsAdapter.GetTeam(FTeamID) = nil then
  6450. begin
  6451. HIntMsg := '您已不是群组“' + Caption + '”的成员,不能收发任何消息!';
  6452. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6453. LblHint.Caption := HIntMsg;
  6454. pnlHint.Height := LblHint.Height + 10;
  6455. // pnlHint.Visible := True;
  6456. pnlClient.Enabled := False;
  6457. end
  6458. else
  6459. pnlHint.Visible := False;
  6460. end
  6461. else
  6462. pnlHint.Visible := False;
  6463. if (pnlHint.Visible = False) and (FRealICQClient.Me.LoginState <> stOnline) then
  6464. begin
  6465. if (FRealICQClient.Me.LoginState = stLeave) or (FRealICQClient.Me.LoginState = stBusy) then
  6466. AStateMsg := FRealICQClient.Me.LeaveMessage
  6467. else
  6468. AStateMsg := StateValues[Integer(FRealICQClient.Me.LoginState)];
  6469. HIntMsg := '您的当前状态为:' + AStateMsg;
  6470. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6471. // pnlHint.Visible := True;
  6472. end;
  6473. LblHint.Caption := HIntMsg;
  6474. pnlHint.Height := LblHint.Height + 10;
  6475. {$endregion}
  6476. {$region '消息接收方信息'}
  6477. LblDest.Hint := HDestIntMsg;
  6478. LblDest.ShowHint := False;
  6479. //字符串长度过长时,截短字符串并在后面显示“...”
  6480. while LblDest.Canvas.TextWidth(HDestIntMsg) > LblDest.Width do
  6481. begin
  6482. if Length(HDestIntMsg) > 3 then
  6483. begin
  6484. if Copy(HDestIntMsg, Length(HDestIntMsg) - 2, Length(HDestIntMsg)) = '...' then
  6485. HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 3);
  6486. HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 1) + '...';
  6487. end
  6488. else
  6489. break;
  6490. LblDest.ShowHint := True;
  6491. end;
  6492. LblDest.Caption := HDestIntMsg;
  6493. {$endregion}
  6494. end;
  6495. procedure TTalkingForm.pnlTalkingAreaClick(Sender: TObject);
  6496. begin
  6497. end;
  6498. //------------------------------------------------------------------------------
  6499. function GetTalkingFormCount: Integer;
  6500. begin
  6501. Result := TalkingForms.Count;
  6502. end;
  6503. //------------------------------------------------------------------------------
  6504. procedure CloseAllTalkingForm;
  6505. var
  6506. AForm: TTalkingForm;
  6507. begin
  6508. while TalkingForms.Count > 0 do
  6509. begin
  6510. AForm := TalkingForms[0];
  6511. FreeAndNil(AForm);
  6512. end;
  6513. end;
  6514. //------------------------------------------------------------------------------
  6515. procedure UpdateAllTakingFormGIFHeadImage;
  6516. var
  6517. iLoop: Integer;
  6518. AForm: TTalkingForm;
  6519. FRealICQUser: TRealICQUser;
  6520. begin
  6521. for iLoop := TalkingForms.Count - 1 downto 0 do
  6522. begin
  6523. AForm := TalkingForms[iLoop];
  6524. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(AForm.FReceiver);
  6525. if Assigned(FRealICQUser) then
  6526. begin
  6527. if FRealICQUser.HeadImageFileType = htGIF then
  6528. AForm.SetReceiver(AForm.FReceiver);
  6529. end;
  6530. if AForm.FRealICQClient.Me.HeadImageFileType = htGIF then
  6531. begin
  6532. AForm.UpdateMyInfo;
  6533. end;
  6534. end;
  6535. end;
  6536. procedure UpdateAllTakingFormHotKeySet;
  6537. var
  6538. iLoop: Integer;
  6539. AForm: TTalkingForm;
  6540. begin
  6541. for iLoop := TalkingForms.Count - 1 downto 0 do
  6542. begin
  6543. AForm := TalkingForms[iLoop];
  6544. AForm.actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage;
  6545. AForm.actEnter.Checked := not MainForm.CtrlEnterSendMessage;
  6546. end;
  6547. end;
  6548. //------------------------------------------------------------------------------
  6549. procedure SetAllTakingFormEnabledState(AEnableValue: Boolean);
  6550. var
  6551. iLoop: Integer;
  6552. AForm: TTalkingForm;
  6553. begin
  6554. for iLoop := TalkingForms.Count - 1 downto 0 do
  6555. begin
  6556. AForm := TalkingForms[iLoop];
  6557. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6558. begin
  6559. FreeAndNil(AForm);
  6560. continue;
  6561. end;
  6562. PostMessage(AForm.pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6563. AForm.pnlClient.Enabled := AEnableValue;
  6564. if not AEnableValue then
  6565. AForm.CancelAllSendFile;
  6566. end;
  6567. end;
  6568. //------------------------------------------------------------------------------
  6569. procedure SetTalkingFormPosition(APrevForm, ATalkingForm: TTalkingForm; AShowActive: Boolean);
  6570. begin
  6571. if APrevForm <> nil then
  6572. begin
  6573. ATalkingForm.Left := APrevForm.Left + 20;
  6574. ATalkingForm.Top := APrevForm.Top + 20;
  6575. if (ATalkingForm.Left + ATalkingForm.Width > Screen.WorkAreaWidth) or (ATalkingForm.Top + ATalkingForm.Height > Screen.WorkAreaHeight) then
  6576. begin
  6577. ATalkingForm.Left := 0;
  6578. ATalkingForm.Top := 0;
  6579. end;
  6580. end
  6581. else
  6582. begin
  6583. //TalkingForm.Left := (Screen.WorkAreaWidth - TalkingForm.Width) div 2;
  6584. //TalkingForm.Top := (Screen.WorkAreaHeight - TalkingForm.Height) div 2;
  6585. end;
  6586. if AShowActive then
  6587. ATalkingForm.WindowState := wsNormal
  6588. else
  6589. ATalkingForm.WindowState := wsMinimized;
  6590. ATalkingForm.Show;
  6591. if AShowActive then
  6592. begin
  6593. ShowWindow(ATalkingForm.Handle, SW_SHOW);
  6594. ForceForeGroundWindow(ATalkingForm.Handle);
  6595. end;
  6596. end;
  6597. //------------------------------------------------------------------------------
  6598. procedure UpdateTalkingForm(ARealICQUser: TRealICQUser);
  6599. var
  6600. iLoop: Integer;
  6601. AForm: TTalkingForm;
  6602. begin
  6603. for iLoop := TalkingForms.Count - 1 downto 0 do
  6604. begin
  6605. AForm := TalkingForms[iLoop];
  6606. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6607. FreeAndNil(AForm)
  6608. else
  6609. AForm.UpdateMyInfo;
  6610. if AForm.FCategory = tcNormal then
  6611. begin
  6612. if (AForm.FReceiver = ARealICQUser.LoginName) then
  6613. begin
  6614. AForm.SetReceiver(ARealICQUser.LoginName);
  6615. end;
  6616. end
  6617. else
  6618. begin
  6619. if AForm.FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName) >= 0 then
  6620. begin
  6621. AForm.UpdateTeamMember(ARealICQUser);
  6622. end;
  6623. end;
  6624. end;
  6625. end;
  6626. //------------------------------------------------------------------------------
  6627. function GetTalkingForm(AReceiver: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6628. var
  6629. iLoop: Integer;
  6630. TalkingForm: TTalkingForm;
  6631. RealICQClient: TRealICQClient;
  6632. begin
  6633. Result := nil;
  6634. if ARealICQClient = nil then
  6635. RealICQClient := MainForm.RealICQClient
  6636. else
  6637. RealICQClient := ARealICQClient;
  6638. for iLoop := 0 to TalkingForms.Count - 1 do
  6639. begin
  6640. TalkingForm := TalkingForms[iLoop];
  6641. if TalkingForm.FCategory <> tcNormal then
  6642. Continue;
  6643. if AnsiSameText(TalkingForm.Receiver, AReceiver) and (TalkingForm.FRealICQClient = RealICQClient) then
  6644. begin
  6645. Result := TalkingForm;
  6646. Exit;
  6647. end;
  6648. end;
  6649. end;
  6650. //------------------------------------------------------------------------------
  6651. procedure ChangeTalkingFormVisible(AVisible: Boolean);
  6652. var
  6653. iLoop: Integer;
  6654. AForm: TTalkingForm;
  6655. begin
  6656. for iLoop := 0 to TalkingForms.Count - 1 do
  6657. begin
  6658. AForm := TalkingForms[iLoop];
  6659. AForm.Visible := AVisible;
  6660. if AVisible then
  6661. end;
  6662. end;
  6663. //------------------------------------------------------------------------------
  6664. function OpenTalkingForm(AReceiver: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6665. var
  6666. iLoop: Integer;
  6667. AForm, TalkingForm: TTalkingForm;
  6668. begin
  6669. // if MainForm.RealICQClient.Friends.IndexOf(AReceiver)<0 then
  6670. MainForm.RealICQClient.GetUserLoginState(AReceiver);
  6671. AForm := nil;
  6672. Result := nil;
  6673. if OpenningTalkingForm then
  6674. Exit;
  6675. try
  6676. OpenningTalkingForm := True;
  6677. for iLoop := 0 to TalkingForms.Count - 1 do
  6678. begin
  6679. AForm := TalkingForms[iLoop];
  6680. if AForm.FCategory <> tcNormal then
  6681. Continue;
  6682. if AnsiSameText(AForm.Receiver, AReceiver) then
  6683. begin
  6684. if AShowActive then
  6685. ForceForeGroundWindow(AForm.Handle);
  6686. Result := AForm;
  6687. Exit;
  6688. end;
  6689. end;
  6690. TalkingForm := TTalkingForm.Create(MainForm);
  6691. TalkingForm.FCategory := tcNormal;
  6692. if ARealICQClient = nil then
  6693. TalkingForm.FRealICQClient := MainForm.RealICQClient
  6694. else
  6695. TalkingForm.FRealICQClient := ARealICQClient;
  6696. TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
  6697. TalkingForm.Receiver := AReceiver;
  6698. TalkingForm.UpdateMyInfo;
  6699. TalkingForm.LoadWindowColor;
  6700. TalkingForm.LoadBackGround;
  6701. SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
  6702. Result := TalkingForm;
  6703. finally
  6704. OpenningTalkingForm := False;
  6705. end;
  6706. MainForm.HideMainForm;
  6707. end;
  6708. //------------------------------------------------------------------------------
  6709. function OpenTeamTalkingForm(ATeamID: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6710. var
  6711. iLoop: Integer;
  6712. AForm, TalkingForm: TTalkingForm;
  6713. begin
  6714. AForm := nil;
  6715. Result := nil;
  6716. if OpenningTalkingForm then
  6717. Exit;
  6718. try
  6719. OpenningTalkingForm := True;
  6720. for iLoop := 0 to TalkingForms.Count - 1 do
  6721. begin
  6722. AForm := TalkingForms[iLoop];
  6723. if AForm.FCategory <> tcTeam then
  6724. Continue;
  6725. if AForm.FTeamID = ATeamID then
  6726. begin
  6727. if AShowActive then
  6728. ForceForeGroundWindow(AForm.Handle);
  6729. Result := AForm;
  6730. Exit;
  6731. end;
  6732. end;
  6733. //Dialogs.ShowMessage('TTalkingForm.Create');
  6734. TalkingForm := TTalkingForm.Create(MainForm);
  6735. //Dialogs.ShowMessage('TTalkingForm.Created');
  6736. TalkingForm.FCategory := tcTeam;
  6737. if ARealICQClient = nil then
  6738. TalkingForm.FRealICQClient := MainForm.RealICQClient
  6739. else
  6740. TalkingForm.FRealICQClient := ARealICQClient;
  6741. TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
  6742. TalkingForm.TeamID := ATeamID;
  6743. TalkingForm.UpdateMyInfo;
  6744. TalkingForm.LoadWindowColor;
  6745. TalkingForm.LoadBackGround;
  6746. SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
  6747. Result := TalkingForm;
  6748. finally
  6749. OpenningTalkingForm := False;
  6750. TTeamsAdapter.MessageMiscMust(ATeamID);
  6751. end;
  6752. MainForm.HideMainForm;
  6753. end;
  6754. //------------------------------------------------------------------------------
  6755. function GetTeamTalkingForm(ATeamID: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6756. var
  6757. iLoop: Integer;
  6758. TalkingForm: TTalkingForm;
  6759. RealICQClient: TRealICQClient;
  6760. begin
  6761. Result := nil;
  6762. if ARealICQClient = nil then
  6763. RealICQClient := MainForm.RealICQClient
  6764. else
  6765. RealICQClient := ARealICQClient;
  6766. for iLoop := 0 to TalkingForms.Count - 1 do
  6767. begin
  6768. TalkingForm := TalkingForms[iLoop];
  6769. if TalkingForm.FCategory <> tcTeam then
  6770. Continue;
  6771. if (AnsiSameText(TalkingForm.FTeamID, ATeamID)) and (TalkingForm.FRealICQClient = RealICQClient) then
  6772. begin
  6773. Result := TalkingForm;
  6774. Exit;
  6775. end;
  6776. end;
  6777. end;
  6778. //------------------------------------------------------------------------------
  6779. procedure UpdateTeamTalkingForm(ATeam: TRealICQTeam);
  6780. var
  6781. iLoop: Integer;
  6782. AForm: TTalkingForm;
  6783. begin
  6784. for iLoop := TalkingForms.Count - 1 downto 0 do
  6785. begin
  6786. AForm := TalkingForms[iLoop];
  6787. if AForm.FCategory <> tcTeam then
  6788. Continue;
  6789. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6790. FreeAndNil(AForm)
  6791. else
  6792. AForm.UpdateMyInfo;
  6793. if (AForm.FTeamID = ATeam.TeamID) then
  6794. begin
  6795. AForm.SetTeamID(ATeam.TeamID);
  6796. Exit;
  6797. end;
  6798. end;
  6799. end;
  6800. //------------------------------------------------------------------------------
  6801. function InTalkingFormAdvertisement(AHandle: THandle): Boolean;
  6802. var
  6803. iLoop: Integer;
  6804. AForm: TTalkingForm;
  6805. begin
  6806. Result := False;
  6807. for iLoop := 0 to TalkingForms.Count - 1 do
  6808. begin
  6809. AForm := TalkingForms[iLoop];
  6810. if IsChild(AForm.WebBrowserForAdvertisement.Handle, AHandle) then
  6811. begin
  6812. Result := True;
  6813. Exit;
  6814. end;
  6815. end;
  6816. end;
  6817. //------------------------------------------------------------------------------
  6818. function InTalkingFormTeamDisk(AHandle: THandle): Boolean;
  6819. var
  6820. iLoop: Integer;
  6821. AForm: TTalkingForm;
  6822. begin
  6823. Result := False;
  6824. for iLoop := 0 to TalkingForms.Count - 1 do
  6825. begin
  6826. AForm := TalkingForms[iLoop];
  6827. if IsChild(AForm.WebBrowserForTeamDisk.Handle, AHandle) then
  6828. begin
  6829. Result := True;
  6830. Exit;
  6831. end;
  6832. end;
  6833. end;
  6834. //------------------------------------------------------------------------------
  6835. procedure ChangeTalkingFormColor(AColor: TColor);
  6836. var
  6837. iLoop: Integer;
  6838. AForm: TTalkingForm;
  6839. begin
  6840. for iLoop := 0 to TalkingForms.Count - 1 do
  6841. begin
  6842. AForm := TalkingForms[iLoop];
  6843. if not AForm.FUseSelfColor then
  6844. AForm.ChangeUIColor(AColor);
  6845. end;
  6846. end;
  6847. //------------------------------------------------------------------------------
  6848. procedure UpdateTalkingFormAdversement;
  6849. var
  6850. iLoop: Integer;
  6851. AForm: TTalkingForm;
  6852. begin
  6853. for iLoop := 0 to TalkingForms.Count - 1 do
  6854. begin
  6855. AForm := TalkingForms[iLoop];
  6856. AForm.LoadAdvertisement;
  6857. end;
  6858. end;
  6859. //------------------------------------------------------------------------------
  6860. procedure ChangeTalkingFormSkin(ASkinName: string);
  6861. var
  6862. iLoop: Integer;
  6863. AForm: TTalkingForm;
  6864. OldSkin: string;
  6865. begin
  6866. ASkinName := AnsiReplaceText(ASkinName, 'MainForm', '');
  6867. for iLoop := 0 to TalkingForms.Count - 1 do
  6868. begin
  6869. AForm := TalkingForms[iLoop];
  6870. OldSkin := AForm.SkinName;
  6871. try
  6872. AForm.SkinName := ASkinName;
  6873. except
  6874. AForm.SkinName := OldSkin;
  6875. end;
  6876. if not AForm.FUseSelfColor then
  6877. AForm.ChangeUIColor(MainForm.UIMainColor)
  6878. else
  6879. AForm.ChangeUIColor(AForm.FWindowColor);
  6880. end;
  6881. end;
  6882. procedure TTalkingForm.SaveImageInfo(TempFaceFileName: string; iFlag: Integer);
  6883. var
  6884. tempImgInfo: PImageInfo;
  6885. begin
  6886. tempImgInfo := new(PImageInfo);
  6887. tempImgInfo.Name := TempFaceFileName;
  6888. tempImgInfo.iFlag := iFlag;
  6889. ImagesList.Add(tempImgInfo);
  6890. end;
  6891. //------------
  6892. function TTalkingForm.HasMobilePhone(LoginName: string): Boolean;
  6893. var
  6894. iIndex: Integer;
  6895. ListItem: TRealICQContacterListItem;
  6896. begin
  6897. Result := False;
  6898. iIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  6899. if iIndex > -1 then
  6900. begin
  6901. ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
  6902. Result := ListItem.HasSMS;
  6903. end;
  6904. end;
  6905. procedure TTalkingForm.spbUserInfoClick(Sender: TObject);
  6906. begin
  6907. miSeeYourDetailInformationClick(nil);
  6908. end;
  6909. //------------------------------------------------------------------------------
  6910. procedure TTalkingForm.spbCopyScreenClick(Sender: TObject);
  6911. var
  6912. Point1, Point2: TPoint;
  6913. begin
  6914. point1 := Point(0, 0);
  6915. point2 := Point(0, 0);
  6916. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6917. GetCursorPos(point2);
  6918. if (point2.X - point1.X) <= 17 then
  6919. begin
  6920. if MainForm.CopyScreenHideTalkForm then
  6921. begin
  6922. WindowState := wsMinimized;
  6923. MainForm.Close;
  6924. end;
  6925. try
  6926. ShowCopyScreenForm(Self);
  6927. finally
  6928. if MainForm.CopyScreenHideTalkForm then
  6929. Self.WindowState := wsNormal;
  6930. self.RichEdInputer.SetFocus;
  6931. end;
  6932. end
  6933. else
  6934. begin
  6935. Point1.X := 0;
  6936. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  6937. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6938. ppForSnap.Popup(Point1.X, Point1.Y);
  6939. end;
  6940. end;
  6941. procedure TTalkingForm.spbEncryMsgClick(Sender: TObject);
  6942. begin
  6943. spbEncryMsg.Tag := 0;
  6944. spbEncryMsg.Visible := false;
  6945. spbNormalMsg.Visible := true;
  6946. end;
  6947. procedure TTalkingForm.spbNormalMsgClick(Sender: TObject);
  6948. begin
  6949. spbEncryMsg.Tag := 1;
  6950. spbEncryMsg.Visible := true;
  6951. spbNormalMsg.Visible := false;
  6952. end;
  6953. //procedure TTalkingForm.chkEncryMessageClick(Sender: TObject);
  6954. //begin
  6955. // SpbEncryMessage.Enabled:= chkEncryMessage.Checked;
  6956. //end;
  6957. //------------------------------------------------------------------------------
  6958. procedure TTalkingForm.actClearEditExecute(Sender: TObject);
  6959. begin
  6960. RichEdInputer.Clear;
  6961. RichEditTemp.Clear;
  6962. end;
  6963. procedure TTalkingForm.actClearWebExecute(Sender: TObject);
  6964. begin
  6965. ClearHTML(self.WebBrowser);
  6966. end;
  6967. procedure TTalkingForm.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
  6968. begin
  6969. Accept := (NewSize >= 1) and ((self.ClientHeight - NewSize) >= 250);
  6970. end;
  6971. procedure TTalkingForm.spbSetClick(Sender: TObject);
  6972. var
  6973. Point1: TPoint;
  6974. begin
  6975. point1 := Point(0, 0);
  6976. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  6977. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6978. ppForSet.Popup(Point1.X, Point1.Y);
  6979. end;
  6980. initialization
  6981. CoInitialize(nil);
  6982. OleInitialize(nil);
  6983. finalization
  6984. try
  6985. OleUninitialize;
  6986. CoUninitialize;
  6987. except
  6988. end;
  6989. end.