TalkingFrm.pas 256 KB

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