TalkingFrm.pas 256 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134
  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. PasteImage;
  3297. finally
  3298. CheckPastedContent;
  3299. LockWindowUpdate(0);
  3300. end;
  3301. end;
  3302. procedure TTalkingForm.EditPasteUpdate(Sender: TObject);
  3303. var
  3304. CF_HTML: DWORD;
  3305. begin
  3306. CF_HTML := RegisterClipboardFormat('HTML Format');
  3307. 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);
  3308. end;
  3309. //------------------------------------------------------------------------------
  3310. procedure TTalkingForm.CheckPastedContent(ADeleteOtherObj: Boolean = False);
  3311. var
  3312. AIndexes: TIndexes;
  3313. AFaceInRichEdit: TFaceInRichEdit;
  3314. AOldSelStart: Integer;
  3315. iLoop: Integer;
  3316. APastedToTemp: Boolean;
  3317. begin
  3318. RichEditTemp.Clear;
  3319. APastedToTemp := False;
  3320. AOldSelStart := RichEdInputer.SelStart;
  3321. AIndexes := RichEdInputer.GetFaceIndexes;
  3322. try
  3323. for iLoop := 0 to High(AIndexes) do
  3324. begin
  3325. AFaceInRichEdit := AIndexes[iLoop];
  3326. if AFaceInRichEdit.FaceIndex < 0 then
  3327. begin
  3328. if ADeleteOtherObj then
  3329. begin
  3330. RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
  3331. RichEdInputer.SelLength := 1;
  3332. RichEdInputer.SelText := '';
  3333. end
  3334. else
  3335. begin
  3336. if not APastedToTemp then
  3337. begin
  3338. RichEditTemp.PasteFromClipboard;
  3339. APastedToTemp := True;
  3340. end;
  3341. RichEdInputer.SelStart := AFaceInRichEdit.FacePosition;
  3342. RichEdInputer.SelLength := 1;
  3343. RichEdInputer.CutToClipboard;
  3344. PasteImage(False);
  3345. end;
  3346. end;
  3347. end;
  3348. finally
  3349. if not ADeleteOtherObj then
  3350. begin
  3351. RichEdInputer.SelStart := AOldSelStart;
  3352. RichEdInputer.SelLength := 0;
  3353. RichEdInputer.Font.Color := RichEdInputer.Font.Color - 1;
  3354. RichEdInputer.Font.Color := RichEdInputer.Font.Color + 1;
  3355. RichEdInputer.DisableAlign;
  3356. try
  3357. PostMessage(RichEdInputer.Handle, WM_SIZE, 0, 0);
  3358. finally
  3359. RichEdInputer.EnableAlign;
  3360. end;
  3361. if APastedToTemp then
  3362. begin
  3363. RichEditTemp.SelectAll;
  3364. RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
  3365. RichEditTemp.CutToClipboard;
  3366. end;
  3367. end;
  3368. end;
  3369. end;
  3370. //------------------------------------------------------------------------------
  3371. function TTalkingForm.FindIECacheImage(ADir, AImageFile: string): string;
  3372. var
  3373. DSearchRec: TSearchRec;
  3374. FindResult: Integer;
  3375. AFileName: string;
  3376. AFileTime, AFileTimeTemp: TDateTime;
  3377. begin
  3378. AFileTime := 0.0;
  3379. Result := '';
  3380. FindResult := FindFirst(ADir + '\' + Format('%s[*]%s', [ReplaceText(AImageFile, ExtractFileExt(AImageFile), ''), ExtractFileExt(AImageFile)]), faAnyFile, DSearchRec);
  3381. while FindResult = 0 do
  3382. begin
  3383. if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
  3384. begin
  3385. AFileName := ADir + '\' + ExtractFileName(DSearchRec.Name);
  3386. //找出最新的文件
  3387. AFileTimeTemp := RealICQUtils.GetFileTime(AFileName, 3);
  3388. if AFileTimeTemp > AFileTime then
  3389. begin
  3390. AFileTime := AFileTimeTemp;
  3391. Result := AFileName;
  3392. end;
  3393. end;
  3394. FindResult := FindNext(DSearchRec);
  3395. end;
  3396. if Result <> '' then
  3397. Exit;
  3398. FindResult := FindFirst(ADir + '\*.*', $00002016, DSearchRec);
  3399. while FindResult = 0 do
  3400. begin
  3401. if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
  3402. begin
  3403. if DirectoryExists(ADir + '\' + ExtractFileName(DSearchRec.Name)) then
  3404. begin
  3405. Result := FindIECacheImage(ADir + '\' + ExtractFileName(DSearchRec.Name), AImageFile);
  3406. if Result <> '' then
  3407. Exit;
  3408. end;
  3409. end;
  3410. FindResult := FindNext(DSearchRec);
  3411. end;
  3412. end;
  3413. function TTalkingForm.CheckImageExists(AImageFile: string): string;
  3414. var
  3415. dwCacheEntryInfoBufferSize: DWORD;
  3416. lpCacheEntryInfo: PInternetCacheEntryInfoA;
  3417. ALocalFile, ALocalFileTemp: string;
  3418. ASplitString: TStringList;
  3419. iIndex: Integer;
  3420. begin
  3421. Result := '';
  3422. dwCacheEntryInfoBufferSize := 0;
  3423. lpCacheEntryInfo := nil;
  3424. GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0);
  3425. GetMem(lpCacheEntryInfo, dwCacheEntryInfoBufferSize);
  3426. try
  3427. if GetUrlCacheEntryInfoEx(PAnsiChar(AImageFile), lpCacheEntryInfo, @dwCacheEntryInfoBufferSize, nil, nil, nil, 0) then
  3428. begin
  3429. Result := StrPas(lpCacheEntryInfo.lpszLocalFileName);
  3430. Exit;
  3431. end;
  3432. finally
  3433. FreeMem(lpCacheEntryInfo);
  3434. end;
  3435. ALocalFileTemp := ReplaceStr(AImageFile, '\', '/');
  3436. while Pos('/', ALocalFileTemp) > 0 do
  3437. begin
  3438. ALocalFileTemp := Copy(ALocalFileTemp, Pos('/', ALocalFileTemp) + 1, Length(ALocalFileTemp));
  3439. end;
  3440. ALocalFile := FindURLCache(PAnsiChar(GetIETempDir + '\Low\Content.IE5\index.dat'), PAnsiChar(AImageFile));
  3441. if Length(ALocalFile) > 0 then
  3442. begin
  3443. ASplitString := SplitString(ALocalFile, Chr(10));
  3444. AImageFile := GetIETempDir + '\Low\Content.IE5\' + ReplaceStr(ASplitString.Strings[0], '?', '') + '\';
  3445. iIndex := 2;
  3446. repeat
  3447. ALocalFile := AImageFile + LeftStr(ALocalFileTemp, 1) + Copy(ASplitString.Strings[iIndex], 3, Length(ASplitString.Strings[iIndex]) - 2);
  3448. Inc(iIndex);
  3449. until (FileExists(ALocalFile)) or (iIndex >= 4);
  3450. if FileExists(ALocalFile) then
  3451. begin
  3452. Result := ALocalFile;
  3453. end;
  3454. end;
  3455. {
  3456. ALocalFile := ReplaceStr(AImageFile, '\', '/');
  3457. while Pos('/', ALocalFile) > 0 do
  3458. begin
  3459. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3460. end;
  3461. Result := FindIECacheImage(GetIETempDir + '\Low\Content.IE5', ALocalFile); }
  3462. end;
  3463. //------------------------------------------------------------------------------
  3464. procedure TTalkingForm.RichEdInputerChange(Sender: TObject);
  3465. var
  3466. iLoop, iLength, InputerLength, iStart: Integer;
  3467. Face: TFace;
  3468. FRealICQUser: TRealICQUser;
  3469. begin
  3470. if Length(Trim(Receiver)) = 0 then
  3471. Exit;
  3472. iLength := Length(RichEdInputer.Text);
  3473. //发送“正在输入消息”字样
  3474. if FCategory = tcNormal then
  3475. begin
  3476. if (iLength = 0) or (GetTickCount - FLastSendInputtingMessageTicket > 5000) then
  3477. begin
  3478. if (FRealICQClient.Me <> nil) and (FRealICQClient.Me.LoginState <> stHidden) then
  3479. begin
  3480. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  3481. if Assigned(FRealICQUser) then
  3482. begin
  3483. ((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox) as TRealICQPtoPBox).SendInputting(iLength > 0);
  3484. FLastSendInputtingMessageTicket := GetTickCount;
  3485. end;
  3486. end;
  3487. end;
  3488. end;
  3489. if iLength = 0 then
  3490. Exit;
  3491. RichEdInputer.OnChange := nil;
  3492. try
  3493. for iLoop := 0 to MainForm.FaceList.Count - 1 do
  3494. begin
  3495. Face := MainForm.FaceList.Objects[iLoop] as TFace;
  3496. if Face.ShortCut = '' then
  3497. continue;
  3498. iStart := TRxRichEdit(Sender).FindText(Face.ShortCut, 0, iLength, []);
  3499. while iStart >= 0 do
  3500. begin
  3501. RichEdInputer.SelStart := iStart;
  3502. RichEdInputer.SelLength := Length(Face.ShortCut);
  3503. RichEdInputer.InsertImage(Face.FileName, iLoop);
  3504. RichEdInputer.SelStart := TRxRichEdit(Sender).SelStart;
  3505. RichEdInputer.SelLength := 0;
  3506. iStart := RichEdInputer.FindText(Face.ShortCut, RichEdInputer.SelStart, iLength, []);
  3507. end;
  3508. end;
  3509. finally
  3510. RichEdInputer.OnChange := RichEdInputerChange;
  3511. end;
  3512. RichEdInputer.MaxLength := Length(Trim(RichEdInputer.Text));
  3513. InputerLength := GetInputerLength;
  3514. if MaxMessageLength - InputerLength > 0 then
  3515. RichEdInputer.MaxLength := RichEdInputer.MaxLength + (MaxMessageLength - InputerLength);
  3516. end;
  3517. procedure TTalkingForm.IdHTTPOnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
  3518. begin
  3519. FRidrected := True;
  3520. FRidrectURL := dest;
  3521. end;
  3522. procedure TTalkingForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
  3523. begin
  3524. end;
  3525. procedure TTalkingForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
  3526. begin
  3527. FImageSize := AWorkCountMax;
  3528. //如果重定向或文件大于200k,断开连接(重新从缓存中查找)
  3529. //if (FRidrected) or (FImageSize > 1024 * 300) then
  3530. (ASender as TIdHTTP).Disconnect;
  3531. end;
  3532. procedure TTalkingForm.IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  3533. begin
  3534. end;
  3535. procedure TTalkingForm.spbUploadTeamFileClick(Sender: TObject);
  3536. var
  3537. UpUrl: string;
  3538. AFileSize: int64;
  3539. begin
  3540. if (FRealICQClient.Connected) and (FRealICQClient.Logined) then
  3541. if OpenDialog.Execute then
  3542. begin
  3543. TTeamShareAdapter.UploadFile(TeamID, OpenDialog.FileName, Self, FRealICQClient, False);
  3544. end;
  3545. end;
  3546. function TTalkingForm.ReAlighHTMLContent(ABaseURL: string): Boolean;
  3547. var
  3548. StrContent, imgBBURL, imgURL, ALocalFile, ALocalFile1, AFileExt, ABaseURLTop, AHttpStart: string;
  3549. iIndex1, iIndex2: Integer;
  3550. PngObject: TPngObject;
  3551. BMP: TBitmap;
  3552. AFinded: Boolean;
  3553. FIdHTTP: TIdHTTP;
  3554. FileStream: TFileStream;
  3555. begin
  3556. Result := False;
  3557. StrContent := RichEditTemp.Text;
  3558. iIndex1 := Pos('[img]', StrContent);
  3559. iIndex2 := Pos('[/img]', StrContent);
  3560. while (iIndex1 > 0) and (iIndex2 > 0) and (iIndex2 > iIndex1) do
  3561. begin
  3562. imgBBURL := Copy(StrContent, iIndex1, iIndex2 - iIndex1 + 6);
  3563. imgURL := Copy(imgBBURL, 6, iIndex2 - iIndex1 - 5);
  3564. RichEditTemp.SelStart := RichEditTemp.FindText(imgBBURL, 0, Length(StrContent), []);
  3565. RichEditTemp.SelLength := Length(WideString(imgBBURL));
  3566. RichEditTemp.SelText := '';
  3567. ImgURL := ReplaceStr(ImgURL, '\', '/');
  3568. if Pos('http://', ImgURL) = 1 then
  3569. begin
  3570. end
  3571. else if Pos('https://', ImgURL) = 1 then
  3572. begin
  3573. end
  3574. else if Pos('/', ImgURL) = 1 then
  3575. begin
  3576. AHttpStart := Copy(ABaseURL, 1, Pos('://', ABaseURL) + 2);
  3577. ABaseURLTop := Copy(ABaseURL, Length(AHttpStart) + 1, Length(ABaseURL));
  3578. ABaseURLTop := Copy(ABaseURLTop, 1, Pos('/', ABaseURLTop) - 1);
  3579. ImgURL := AHttpStart + ABaseURLTop + ImgURL;
  3580. end
  3581. else
  3582. begin
  3583. ALocalFile := ReplaceStr(ABaseURL, '\', '/');
  3584. while Pos('/', ALocalFile) > 0 do
  3585. begin
  3586. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3587. end;
  3588. ImgURL := ReplaceStr(ABaseURL, ALocalFile, '') + ImgURL;
  3589. end;
  3590. ALocalFile := ReplaceStr(ImgURL, '\', '/');
  3591. while Pos('/', ALocalFile) > 0 do
  3592. begin
  3593. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3594. end;
  3595. AFileExt := ExtractFileExt(ALocalFile);
  3596. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  3597. begin
  3598. AFinded := False;
  3599. if AnsiSameText(Copy(ImgURL, 1, 8), 'file:///') then
  3600. begin
  3601. ImgURL := Copy(ImgURL, 9, Length(ImgURL) - 8);
  3602. AFinded := FileExists(ImgURL);
  3603. ALocalFile := ImgURL;
  3604. end
  3605. else
  3606. begin
  3607. ALocalFile1 := CheckImageExists(ImgURL);
  3608. if FileExists(ALocalFile1) then
  3609. begin
  3610. ALocalFile := ALocalFile1;
  3611. AFinded := True;
  3612. end
  3613. else
  3614. begin
  3615. {$region '检查是否有重定向'}
  3616. FRidrected := False;
  3617. FRidrectURL := '';
  3618. FImageSize := 0;
  3619. ALocalFile1 := MainForm.RealICQClient.GetCacheFaceDir + IntToStr(GetTickCount) + '_' + ALocalFile;
  3620. FIdHTTP := TIdHTTP.Create(nil);
  3621. try
  3622. FIdHTTP.ConnectTimeout := 1500;
  3623. FIdHTTP.ReadTimeout := 2000;
  3624. FIdHTTP.OnWork := IdHTTPWork;
  3625. FIdHTTP.OnWorkBegin := IdHTTPWorkBegin;
  3626. FIdHTTP.OnWorkEnd := IdHTTPWorkEnd;
  3627. FIdHTTP.OnRedirect := IdHTTPOnRedirect;
  3628. try
  3629. FileStream := TFileStream.Create(ALocalFile1, fmCreate, fmShareDenyNone);
  3630. try
  3631. FIdHTTP.Get(FIdHTTP.URL.URLEncode(ImgURL), FileStream);
  3632. ALocalFile := ALocalFile1;
  3633. AFinded := True;
  3634. finally
  3635. FileStream.Free;
  3636. end;
  3637. except
  3638. on E: Exception do
  3639. begin
  3640. DeleteFile(ALocalFile1);
  3641. end;
  3642. end;
  3643. finally
  3644. FreeAndNil(FIdHTTP);
  3645. end;
  3646. if FRidrected then
  3647. begin
  3648. FRidrectURL := ReplaceStr(FRidrectURL, '\', '/');
  3649. ImgURL := ReplaceStr(ImgURL, '\', '/');
  3650. if Pos('http://', FRidrectURL) = 1 then
  3651. ImgURL := FRidrectURL
  3652. else if Pos('https://', FRidrectURL) = 1 then
  3653. ImgURL := FRidrectURL
  3654. else if Pos('/', FRidrectURL) = 1 then
  3655. begin
  3656. AHttpStart := Copy(ImgURL, 1, Pos('://', ImgURL) + 2);
  3657. ImgURL := Copy(ImgURL, Length(AHttpStart) + 1, Length(ImgURL));
  3658. ImgURL := Copy(ImgURL, 1, Pos('/', ImgURL) - 1);
  3659. ImgURL := AHttpStart + ImgURL + FRidrectURL;
  3660. end
  3661. else
  3662. begin
  3663. ImgURL := ReplaceStr(ImgURL, ALocalFile, '') + FRidrectURL;
  3664. end;
  3665. ALocalFile := ReplaceStr(ImgURL, '\', '/');
  3666. while Pos('/', ALocalFile) > 0 do
  3667. begin
  3668. ALocalFile := Copy(ALocalFile, Pos('/', ALocalFile) + 1, Length(ALocalFile));
  3669. end;
  3670. AFileExt := ExtractFileExt(ALocalFile);
  3671. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  3672. begin
  3673. ALocalFile1 := CheckImageExists(ImgURL);
  3674. if FileExists(ALocalFile1) then
  3675. begin
  3676. ALocalFile := ALocalFile1;
  3677. AFinded := True;
  3678. end;
  3679. end;
  3680. end;
  3681. {$endregion }
  3682. end;
  3683. end;
  3684. if AFinded then
  3685. begin
  3686. try
  3687. AddImageToInput(ALocalFile, RichEditTemp);
  3688. Result := True;
  3689. except
  3690. on E: Exception do
  3691. begin
  3692. if Pos('JPEG error #53', E.Message) > 0 then
  3693. begin
  3694. MoveFile(PChar(ALocalFile), PChar(ALocalFile + '.gif'));
  3695. try
  3696. AddImageToInput(ALocalFile + '.gif', RichEditTemp);
  3697. Result := True;
  3698. except
  3699. Result := False;
  3700. end;
  3701. end
  3702. else
  3703. begin
  3704. Result := False;
  3705. end;
  3706. end;
  3707. end;
  3708. end;
  3709. end;
  3710. StrContent := RichEditTemp.Text;
  3711. iIndex1 := Pos('[img]', StrContent);
  3712. iIndex2 := Pos('[/img]', StrContent);
  3713. end;
  3714. Application.ProcessMessages;
  3715. Sleep(10);
  3716. Application.ProcessMessages;
  3717. RichEditTemp.SelectAll;
  3718. RichEditTemp.SelLength := RichEditTemp.SelLength - 2;
  3719. RichEditTemp.CopyToClipboard;
  3720. RichEdInputer.PasteFromClipboard;
  3721. RichEditTemp.Clear;
  3722. end;
  3723. function TTalkingForm.GetHTMLUBBCode(AHTML: string; var ABaseURL: string): string;
  3724. var
  3725. iIndex1: Integer;
  3726. StrStartFragment, StrEndFragment: string;
  3727. iStartFragment, iEndFragment: Integer;
  3728. reg: TPerlRegEx;
  3729. ws: string;
  3730. begin
  3731. Result := '';
  3732. iIndex1 := Pos('SourceURL:', AHTML);
  3733. if iIndex1 > 0 then
  3734. begin
  3735. ABaseURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), 100);
  3736. iIndex1 := Pos(#$D, ABaseURL);
  3737. if iIndex1 > 0 then
  3738. begin
  3739. ABaseURL := Copy(ABaseURL, 1, iIndex1 - 1);
  3740. end;
  3741. end;
  3742. iIndex1 := Pos('StartFragment:', AHTML);
  3743. if iIndex1 = 0 then
  3744. Exit;
  3745. StrStartFragment := Copy(AHTML, iIndex1 + Length('StartFragment:'), 12);
  3746. iIndex1 := Pos(#$D, StrStartFragment);
  3747. if iIndex1 = 0 then
  3748. Exit;
  3749. StrStartFragment := Copy(StrStartFragment, 1, iIndex1 - 1);
  3750. iIndex1 := Pos('EndFragment:', AHTML);
  3751. if iIndex1 = 0 then
  3752. Exit;
  3753. StrEndFragment := Copy(AHTML, iIndex1 + Length('EndFragment:'), 12);
  3754. iIndex1 := Pos(#$D, StrEndFragment);
  3755. if iIndex1 = 0 then
  3756. Exit;
  3757. StrEndFragment := Copy(StrEndFragment, 1, iIndex1 - 1);
  3758. iStartFragment := StrToInt(StrStartFragment);
  3759. iEndFragment := StrToInt(StrEndFragment);
  3760. Result := Copy(AHTML, iStartFragment + 1, iEndFragment - iStartFragment);
  3761. {iIndex1 := Pos('SourceURL:', AHTML);
  3762. if iIndex1 = 0 then Exit;
  3763. StrSourceURL := Copy(AHTML, iIndex1 + Length('SourceURL:'), Length(AHTML));
  3764. StrSourceURL := Copy(StrSourceURL, 1, Pos(#$D#$A, StrSourceURL)); }
  3765. reg := TPerlRegEx.Create;
  3766. reg.Subject := LowerCase(Result);
  3767. reg.RegEx := '聽'; //???????????????????????????????????????
  3768. reg.Replacement := ' ';
  3769. reg.ReplaceAll;
  3770. reg.RegEx := #$D#$A;
  3771. reg.Replacement := '';
  3772. reg.ReplaceAll;
  3773. reg.RegEx := '</p>';
  3774. reg.Replacement := #$D#$A;
  3775. reg.ReplaceAll;
  3776. reg.RegEx := '</div>';
  3777. reg.Replacement := #$D#$A;
  3778. reg.ReplaceAll;
  3779. reg.RegEx := '<br>';
  3780. reg.Replacement := #$D#$A;
  3781. reg.ReplaceAll;
  3782. reg.RegEx := '<script[^>]*?>([\w\W]*?)<\/script>';
  3783. reg.Replacement := '';
  3784. reg.ReplaceAll;
  3785. reg.RegEx := '<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>';
  3786. reg.Replacement := '$2';
  3787. reg.ReplaceAll;
  3788. reg.RegEx := '<img[^>]+src="([^"]+)"[^>]*>';
  3789. reg.Replacement := '[img]$1[/img]';
  3790. reg.ReplaceAll;
  3791. reg.RegEx := '<[^>]*?>';
  3792. reg.Replacement := '';
  3793. reg.ReplaceAll;
  3794. reg.RegEx := '&amp;';
  3795. reg.Replacement := '&';
  3796. reg.ReplaceAll;
  3797. reg.RegEx := '&lt;';
  3798. reg.Replacement := '<';
  3799. reg.ReplaceAll;
  3800. reg.RegEx := '&gt;';
  3801. reg.Replacement := '>';
  3802. reg.ReplaceAll;
  3803. reg.RegEx := '&nbsp;';
  3804. reg.Replacement := ' ';
  3805. reg.ReplaceAll;
  3806. reg.RegEx := '&quot;';
  3807. reg.Replacement := '"';
  3808. reg.ReplaceAll;
  3809. Result := reg.Subject;
  3810. FreeAndNil(reg);
  3811. ws := UTF8Decode(Result);
  3812. while (ws[Length(ws)] = #$A) or (ws[Length(ws)] = #$D) do
  3813. ws := Copy(ws, 1, Length(ws) - 1);
  3814. Result := ws;
  3815. end;
  3816. function TTalkingForm.PasteImage(AUseTemp: Boolean = True): Boolean;
  3817. var
  3818. Picture: TPicture;
  3819. Bitmap: TBitmap;
  3820. GIF: TGIFImage;
  3821. AFileName: string;
  3822. AFindedImage: Boolean;
  3823. PFileName: PChar;
  3824. DataHandle: Thandle;
  3825. FilesCount: Integer;
  3826. ClipboardText: string;
  3827. iLoop, tabCount, returnCount: Integer;
  3828. AIndexes: TIndexes;
  3829. AFaceInRichEdit: TFaceInRichEdit;
  3830. CF_HTML: DWORD;
  3831. hMem: DWORD;
  3832. pHTML: PChar;
  3833. StrHTML, ABaseURL: string;
  3834. APasted: Boolean;
  3835. begin
  3836. Result := False;
  3837. ClipboardText := Clipboard.AsText;
  3838. /// 如果复制内容是文件
  3839. if Clipboard.HasFormat(CF_HDROP) and ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
  3840. begin
  3841. GetMem(PFileName, MAX_PATH + 1);
  3842. DataHandle := Clipboard.GetAsHandle(CF_HDROP);
  3843. FilesCount := DragQueryFile(DataHandle, MAXDWORD, PFileName, MAX_PATH);
  3844. for iLoop := 0 to FilesCount - 1 do
  3845. begin
  3846. if DragQueryFile(DataHandle, iLoop, PFileName, MAX_PATH) > 0 then
  3847. begin
  3848. if DirectoryExists(PFileName) then
  3849. OpenSendFolderForm(PFileName)
  3850. else
  3851. SendDropFile(PFileName);
  3852. end;
  3853. if iLoop > 20 then
  3854. break;
  3855. end;
  3856. FreeMem(PFileName);
  3857. Result := True;
  3858. Exit;
  3859. end;
  3860. tabCount := 0;
  3861. returnCount := 0;
  3862. for iLoop := 1 to Length(ClipboardText) do
  3863. begin
  3864. if ClipboardText[iLoop] = #9 then
  3865. Inc(tabCount);
  3866. if ClipboardText[iLoop] = #13 then
  3867. Inc(returnCount);
  3868. end;
  3869. //粘贴HTML数据
  3870. CF_HTML := RegisterClipboardFormat('HTML Format');
  3871. ///如果复制内容是HTML
  3872. if Clipboard.HasFormat(CF_HTML) and not ((Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) and (Clipboard.HasFormat(CF_METAFILEPICT))) then
  3873. begin
  3874. Screen.Cursor := crHourGlass;
  3875. try
  3876. hMem := Clipboard.GetAsHandle(CF_HTML);
  3877. pHTML := GlobalLock(hMem);
  3878. StrHTML := StrPas(pHTML);
  3879. GlobalUnlock(hMem);
  3880. // Clipboard.Clear;
  3881. ABaseURL := '';
  3882. StrHTML := GetHTMLUBBCode(StrHTML, ABaseURL);
  3883. RichEditTemp.Clear;
  3884. RichEditTemp.Lines.Add(StrHTML);
  3885. ///提取出HTML中的图片
  3886. Result := ReAlighHTMLContent(ABaseURL);
  3887. finally
  3888. Screen.Cursor := crDefault;
  3889. end;
  3890. Exit;
  3891. end;
  3892. {$region '先在临时RichEdit中粘贴'}
  3893. if AUseTemp and (Length(ClipboardText) = 0) then
  3894. begin
  3895. RichEditTemp.Clear;
  3896. RichEditTemp.PasteFromClipboard;
  3897. AIndexes := RichEditTemp.GetFaceIndexes;
  3898. if High(AIndexes) = 0 then //只有一个对象
  3899. begin
  3900. AFaceInRichEdit := AIndexes[0];
  3901. if AFaceInRichEdit.FaceIndex > 0 then //已经是表情对象
  3902. begin
  3903. Result := False;
  3904. RichEditTemp.Clear;
  3905. end
  3906. else if ((not Clipboard.HasFormat(CF_METAFILEPICT)) and (not Clipboard.HasFormat(CF_PICTURE))) then
  3907. begin
  3908. Result := True;
  3909. RichEditTemp.Clear;
  3910. end;
  3911. end;
  3912. Exit;
  3913. end;
  3914. {$endregion}
  3915. try
  3916. ///截图
  3917. if Clipboard.HasFormat(CF_METAFILEPICT) then
  3918. begin
  3919. if (Length(ClipboardText) > 0) and (tabCount > 0) and (tabCount >= returnCount) then
  3920. begin
  3921. AFindedImage := False;
  3922. Bitmap := TBitmap.Create;
  3923. try
  3924. try
  3925. Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
  3926. AFindedImage := True;
  3927. except
  3928. end;
  3929. if AFindedImage then
  3930. begin
  3931. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
  3932. Bitmap.SaveToFile(AFileName);
  3933. end;
  3934. finally
  3935. Bitmap.Free;
  3936. end;
  3937. if AFindedImage then
  3938. begin
  3939. AddImageToInput(AFileName, RichEdInputer);
  3940. DeleteFile(AFileName);
  3941. Result := True;
  3942. Exit;
  3943. end;
  3944. end;
  3945. end;
  3946. if Clipboard.HasFormat(CF_PICTURE) and (Length(Trim(Clipboard.AsText)) = 0) then
  3947. begin
  3948. Picture := TPicture.Create;
  3949. Bitmap := TBitmap.Create;
  3950. try
  3951. Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
  3952. AFileName := MainForm.RealICQClient.GetReceivedFaceDir + 'SC' + IntToStr(GetTickCount) + '.TEMP.BMP';
  3953. Bitmap.SaveToFile(AFileName);
  3954. finally
  3955. Bitmap.Free;
  3956. Picture.Free;
  3957. end;
  3958. AddImageToInput(AFileName, RichEdInputer);
  3959. DeleteFile(AFileName);
  3960. Result := True;
  3961. Exit;
  3962. end;
  3963. except
  3964. on E: Exception do
  3965. Error(E.Message, 'TTalkingForm.PasteImage');
  3966. end;
  3967. RichEdInputer.PasteFromClipboard;
  3968. end;
  3969. procedure TTalkingForm.btCloseClick(Sender: TObject);
  3970. begin
  3971. if Assigned(FRemoteControlMission) then
  3972. FRemoteControlMission.Stop;
  3973. end;
  3974. procedure TTalkingForm.btCloseTalkClick(Sender: TObject);
  3975. var
  3976. source, target: string;
  3977. AUser: TRealICQUser;
  3978. begin
  3979. if TConditionConfig.GetConfig.GradeSystem and (FCategory = tcNormal) then
  3980. begin
  3981. AUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  3982. if not Assigned(AUser) then
  3983. Exit;
  3984. source := TUsersService.ClearServerID(FSender);
  3985. target := TUsersService.ClearServerID(FReceiver);
  3986. (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 + '"]');
  3987. end
  3988. else
  3989. Close;
  3990. end;
  3991. procedure TTalkingForm.btDownArrowClick(Sender: TObject);
  3992. var
  3993. Point1: TPoint;
  3994. begin
  3995. Point1.X := 0;
  3996. Point1.Y := (Sender as TRealICQButton).Height + 1;
  3997. Point1 := (Sender as TRealICQButton).ClientToScreen(Point1);
  3998. ppForDown.Popup(Point1.X + 6, Point1.Y);
  3999. end;
  4000. procedure TTalkingForm.btnQRClick(Sender: TObject);
  4001. var
  4002. data: string;
  4003. RealICQUser: TRealICQUser;
  4004. Form: TVCardForm;
  4005. begin
  4006. Form := GetVCardForm(FReceiver);
  4007. Form.Top := (Screen.Height - Form.Height) div 2;
  4008. Form.Left := (Screen.Width - Form.Width) div 2;
  4009. Form.Show;
  4010. end;
  4011. procedure TTalkingForm.btReleaseControlClick(Sender: TObject);
  4012. begin
  4013. if Assigned(FRemoteControlMission) then
  4014. FRemoteControlMission.CancelControl;
  4015. end;
  4016. procedure TTalkingForm.btSendClick(Sender: TObject);
  4017. var
  4018. Face: TFace;
  4019. FaceMD5String, MessageStr: string;
  4020. BaseSelStart, iCount, iLoop: Integer;
  4021. FaceInRichEdit: TFaceInRichEdit;
  4022. FaceIndexes: TIndexes;
  4023. FRealICQUser: TRealICQUser;
  4024. saystr, AError: string;
  4025. AFaces: TStringList;
  4026. ATask: TFacesUploaderTask;
  4027. begin
  4028. if (GetTickCount - FLastSendMsgTicket) < 200 then
  4029. begin
  4030. ShowSendMessageTooQuickly(WebBrowser);
  4031. Exit;
  4032. end;
  4033. FRealICQUser := nil;
  4034. if FCategory = tcNormal then
  4035. begin
  4036. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4037. if not Assigned(FRealICQUser) then
  4038. Exit;
  4039. if AnsiSameText(RichEdInputer.Text, '/P2PType') then
  4040. begin
  4041. P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
  4042. ClearInputtingMessageTimer.Enabled := False;
  4043. ClearInputtingMessageTimer.Enabled := True;
  4044. RichEdInputer.Lines.Clear;
  4045. Exit;
  4046. end;
  4047. end;
  4048. if GetInputerLength > MaxMessageLength + 64 then
  4049. begin
  4050. MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
  4051. RichEdInputer.SetFocus;
  4052. Exit;
  4053. end;
  4054. MessageStr := '';
  4055. AFaces := TStringList.Create;
  4056. FaceIndexes := RichEdInputer.GetFaceIndexes;
  4057. BaseSelStart := 0;
  4058. RichEdInputer.OnChange := nil;
  4059. RichEdInputer.Visible := False;
  4060. try
  4061. iCount := 0;
  4062. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4063. begin
  4064. FaceInRichEdit := FaceIndexes[iLoop];
  4065. if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
  4066. Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
  4067. else
  4068. Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
  4069. Debug(Face.MD5Code, '截图');
  4070. if TLimitCondition.GreaterThanFaceMaxSize(Face.FileName, AError) then
  4071. begin
  4072. MessageBox(Handle, PChar(AError), '提示', MB_ICONINFORMATION);
  4073. Error(AError, 'TLimitCondition.GreaterThanFaceMaxSize');
  4074. RichEdInputer.SetFocus;
  4075. Exit;
  4076. end;
  4077. end;
  4078. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4079. begin
  4080. FaceInRichEdit := FaceIndexes[iLoop];
  4081. if FaceInRichEdit.FaceIndex >= BaseTempFaceIndex then
  4082. Face := MainForm.TempFaceList.Objects[FaceInRichEdit.FaceIndex - BaseTempFaceIndex] as TFace
  4083. else
  4084. Face := MainForm.FaceList.Objects[FaceInRichEdit.FaceIndex] as TFace;
  4085. if FaceInRichEdit.FaceIndex < MainForm.SystemFaceCount then
  4086. FaceMD5String := Face.ShortCut
  4087. else
  4088. begin
  4089. FaceMD5String := '[image-src="' + Face.MD5Code + '"]';
  4090. Inc(iCount);
  4091. AFaces.addObject(Face.FileName, Face);
  4092. end;
  4093. RichEdInputer.SelStart := BaseSelStart + FaceInRichEdit.FacePosition;
  4094. RichEdInputer.SelLength := 1;
  4095. RichEdInputer.SelText := FaceMD5String;
  4096. Inc(BaseSelStart, Length(FaceMD5String) - 1);
  4097. end;
  4098. MessageStr := Trim(RichEdInputer.Text);
  4099. if Length(MessageStr) = 0 then
  4100. begin
  4101. MessageBox(Handle, '不能发送空消息! ', '提示', MB_ICONINFORMATION);
  4102. Exit;
  4103. end;
  4104. if GetInputerLength > 4096 then
  4105. begin
  4106. MessageBox(Handle, '输入的消息内容太长! ', '提示', MB_ICONINFORMATION);
  4107. RichEdInputer.SetFocus;
  4108. Exit;
  4109. end;
  4110. finally
  4111. RichEdInputer.Visible := True;
  4112. RichEdInputer.SetFocus;
  4113. end;
  4114. RichEdInputer.MaxLength := MaxMessageLength;
  4115. RichEdInputer.Lines.Clear;
  4116. RichEdInputer.Clear;
  4117. RichEdInputer.OnChange := RichEdInputerChange;
  4118. RichEdInputer.Visible := True;
  4119. RichEdInputer.SetFocus;
  4120. while (ImagesList.Count > 0) do
  4121. begin
  4122. dispose(ImagesList.First);
  4123. ImagesList.Delete(0);
  4124. end;
  4125. if FCategory = tcNormal then
  4126. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SyncSendMessage((spbEncryMsg.Tag = 1), FontToString(RichEdInputer.Font), MessageStr, AFaces)
  4127. else
  4128. TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, AFaces, '');
  4129. FLastSendMsgTicket := GetTickCount;
  4130. end;
  4131. procedure TTalkingForm.btSetControlClick(Sender: TObject);
  4132. begin
  4133. if Assigned(FRemoteControlMission) then
  4134. FRemoteControlMission.ControlReAccept;
  4135. end;
  4136. //------------------------------------------------------------------------------
  4137. procedure TTalkingForm.RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  4138. var
  4139. chrPoint, vPoint, pt: TPoint;
  4140. FaceInRichEdit: TFaceInRichEdit;
  4141. FaceIndexes: TIndexes;
  4142. iLoop, iPos: integer;
  4143. face: TFace;
  4144. begin
  4145. if Button = mbRight then
  4146. begin
  4147. vPoint.X := X;
  4148. vPoint.Y := Y;
  4149. vPoint := RichEdInputer.ClientToScreen(vPoint);
  4150. chrPoint := Point(X, Y);
  4151. iPos := SendMessage(TRealICQRichEdit(Sender).Handle, EM_CHARFROMPOS, 0, Integer(@chrPoint)) and $0000FFFF; // 得到鼠标点击字符位置
  4152. pt := TRealICQRichEdit(Sender).GetCharPos(iPos);
  4153. if (RichEdInputer.SelLength <= 0) then
  4154. begin
  4155. if pt.x < chrPoint.X then
  4156. RichEdInputer.SetSelection(iPos, iPos + 1, false)
  4157. else
  4158. RichEdInputer.SetSelection(iPos - 1, iPos, true);
  4159. if TRealICQRichEdit(Sender).SelectionType <> [stObject] then
  4160. begin
  4161. RichEdInputer.SelLength := 0;
  4162. RichEdInputer.SelStart := iPos;
  4163. end;
  4164. end;
  4165. //判断
  4166. if TRealICQRichEdit(Sender).SelectionType = [stObject] then
  4167. begin
  4168. FaceIndexes := TRealICQRichEdit(Sender).GetFaceIndexes;
  4169. for iLoop := 0 to Length(FaceIndexes) - 1 do
  4170. begin
  4171. FaceInRichEdit := FaceIndexes[iLoop];
  4172. if FaceInRichEdit.FacePosition = TRealICQRichEdit(Sender).SelStart then
  4173. begin
  4174. FRightMouseClickedFace := FaceInRichEdit;
  4175. miCopyImage.Visible := True;
  4176. actSaveImgAs.Visible := True;
  4177. actAddImageToCustomFaces.Visible := True;
  4178. ppForInputerImg.Popup(vPoint.X, vPoint.Y);
  4179. break;
  4180. end;
  4181. end;
  4182. RichEdInputer.SelLength := 0;
  4183. RichEdInputer.SelStart := iPos;
  4184. end
  4185. else
  4186. ppForInputer.Popup(vPoint.X, vPoint.Y);
  4187. end;
  4188. end;
  4189. procedure TTalkingForm.RichEdInputerSelectionChange(Sender: TObject);
  4190. begin
  4191. //Dialogs.ShowMessage('RichEdInputerSelectionChange');
  4192. end;
  4193. //------------------------------------------------------------------------------
  4194. procedure TTalkingForm.rndMyInfoResize(Sender: TObject);
  4195. begin
  4196. //Application.ProcessMessages;
  4197. end;
  4198. //------------------------------------------------------------------------------
  4199. procedure TTalkingForm.spbSelUIColorClick(Sender: TObject);
  4200. var
  4201. Point: TPoint;
  4202. begin
  4203. Point.X := 0;
  4204. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  4205. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4206. ppColors.Popup(Point.X, Point.Y);
  4207. end;
  4208. //------------------------------------------------------------------------------
  4209. procedure TTalkingForm.LblSendSMSClick(Sender: TObject);
  4210. var
  4211. FRealICQUser: TRealICQUser;
  4212. begin
  4213. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4214. if Length(FRealICQUser.Mobile) > 0 then
  4215. OpenSMSForm(Receiver, True)
  4216. else
  4217. OpenSMSForm('', True);
  4218. end;
  4219. procedure TTalkingForm.LblSendSMSMouseEnter(Sender: TObject);
  4220. begin
  4221. LblSendSMS.Font.Style := [fsUnderLine];
  4222. LblSendSMS1.Font.Style := [fsUnderLine];
  4223. end;
  4224. procedure TTalkingForm.LblSendSMSMouseLeave(Sender: TObject);
  4225. begin
  4226. LblSendSMS.Font.Style := [];
  4227. LblSendSMS1.Font.Style := [];
  4228. end;
  4229. procedure TTalkingForm.LoadAdvertisement;
  4230. begin
  4231. if (not FRealICQClient.TalkingFormAdversement.Visible) then
  4232. begin
  4233. if pnlForWebBrowserAdvertisement.Width > 0 then
  4234. pnlAdvertisement.Width := 0;
  4235. end
  4236. else
  4237. begin
  4238. WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
  4239. pnlForHideWebBrowserAdvertisement.Visible := True;
  4240. WebBrowserForAdvertisement.OnDocumentComplete := WebBrowserForAdvertisementDocumentComplete;
  4241. WebBrowserForAdvertisement.Navigate(FRealICQClient.TalkingFormAdversement.URL);
  4242. WebBrowserForAdvertisement.OnBeforeNavigate2 := WebBrowserForAdvertisementBeforeNavigate2;
  4243. pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
  4244. end;
  4245. end;
  4246. //------------------------------------------------------------------------------
  4247. procedure TTalkingForm.LoadNotReadMessagesFromDBHistory(DBHistorySearchResult: TDBHistorySearchResult);
  4248. var
  4249. iLoop: Integer;
  4250. MessageSearchResult: TMessageSearchResult;
  4251. SenderName, SplitHTML, FontStr, AMessageStr: string;
  4252. FRealICQUser: TRealICQUser;
  4253. TextFont: TFont;
  4254. iIndex: Integer;
  4255. MessageList: TList;
  4256. NotReadMessageCount: Integer;
  4257. OldAllowURL: Boolean;
  4258. begin
  4259. ClearHTML(self.WebBrowser);
  4260. for iLoop := DBHistorySearchResult.Messages.Count - 1 downto 0 do
  4261. begin
  4262. MessageSearchResult := DBHistorySearchResult.Messages[iLoop];
  4263. if MessageSearchResult.TeamID = '-5' then
  4264. begin
  4265. Continue;
  4266. end;
  4267. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
  4268. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  4269. SenderName := FRealICQUser.LoginName
  4270. else
  4271. SenderName := FRealICQUser.DisplayName;
  4272. // TextFont := TFont.Create;
  4273. // OldAllowURL := MainForm.AllowURL;
  4274. try
  4275. // MainForm.AllowURL := False;
  4276. // StringToFont(MessageSearchResult.Font, TextFont);
  4277. // TextFont.Color := $00686868;
  4278. // FontStr := FontToString(TextFont);
  4279. if MessageSearchResult.IsEncryMessage then
  4280. AMessageStr := IntToStr(MessageSearchResult.ID)
  4281. else
  4282. AMessageStr := MessageSearchResult.MessageStr;
  4283. AddMessageToWebBrowser(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
  4284. finally
  4285. // MainForm.AllowURL := OldAllowURL;
  4286. // TextFont.Free;
  4287. end;
  4288. end;
  4289. end;
  4290. procedure TTalkingForm.LoadOfflinefilesConfig;
  4291. var
  4292. XMLDocument: TXMLDocument;
  4293. ServerConfigNode: IXMLNode;
  4294. begin
  4295. XMLDocument := TXMLDocument.Create(Self);
  4296. try
  4297. XMLDocument.Active := True;
  4298. if csDesigning in ComponentState then
  4299. exit;
  4300. XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName) + ConfigXMLFilePath + 'OfflinefilesServerConfig.xml');
  4301. ServerConfigNode := XMLDocument.DocumentElement;
  4302. FOfflinefilesAddr := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Address'];
  4303. FOfflinefilesPort := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['Port'];
  4304. FPackageSize := ServerConfigNode.ChildNodes.FindNode('OfflinefilesServer').Attributes['PackageSize'];
  4305. finally
  4306. XMLDocument.Free;
  4307. end;
  4308. end;
  4309. //------------------------------------------------------------------------------
  4310. procedure TTalkingForm.LoadHistoryMessages;
  4311. var
  4312. iLoop: Integer;
  4313. MessageSearchResult: TMessageSearchResult;
  4314. SenderName, SplitHTML, FontStr, AMessageStr: string;
  4315. FRealICQUser: TRealICQUser;
  4316. iIndex: Integer;
  4317. MessageList: TList;
  4318. Alias: string;
  4319. begin
  4320. if FCategory = tcNormal then
  4321. MessageList := MainForm.DBHistory.GetMessage('-1', FReceiver, FRealICQClient.LoginName, FMaxID, 8)
  4322. else
  4323. MessageList := MainForm.DBHistory.GetMessage(FTeamID, FReceiver, FRealICQClient.LoginName, FMaxID, 8);
  4324. for iLoop := 0 to MessageList.Count - 1 do
  4325. begin
  4326. MessageSearchResult := MessageList[iLoop];
  4327. if MessageSearchResult.TeamID = '-5' then
  4328. begin
  4329. Continue;
  4330. end;
  4331. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
  4332. Alias := TTeamsAdapter.GetAlias(FTeamID, FRealICQUser.LoginName);
  4333. if trim(Alias) = '' then
  4334. begin
  4335. if Length(Trim(FRealICQUser.DisplayName)) = 0 then
  4336. SenderName := FRealICQUser.LoginName
  4337. else
  4338. SenderName := FRealICQUser.DisplayName;
  4339. end
  4340. else
  4341. SenderName := Alias;
  4342. if MessageSearchResult.IsEncryMessage then
  4343. AMessageStr := IntToStr(MessageSearchResult.ID)
  4344. else
  4345. AMessageStr := MessageSearchResult.MessageStr;
  4346. AddMessageToWebBrowserTop(FRealICQUser.LoginName, SenderName, MessageSearchResult.Font, AMessageStr, MessageSearchResult.SendDateTime, MessageSearchResult.IsEncryMessage, False, False);
  4347. end;
  4348. if MessageList.Count > 0 then
  4349. FMaxID := TMessageSearchResult(MessageList[MessageList.Count - 1]).ID;
  4350. TRealICQUtility.FreeList(MessageList);
  4351. end;
  4352. //------------------------------------------------------------------------------
  4353. procedure TTalkingForm.LoadNotReadMessages;
  4354. var
  4355. iIndex: Integer;
  4356. MessageList: TList;
  4357. NotReadMessage: TNotReadMessage;
  4358. NotReadTeamMessage: TNotReadTeamMessage;
  4359. begin
  4360. try
  4361. Application.ProcessMessages;
  4362. LoadHistoryMessages;
  4363. except
  4364. end;
  4365. GoBottom(Webbrowser);
  4366. if FCategory = tcNormal then
  4367. begin
  4368. iIndex := MainForm.NotReadMessages.IndexOf(Receiver);
  4369. if iIndex < 0 then
  4370. Exit;
  4371. MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
  4372. MainForm.NotReadMessages.Delete(iIndex);
  4373. try
  4374. NotReadMessageBoxForm.ShowNotReadMessage;
  4375. NotReadMessageBoxForm.Height := 0;
  4376. NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
  4377. except
  4378. end;
  4379. // MainForm.DBHistory.SetReadFlag('-1', Receiver);
  4380. //
  4381. // while MessageList.Count > 0 do
  4382. // begin
  4383. // NotReadMessage := TNotReadMessage(MessageList[0]);
  4384. // ShowMessage(NotReadMessage.RealICQMessage, NotReadMessage.ShowSendFailed);
  4385. // MessageList.Delete(0);
  4386. // FreeAndNil(NotReadMessage);
  4387. // end;
  4388. // FreeAndNil(MessageList);
  4389. TRealICQUtility.FreeList(MessageList);
  4390. MainForm.StopFlash(Receiver);
  4391. end
  4392. else
  4393. begin
  4394. iIndex := MainForm.NotReadMessages.IndexOf(TeamMessageID + FTeamID);
  4395. if iIndex < 0 then
  4396. Exit;
  4397. MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList;
  4398. MainForm.NotReadMessages.Delete(iIndex);
  4399. MainForm.DBHistory.SetReadFlag(FTeamID, '');
  4400. try
  4401. NotReadMessageBoxForm.ShowNotReadMessage;
  4402. NotReadMessageBoxForm.Height := 0;
  4403. NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
  4404. except
  4405. end;
  4406. // while MessageList.Count > 0 do
  4407. // begin
  4408. // NotReadTeamMessage := TNotReadTeamMessage(MessageList[0]);
  4409. //
  4410. // ShowTeamMessage(NotReadTeamMessage.RealICQTeamMessage, NotReadTeamMessage.ShowSendFailed);
  4411. // MessageList.Delete(0);
  4412. // FreeAndNil(NotReadTeamMessage);
  4413. // end;
  4414. // FreeAndNil(MessageList);
  4415. TRealICQUtility.FreeList(MessageList);
  4416. MainForm.StopFlashTeam(FTeamID);
  4417. end;
  4418. end;
  4419. {设置WebBrowser的样式}
  4420. //------------------------------------------------------------------------------
  4421. procedure TTalkingForm.SetDOMStyle(Doc: IHTMLDocument2);
  4422. var
  4423. v: Variant;
  4424. CurrentColor, CssColor: string;
  4425. AHtmlFile: TFileStream;
  4426. AStrStream: TStringStream;
  4427. begin
  4428. // if pnlForHideWebBrowser.Visible then
  4429. // begin
  4430. // try
  4431. // AHtmlFile := TFileStream.Create('E:\\DelphiProjects\\IMClient-Root-CMG\\html\\chat.html', fmOpenRead);
  4432. // AStrStream := TStringStream.Create('');
  4433. // AStrStream.CopyFrom(AHtmlFile, AHtmlFile.Size);
  4434. // v := VarArrayCreate([0, 0], varVariant);
  4435. // v[0] := AStrStream.DataString;
  4436. // // v[0] := '<html dir="ltr" lang="zh">'
  4437. // // + '<head>'
  4438. // // + '<META http-equiv="Content-Type" content="text/html; charset=gb2312">'
  4439. // // + '<body link="#0000FF" vlink="#0000FF" alink="#0000FF" hlink="#0000FF" bgcolor="#fdfdfd" oncontextmenu="location.href=''PopMenu'';return false;">'
  4440. // // + '</body>'
  4441. // // + '</head>'; //????????????????????????
  4442. // doc.write(PSafeArray(TVarData(v).VArray));
  4443. // finally
  4444. // AHtmlFile.Free;
  4445. // AStrStream.Free;
  4446. // end;
  4447. // end;
  4448. try
  4449. CurrentColor := IntToHex(ConvertColorToColor($00CDCDCD, FWindowColor), 6);
  4450. CssColor := '#' + Copy(CurrentColor, 5, 2) + Copy(CurrentColor, 3, 2) + Copy(CurrentColor, 1, 2);
  4451. except
  4452. end;
  4453. Doc.body.language := 'gb2312';
  4454. 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;}';
  4455. Doc.body.style.overflow := 'auto';
  4456. Doc.body.style.border := '0px solid';
  4457. Doc.body.style.margin := '2px';
  4458. Doc.body.style.fontFamily := '宋体';
  4459. Doc.body.style.fontSize := '9pt';
  4460. Doc.body.style.backgroundImage := 'url(' + FBackGroundImage + ')';
  4461. end;
  4462. //------------------------------------------------------------------------------
  4463. procedure TTalkingForm.WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4464. begin
  4465. // Dialogs.ShowMessage(IntToStr(Pos(FBaseURL, UpperCase(String(URL)))));
  4466. // Dialogs.ShowMessage(IntToStr(Pos('about:blank', UpperCase(String(URL)))));
  4467. if (Pos(FBaseURL, UpperCase(string(URL))) >= 1) or (Pos('about:blank', string(URL)) >= 1) then
  4468. begin
  4469. URL := Trim(AnsiReplaceText(string(URL), FBaseURL, ''));
  4470. if TFileTransmitAdapter.HandleMessage(Self, URL, Cancel) then
  4471. Exit;
  4472. IEBeforeNavigate2(Self, ASender, pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel);
  4473. end
  4474. else
  4475. begin
  4476. if Category = tcNormal then
  4477. begin
  4478. if FileExists(string(URL)) then
  4479. begin
  4480. if FRealICQClient.Connected and FRealICQClient.Logined then
  4481. begin
  4482. SendDropFile(string(URL));
  4483. Cancel := True;
  4484. end;
  4485. end;
  4486. if DirectoryExists(string(URL)) then
  4487. begin
  4488. if FRealICQClient.Connected and FRealICQClient.Logined then
  4489. begin
  4490. OpenSendFolderForm(string(URL));
  4491. Cancel := True;
  4492. end;
  4493. end;
  4494. end
  4495. else
  4496. begin
  4497. if FileExists(string(URL)) then
  4498. begin
  4499. if FRealICQClient.Connected and FRealICQClient.Logined then
  4500. begin
  4501. SendDropFile(string(URL));
  4502. Cancel := True;
  4503. end;
  4504. end;
  4505. end;
  4506. end;
  4507. end;
  4508. //------------------------------------------------------------------------------
  4509. function TTalkingForm.GetCanWriteMessage: Boolean;
  4510. begin
  4511. Result := not pnlForHideWebBrowser.Visible;
  4512. end;
  4513. //------------------------------------------------------------------------------
  4514. procedure TTalkingForm.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4515. begin
  4516. try
  4517. Log('WebBrowserDocumentComplete', 'WebBrowser');
  4518. WebBrowser.OnDocumentComplete := nil;
  4519. try
  4520. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  4521. finally
  4522. pnlForHideWebBrowser.Visible := False;
  4523. end;
  4524. except
  4525. end;
  4526. end;
  4527. //------------------------------------------------------------------------------
  4528. procedure TTalkingForm.WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4529. begin
  4530. if not AnsiSameText(URL, FRealICQClient.TalkingFormAdversement.URL) then
  4531. begin
  4532. ShellExecute(handle, 'open', PChar(MainForm.GetDefaultBrowser), PChar('"' + string(URL) + '"'), nil, SW_SHOWNORMAL);
  4533. Cancel := True;
  4534. end;
  4535. end;
  4536. //------------------------------------------------------------------------------
  4537. procedure TTalkingForm.WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4538. begin
  4539. try
  4540. WebBrowserForAdvertisement.OnDocumentComplete := nil;
  4541. MainForm.SetDomStyle(WebBrowserForAdvertisement.Document as IHtmlDocument2);
  4542. except
  4543. end;
  4544. Application.ProcessMessages;
  4545. pnlForHideWebBrowserAdvertisement.Visible := False;
  4546. pnlAdvertisement.Width := FRealICQClient.TalkingFormAdversement.Width;
  4547. Constraints.MinWidth := 288 + pnlAdvertisement.Width;
  4548. ClearMemory;
  4549. end;
  4550. procedure TTalkingForm.WebBrowserForTeamDiskBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4551. begin
  4552. if FileExists(string(URL)) then
  4553. TTeamShareAdapter.UploadFile(TeamID, string(URL), Self, Self.FRealICQClient, False);
  4554. end;
  4555. procedure TTalkingForm.WebBrowserForTeamDiskoldBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
  4556. var
  4557. strMissionID, strFileName, js: string;
  4558. begin
  4559. if FileExists(string(URL)) then
  4560. begin
  4561. if FRealICQClient.Connected and Self.FRealICQClient.Logined then
  4562. begin
  4563. try
  4564. strMissionID := '1|' + IntToStr(GetTickCount) + ',' + TeamID + ',' + MainForm.RealICQClient.LoginName;
  4565. strFileName := string(URL);
  4566. js := format('ReadyToUpload("%s", "%s", %d)', [strMissionID, ReplaceStr(strFileName, '\', '\\'), GetTheFileSize(strFileName)]);
  4567. try
  4568. WebBrowserForTeamDisk.OleObject.Document.parentWindow.execScript(js, 'JavaScript');
  4569. except
  4570. end;
  4571. except
  4572. on E: Exception do
  4573. MessageBox(0, PChar(E.Message), '上传文件出错! ', MB_ICONINFORMATION);
  4574. end;
  4575. end;
  4576. Cancel := True;
  4577. end;
  4578. end;
  4579. procedure TTalkingForm.WebBrowserForTeamDiskoldDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  4580. begin
  4581. pnlForHideTeamDisk.Visible := False;
  4582. WebBrowserForTeamDisk.OnDocumentComplete := nil;
  4583. end;
  4584. //------------------------------------------------------------------------------
  4585. procedure TTalkingForm.OnKeyDown(var Msg: TMessage);
  4586. begin
  4587. if RemoteControlForm = nil then
  4588. Exit;
  4589. if RemoteControlForm.Parent <> pnlRC then
  4590. Exit;
  4591. if FRemoteControlMission <> nil then
  4592. FRemoteControlMission.SendMessage(Msg);
  4593. end;
  4594. //------------------------------------------------------------------------------
  4595. procedure TTalkingForm.OnKeyUp(var Msg: TMessage);
  4596. begin
  4597. if RemoteControlForm = nil then
  4598. Exit;
  4599. if RemoteControlForm.Parent <> pnlRC then
  4600. Exit;
  4601. if FRemoteControlMission <> nil then
  4602. FRemoteControlMission.SendMessage(Msg);
  4603. end;
  4604. //------------------------------------------------------------------------------
  4605. procedure TTalkingForm.CMWininichange(var Message: TWMWinIniChange);
  4606. begin
  4607. ChangeUIColor(MainForm.UIMainColor);
  4608. DisableAlign;
  4609. try
  4610. PostMessage(Handle, WM_SIZE, 0, 0);
  4611. finally
  4612. EnableAlign;
  4613. end;
  4614. end;
  4615. //------------------------------------------------------------------------------
  4616. procedure TTalkingForm.CreateParams(var Params: TCreateParams);
  4617. begin
  4618. inherited;
  4619. with Params do
  4620. begin
  4621. Params.WndParent := 0;
  4622. end;
  4623. end;
  4624. //------------------------------------------------------------------------------
  4625. procedure TTalkingForm.SendDropFile(AFileName: string);
  4626. var
  4627. FRealICQUser: TRealICQUser;
  4628. AFileStream: TFileStream;
  4629. AModalResult: Integer;
  4630. UpUrl: string;
  4631. AFileSize: int64;
  4632. AError: string;
  4633. begin
  4634. if not FRealICQClient.Connected or not FRealICQClient.Logined then
  4635. Exit;
  4636. //Success('1', 'TTalkingForm.SendDropFile');
  4637. try
  4638. if FCategory = tcTeam then
  4639. begin
  4640. if DirectoryExists(AFileName) then
  4641. begin
  4642. MessageBox(0, PChar('不支持直接上传目录,请压缩后上传! '), '提示', MB_ICONINFORMATION);
  4643. Exit;
  4644. end;
  4645. if FileExists(AFileName) then
  4646. TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
  4647. Exit;
  4648. end;
  4649. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4650. if not Assigned(FRealICQUser) then
  4651. Exit;
  4652. //Success('2', 'TTalkingForm.SendDropFile');
  4653. if not (FRealICQUser.LoginState = stOffline) and not (FRealICQUser.LoginState = stHidden) then
  4654. begin
  4655. SendFile(AFileName);
  4656. Exit;
  4657. end;
  4658. //Success('3', 'TTalkingForm.SendDropFile');
  4659. if TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient) then
  4660. begin
  4661. MessageBox(0, PChar(AError), '提示', MB_ICONINFORMATION);
  4662. PostMessage(Handle, WM_SETFOCUS, 0, 0);
  4663. Exit;
  4664. end;
  4665. //Success('3', 'TTalkingForm.SendDropFile');
  4666. TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
  4667. except
  4668. on E: Exception do
  4669. Error(E.Message, 'TTalkingForm.SendDropFile(' + AFileName + ')');
  4670. end;
  4671. end;
  4672. procedure TTalkingForm.RichEdInputerDropFiles(Sender: TObject; AFiles: TStringList);
  4673. var
  4674. iLoop: Integer;
  4675. iTimes: Integer;
  4676. UpUrl: string;
  4677. AFileSize: int64;
  4678. begin
  4679. iTimes := 0;
  4680. for iLoop := 0 to AFiles.Count - 1 do
  4681. begin
  4682. try
  4683. if FileExists(AFiles[iLoop]) and (RichEdInputer.InsertDIB) then
  4684. begin
  4685. if (AFiles.Count = 1) then
  4686. begin
  4687. AddImageToInput(AFiles[iLoop], RichEdInputer);
  4688. Break;
  4689. end;
  4690. end;
  4691. except
  4692. on E: Exception do
  4693. Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles-RichEdInputer.InsertDIB');
  4694. end;
  4695. try
  4696. if FCategory = tcTeam then
  4697. begin
  4698. if TGroupConfig.GetConfig.GroupVersion = gvIntegration then
  4699. begin
  4700. if not (MessageBox(0, '确定要群发该文件吗? ', '提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK) then
  4701. Exit;
  4702. TFileTransmitAdapter.Send(Self, tdSender, AFiles[iLoop], 1, FTeamID, '', Now, FRealICQClient);
  4703. end
  4704. else
  4705. TTeamShareAdapter.UploadFile(TeamID, AFiles[iLoop], Self, FRealICQClient, True);
  4706. end
  4707. else
  4708. begin
  4709. if DirectoryExists(AFiles[iLoop]) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4710. begin
  4711. OpenSendFolderForm(AFiles[iLoop]);
  4712. Exit;
  4713. end;
  4714. if (iTimes < 10) and MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4715. begin
  4716. SendDropFile(AFiles[iLoop]);
  4717. Inc(iTimes);
  4718. end;
  4719. end;
  4720. except
  4721. on E: Exception do
  4722. Error(E.Message, 'TTalkingForm.RichEdInputerDropFiles');
  4723. end;
  4724. end;
  4725. end;
  4726. procedure TTalkingForm.RichEdInputerInsertObject(Sender: TObject);
  4727. begin
  4728. TimerForCheckPastedContent.Enabled := False;
  4729. TimerForCheckPastedContent.Tag := 0;
  4730. TimerForCheckPastedContent.Enabled := True;
  4731. end;
  4732. { TODO -olqq -c : 群共享文件发送完成后,通知群成员 2014/12/18 14:45:09 }
  4733. procedure TTalkingForm.DownFileComplete(ASource, ADest, ARemark: string; AStatus: boolean; AFileSize: Integer; IsNeedNotify: Boolean);
  4734. var
  4735. MessageStr: string;
  4736. FaceFileName: TStringList;
  4737. IsAdmin: string;
  4738. begin
  4739. if not AStatus then
  4740. begin
  4741. spbUploadTeamFileProcess.Visible := False;
  4742. Messagebox(handle, PAnsiChar(ARemark), '提示', MB_OK);
  4743. Exit;
  4744. end;
  4745. if IsNeedNotify then
  4746. TTeamShareAdapter.UploadedNotifyToMembers(FRealICQClient.LoginName, TTeamsAdapter.GetTeam(FTeamID).TeamMembers, ARemark, ExtractFileName(ADest), AFileSize, FRealICQClient);
  4747. if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
  4748. IsAdmin := '1'
  4749. else
  4750. IsAdmin := '0';
  4751. spbUploadTeamFileProcess.Visible := False;
  4752. spbUploadTeamFileProcess.Caption := '%0';
  4753. FaceFileName := TStringList.Create;
  4754. try
  4755. MessageStr := '<TeamShare>' + ExtractFileName(ADest) + '</TeamShare>';
  4756. TTeamsAdapter.SendTeamMessage(FTeamID, MainForm.realICQClient.LoginName, MessageStr, RichEdInputer.Font, FaceFileName, '');
  4757. finally
  4758. FaceFileName.Free;
  4759. end;
  4760. WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
  4761. end;
  4762. procedure TTalkingForm.DropFiles(var Message: TMessage);
  4763. var
  4764. i: Integer;
  4765. p: array[0..254] of Char;
  4766. ALocalFile, AFileExt, ALocalPath, ALocalFilePath: string;
  4767. iTimes: Integer;
  4768. UpUrl: string;
  4769. AFileSize: Int64;
  4770. begin
  4771. iTimes := 0;
  4772. try
  4773. i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
  4774. for i := 0 to i - 1 do
  4775. begin
  4776. DragQueryFile(Message.wParam, i, p, 255);
  4777. if FileExists(StrPas(p)) then
  4778. begin
  4779. ALocalFile := StrPas(p);
  4780. //Success(ALocalFile, 'TTalkingForm.DropFiles');
  4781. AFileExt := ExtractFileExt(ALocalFile);
  4782. if AnsiSameText(AFileExt, '.gif') or AnsiSameText(AFileExt, '.jpg') or AnsiSameText(AFileExt, '.bmp') or AnsiSameText(AFileExt, '.png') or AnsiSameText(AFileExt, '.jpeg') then
  4783. begin
  4784. ALocalPath := ExtractFilePath(Application.ExeName);
  4785. ALocalFilePath := ExtractFilePath(ALocalFile);
  4786. ALocalFilePath := Copy(ALocalFilePath, 1, Length(ALocalPath));
  4787. if AnsiSameText(ALocalPath, ALocalFilePath) then
  4788. begin
  4789. Continue;
  4790. end;
  4791. end;
  4792. if FCategory = tcTeam then
  4793. begin
  4794. TTeamShareAdapter.UploadFile(TeamID, StrPas(p), Self, FRealICQClient, False);
  4795. end
  4796. else if FCategory = tcNormal then
  4797. begin
  4798. if DirectoryExists(StrPas(p)) then
  4799. begin
  4800. if MainForm.RealICQClient.Connected and MainForm.RealICQClient.Logined then
  4801. OpenSendFolderForm(StrPas(p));
  4802. end;
  4803. end;
  4804. end;
  4805. end;
  4806. except
  4807. on E: Exception do
  4808. begin
  4809. Error(E.Message, 'TTalkingForm.DropFiles');
  4810. DragFinish(Message.wParam);
  4811. Message.Result := 1;
  4812. end;
  4813. end;
  4814. DragFinish(Message.wParam);
  4815. Message.Result := 1;
  4816. end;
  4817. //------------------------------------------------------------------------------
  4818. procedure TTalkingForm.ShowInputting(AInputting: Boolean);
  4819. var
  4820. UserName: string;
  4821. RealICQUser: TRealICQUser;
  4822. begin
  4823. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4824. if not Assigned(RealICQUser) then
  4825. UserName := FReceiver
  4826. else if RealICQUser.DisplayName = '' then
  4827. UserName := RealICQUser.LoginName
  4828. else
  4829. UserName := RealICQUser.DisplayName;
  4830. if AInputting then
  4831. begin
  4832. lblState.Caption := UserName + ' 正在输入消息...';
  4833. Caption := UserName + ' 正在输入';
  4834. ClearInputtingMessageTimer.Enabled := False;
  4835. ClearInputtingMessageTimer.Enabled := True;
  4836. end
  4837. else
  4838. begin
  4839. lblState.Caption := '';
  4840. Caption := UserName;
  4841. ClearInputtingMessageTimer.Enabled := False;
  4842. end;
  4843. PostMessage(Handle, WM_SIZE, 0, 0);
  4844. end;
  4845. //------------------------------------------------------------------------------
  4846. procedure TTalkingForm.P2PTypeChanged(Sender: TObject);
  4847. var
  4848. RealICQPtoPBox: TRealICQPtoPBox;
  4849. begin
  4850. if not (Sender is TRealICQPtoPBox) then
  4851. Exit;
  4852. try
  4853. RealICQPtoPBox := Sender as TRealICQPtoPBox;
  4854. case RealICQPtoPBox.P2PType of
  4855. ppTransByServerTCP:
  4856. lblState.Caption := '连接方式: 服务器中转';
  4857. ppPtoPByTCPServer:
  4858. lblState.Caption := '连接方式: TCP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ' -> 本机)';
  4859. ppPtoPByTCPClient:
  4860. lblState.Caption := '连接方式: TCP直连(本机 -> ' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
  4861. ppPtoPByUDP:
  4862. lblState.Caption := '连接方式: UDP直连(' + RealICQPtoPBox.P2PAddress + ':' + IntToStr(RealICQPtoPBox.P2PPort) + ')';
  4863. end;
  4864. except
  4865. end;
  4866. end;
  4867. procedure TTalkingForm.OpenSendFolderForm(FolderName: string);
  4868. var
  4869. SendFolderForm: TSendFolderForm;
  4870. RealICQUser: TRealICQUser;
  4871. iLoop: Integer;
  4872. ReceiverName: string;
  4873. begin
  4874. if not MainForm.RealICQClient.Connected or not MainForm.RealICQClient.Logined then
  4875. Exit;
  4876. SendFolderForm := TSendFolderForm.Create(MainForm);
  4877. if Category = tcNormal then
  4878. begin
  4879. if AnsiSameText(Receiver, MainForm.RealICQClient.LoginName) then
  4880. Exit;
  4881. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  4882. if not Assigned(RealICQUser) then
  4883. Exit;
  4884. with SendFolderForm.lvUsers.Items.Add do
  4885. begin
  4886. Caption := RealICQUser.LoginName;
  4887. SubItems.Add(RealICQUser.DisplayName);
  4888. end;
  4889. end
  4890. else
  4891. begin
  4892. Exit;
  4893. end;
  4894. SendFolderForm.Show;
  4895. // SendFolderForm.BringToFront;
  4896. if DirectoryExists(FolderName) then
  4897. begin
  4898. SendFolderForm.AddFolderMission(FolderName);
  4899. end;
  4900. end;
  4901. //------------------------------------------------------------------------------
  4902. procedure TTalkingForm.spbSendFolderClick(Sender: TObject);
  4903. begin
  4904. OpenSendFolderForm('');
  4905. end;
  4906. //------------------------------------------------------------------------------
  4907. procedure TTalkingForm.spbAboutClick(Sender: TObject);
  4908. begin
  4909. MainForm.actAbout.Execute;
  4910. end;
  4911. procedure TTalkingForm.spbBackgroundClick(Sender: TObject);
  4912. var
  4913. Point: TPoint;
  4914. begin
  4915. if SelBackForm = nil then
  4916. begin
  4917. SelBackForm := TSelBackForm.Create(MainForm);
  4918. end;
  4919. SelBackForm.ParentForm := Self;
  4920. Point.X := 0;
  4921. Point.Y := (Sender as TRealICQSpeedButton).Height;
  4922. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4923. Point.X := Point.X - (SelBackForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
  4924. if Point.X <= 0 then
  4925. SelBackForm.Left := 1
  4926. else if Screen.WorkAreaWidth - Point.X >= SelBackForm.Width then
  4927. SelBackForm.Left := Point.X
  4928. else
  4929. SelBackForm.Left := Screen.WorkAreaWidth - SelBackForm.Width - 1;
  4930. if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelBackForm.Height) then
  4931. SelBackForm.Top := Point.Y - SelBackForm.Height - (Sender as TRealICQSpeedButton).Height
  4932. else
  4933. SelBackForm.Top := Point.Y;
  4934. SelBackForm.Show;
  4935. end;
  4936. procedure ShowCopyScreenForm(ATalkingForm: TTalkingForm);
  4937. begin
  4938. if Assigned(CopyScreenForm) then
  4939. Exit;
  4940. if ATalkingForm <> nil then
  4941. CopyScreenForm := TCopyScreenForm.Create(ATalkingForm)
  4942. else
  4943. CopyScreenForm := TCopyScreenForm.Create(MainForm);
  4944. try
  4945. CopyScreenForm.TalkingForm := ATalkingForm;
  4946. CopyScreenForm.WindowState := wsMaximized;
  4947. CopyScreenForm.ShowModal; //显示窗口
  4948. finally
  4949. FreeAndNil(CopyScreenForm);
  4950. end;
  4951. end;
  4952. //------------------------------------------------------------------------------
  4953. procedure TTalkingForm.spbFaceClick(Sender: TObject);
  4954. var
  4955. Point: TPoint;
  4956. begin
  4957. if SelFaceForm = nil then
  4958. begin
  4959. SelFaceForm := TSelFaceForm.Create(MainForm);
  4960. end;
  4961. SelFaceForm.TalkingForm := Self;
  4962. Point.X := 0;
  4963. Point.Y := (Sender as TRealICQSpeedButton).Height;
  4964. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4965. Point.X := Point.X - (SelFaceForm.Width div 2) + (Sender as TRealICQSpeedButton).Width div 2;
  4966. if Point.X <= 0 then
  4967. SelFaceForm.Left := 1
  4968. else if Screen.WorkAreaWidth - Point.X >= SelFaceForm.Width then
  4969. SelFaceForm.Left := Point.X
  4970. else
  4971. SelFaceForm.Left := Screen.WorkAreaWidth - SelFaceForm.Width - 1;
  4972. if (Point.Y - (Sender as TRealICQSpeedButton).Height > SelFaceForm.Height) then
  4973. SelFaceForm.Top := Point.Y - SelFaceForm.Height - (Sender as TRealICQSpeedButton).Height
  4974. else
  4975. SelFaceForm.Top := Point.Y;
  4976. SelFaceForm.Show;
  4977. end;
  4978. //------------------------------------------------------------------------------
  4979. procedure TTalkingForm.spbFontClick(Sender: TObject);
  4980. begin
  4981. EditFontSet.Execute;
  4982. end;
  4983. //------------------------------------------------------------------------------
  4984. procedure TTalkingForm.SpbForMyInfoClick(Sender: TObject);
  4985. var
  4986. Point: TPoint;
  4987. begin
  4988. Point.X := 0;
  4989. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  4990. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  4991. if FRealICQClient = MainForm.RealICQClient then
  4992. ppMyOptions.Popup(Point.X, Point.Y)
  4993. else
  4994. MainForm.ppChangeCustomerState.Popup(Point.X, Point.Y);
  4995. end;
  4996. //------------------------------------------------------------------------------
  4997. procedure TTalkingForm.SpbForYourInfoClick(Sender: TObject);
  4998. var
  4999. Point: TPoint;
  5000. begin
  5001. Point.X := 0;
  5002. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5003. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5004. ppYourOptions.Popup(Point.X, Point.Y);
  5005. end;
  5006. //------------------------------------------------------------------------------
  5007. procedure TTalkingForm.ShakeWindow;
  5008. var
  5009. iLoop: Integer;
  5010. OldLeft: Integer;
  5011. begin
  5012. PlayEventSound(ExtractFilePath(Application.ExeName) + '\' + ShakeWindowSound);
  5013. OldLeft := Left;
  5014. try
  5015. for iLoop := 12 downto 0 do
  5016. begin
  5017. if iLoop mod 2 = 0 then
  5018. Left := OldLeft + iLoop * 1
  5019. else
  5020. Left := OldLeft - iLoop * 1;
  5021. Sleep(10);
  5022. Application.ProcessMessages;
  5023. Sleep(10);
  5024. end;
  5025. finally
  5026. Left := OldLeft;
  5027. end;
  5028. end;
  5029. //------------------------------------------------------------------------------
  5030. procedure TTalkingForm.spbShakeWindowClick(Sender: TObject);
  5031. var
  5032. FRealICQUser: TRealICQUser;
  5033. begin
  5034. if GetTickCount - FLastSendShakeWindowTicket < 150000 then
  5035. begin
  5036. MessageBox(Handle, '请勿频繁发送窗口抖动! ', '提示', MB_ICONINFORMATION);
  5037. Exit;
  5038. end;
  5039. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  5040. if Assigned(FRealICQUser) then
  5041. begin
  5042. if (FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden) then
  5043. begin
  5044. MessageBox(Handle, '对方离线或隐身,无法接收窗口抖动! ', '提示', MB_ICONINFORMATION);
  5045. Exit;
  5046. end;
  5047. FLastSendShakeWindowTicket := GetTickCount;
  5048. ShowShakeWindow(True);
  5049. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).SendShakeWindow;
  5050. end;
  5051. end;
  5052. //------------------------------------------------------------------------------
  5053. procedure TTalkingForm.SetBrowserBg(BackImage: string);
  5054. begin
  5055. FBackGroundImage := BackImage;
  5056. try
  5057. SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  5058. except
  5059. end;
  5060. SaveBackGround;
  5061. end;
  5062. //------------------------------------------------------------------------------
  5063. procedure TTalkingForm.ShowShakeWindow(AIsSource: Boolean);
  5064. var
  5065. HTML: string;
  5066. UserName: string;
  5067. RealICQUser: TRealICQUser;
  5068. begin
  5069. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
  5070. if not Assigned(RealICQUser) then
  5071. UserName := FReceiver
  5072. else if RealICQUser.DisplayName = '' then
  5073. UserName := RealICQUser.LoginName
  5074. else
  5075. UserName := RealICQUser.DisplayName;
  5076. HTML := '<table width="100%" style="font-size:9pt;border:0px; padding:2px; color:#0000ff; margin-top:2px;margin-bottom:5px;"><tr><td>';
  5077. HTML := HTML + '<img src="' + ExtractFilePath(Application.ExeName) + InfomationPicture + '" align="absBottom"> ';
  5078. HTML := HTML + '<span>';
  5079. if AIsSource then
  5080. HTML := HTML + '您抖动了 ' + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 的对话窗口。'
  5081. else
  5082. HTML := HTML + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 抖动了您的对话窗口。';
  5083. HTML := HTML + '</span>';
  5084. HTML := HTML + '</td></tr></table>';
  5085. InsertHTML(WebBrowser, HTML);
  5086. Application.ProcessMessages;
  5087. ShakeWindow;
  5088. Sleep(450);
  5089. ShakeWindow;
  5090. end;
  5091. //------------------------------------------------------------------------------
  5092. procedure TTalkingForm.spbSpkClick(Sender: TObject);
  5093. var
  5094. Point: TPoint;
  5095. begin
  5096. Point.X := 0;
  5097. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5098. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5099. miOpenMic.Visible := False;
  5100. miCloseMic.Visible := False;
  5101. miOpenSpeak.Visible := True;
  5102. miCloseSpeak.Visible := True;
  5103. miOpenSpeak.Enabled := not TAudioTransmitter.GetRecvAudio;
  5104. miCloseSpeak.Enabled := TAudioTransmitter.GetRecvAudio;
  5105. ppAudioSet.Popup(Point.X, Point.Y);
  5106. end;
  5107. procedure TTalkingForm.spbTeamNetWorkDiskClick(Sender: TObject);
  5108. var
  5109. STR: string;
  5110. IsAdmin: string;
  5111. begin
  5112. if TTeamsAdapter.IsTeamManager(FTeamID, MainForm.RealICQClient.LoginName) then
  5113. IsAdmin := '1'
  5114. else
  5115. IsAdmin := '0';
  5116. LockWindowUpdate(GetDesktopWindow);
  5117. try
  5118. Width := 800;
  5119. PnlTeamCallBoard.Visible := False;
  5120. rndTeamMembers.Visible := False;
  5121. pnlUserInformation.Width := 450;
  5122. pnlTeamWebDisk.Visible := True;
  5123. WebBrowserForTeamDisk.Navigate(TTeamShareAdapter.GetShareURL(TeamID, FRealICQClient.LoginName, FRealICQClient.Me.DisplayName, IsAdmin));
  5124. //WebBrowserForTeamDisk.OnDocumentComplete := WebBrowserForTeamDiskDocumentComplete;
  5125. //STR := 'http://192.168.16.202:8083/home/index?loginname='+MainForm.RealICQClient.LoginName+'&teamid='+TeamID+'&displayname='+HttpEncode(Ansitoutf8(MainForm.RealICQClient.Me.DisplayName)+'&isAdmin='+IsAdmin);
  5126. // STR := MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount);
  5127. // WebBrowserForTeamDisk.Navigate(MainForm.RealICQClient.HeadImageURL + '/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
  5128. //WebBrowserForTeamDisk.Navigate('http://172.28.1.76/share/Default.aspx?TeamID=' + TeamID + '&LoginName=' + MainForm.RealICQClient.LoginName + '&password=' + MD5En(MainForm.RealICQClient.Password) + '&tick=' + IntToStr(GetTickCount));
  5129. finally
  5130. LockWindowUpdate(0);
  5131. end;
  5132. end;
  5133. procedure TTalkingForm.spbCloseTeamWebDiskClick(Sender: TObject);
  5134. var
  5135. iLoop: Integer;
  5136. AFileMission: TUploadOrDownloadFileMission;
  5137. AFinded: Boolean;
  5138. begin
  5139. AFinded := False;
  5140. if FUpDownFileMissions.Count > 0 then
  5141. begin
  5142. {for iLoop := UpDownFileMissions.Count - 1 downto 0 do
  5143. begin
  5144. AFileMission := UpDownFileMissions[iLoop];
  5145. if AFileMission.Category = 3 then
  5146. begin
  5147. AFinded := True;
  5148. Break;
  5149. end;
  5150. end;
  5151. if MessageBox(Handle, '有文件正在上传,确定要关闭吗?',
  5152. '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  5153. begin
  5154. Exit;
  5155. end; }
  5156. for iLoop := UpDownFileMissions.Count - 1 downto 0 do
  5157. begin
  5158. AFileMission := UpDownFileMissions[iLoop];
  5159. if AFileMission.Category = 3 then
  5160. begin
  5161. try
  5162. try
  5163. AFileMission.Stop;
  5164. finally
  5165. FreeAndNil(AFileMission);
  5166. end;
  5167. except
  5168. end;
  5169. end;
  5170. end;
  5171. end;
  5172. LockWindowUpdate(GetDesktopWindow);
  5173. try
  5174. PnlTeamCallBoard.Visible := True;
  5175. pnlTeamMembers.Visible := True;
  5176. rndTeamMembers.Visible := True;
  5177. pnlUserInformation.Width := 200;
  5178. pnlTeamWebDisk.Visible := False;
  5179. WindowState := wsNormal;
  5180. Width := 580;
  5181. finally
  5182. LockWindowUpdate(0);
  5183. end;
  5184. end;
  5185. procedure TTalkingForm.SendOfflineFile(AFileName: string);
  5186. var
  5187. //FRealICQUser: TRealICQUser;
  5188. AFileStream: TFileStream;
  5189. ALoginName: string;
  5190. RealICQUser: TRealICQUser;
  5191. ItemIndex: Integer;
  5192. RealICQContacterListItem: TRealICQContacterListItem;
  5193. AError: string;
  5194. begin
  5195. try
  5196. if (TLimitCondition.GreaterThanOfflineFileMaxSize(AFileName, AError, FRealICQClient)) then
  5197. raise Exception.Create(AError);
  5198. if FCategory = tcNormal then
  5199. begin
  5200. if not (MessageBox(Handle, PChar('确定要发送“' + AFileName + '”吗? '), '提示', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = IDYES) then
  5201. Exit;
  5202. TFileTransmitAdapter.Send(Self, tdSender, AFileName, 0, FReceiver, '', Now, FRealICQClient);
  5203. {$region '更新“最近联系人列表”中的数据'}
  5204. ALoginName := FReceiver;
  5205. RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
  5206. if RealICQUser <> nil then
  5207. begin
  5208. ItemIndex := MainForm.ListViewLatests.Items.IndexOf(ALoginName);
  5209. if ItemIndex = -1 then
  5210. ItemIndex := MainForm.ListViewLatests.Items.Add(ALoginName);
  5211. RealICQContacterListItem := MainForm.ListViewLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5212. MainForm.BindUserDataToItem(RealICQContacterListItem, RealICQUser);
  5213. RealICQContacterListItem.MoveToTop;
  5214. end;
  5215. {$endregion}
  5216. end
  5217. else
  5218. begin
  5219. TFileTransmitAdapter.SendToTeam(Self, tdSender, AFileName, 1, FTeamID, '', Now, FRealICQClient);
  5220. end;
  5221. except
  5222. on E: Exception do
  5223. MessageBox(0, PChar(E.Message), '发送文件出错', MB_ICONINFORMATION);
  5224. end;
  5225. end;
  5226. //------------------------------------------------------------------------------
  5227. procedure TTalkingForm.spbUploadFileClick(Sender: TObject);
  5228. var
  5229. //FRealICQUser: TRealICQUser;
  5230. AFileStream: TFileStream;
  5231. ALoginName, AFileName: string;
  5232. RealICQUser: TRealICQUser;
  5233. ItemIndex: Integer;
  5234. RealICQContacterListItem: TRealICQContacterListItem;
  5235. begin
  5236. if not FRealICQClient.Connected or not FRealICQClient.Logined then
  5237. Exit;
  5238. OpenDialog.Title := '传输离线文件';
  5239. if OpenDialog.Execute then
  5240. begin
  5241. SendOfflineFile(OpenDialog.FileName);
  5242. end;
  5243. end;
  5244. //------------------------------------------------------------------------------
  5245. //procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
  5246. //begin
  5247. // if FCategory = tcTeam then
  5248. // begin
  5249. // MainForm.actMsgManagerExecute(nil);
  5250. // Application.ProcessMessages;
  5251. // MessagesManagerForm.ShowTeamsMessages(FTeamID);
  5252. // end
  5253. // else
  5254. // if FCategory = tcNormal then
  5255. // begin
  5256. // if FReceiver <> '' then
  5257. // begin
  5258. // MainForm.actMsgManagerExecute(nil);
  5259. // Application.ProcessMessages;
  5260. // MessagesManagerForm.ShowUsersMessages(FReceiver);
  5261. // end;
  5262. // end;
  5263. //end;
  5264. //------------------------------------------------------------------------------
  5265. procedure TTalkingForm.spbHistroyMessageClick(Sender: TObject);
  5266. var
  5267. Point1, Point2: TPoint;
  5268. begin
  5269. point1 := Point(0, 0);
  5270. point2 := Point(0, 0);
  5271. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  5272. GetCursorPos(point2);
  5273. if (point2.X - point1.X) <= 17 then
  5274. begin
  5275. if FCategory = tcTeam then
  5276. begin
  5277. MainForm.actMsgManagerExecute(nil);
  5278. Application.ProcessMessages;
  5279. MessagesManagerForm.ShowTeamsMessages(FTeamID);
  5280. end
  5281. else if FCategory = tcNormal then
  5282. begin
  5283. if FReceiver <> '' then
  5284. begin
  5285. MainForm.actMsgManagerExecute(nil);
  5286. Application.ProcessMessages;
  5287. MessagesManagerForm.ShowUsersMessages(FReceiver);
  5288. end
  5289. end
  5290. end
  5291. else
  5292. begin
  5293. Point1.X := 0;
  5294. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5295. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  5296. ppForMsg.Popup(Point1.X, Point1.Y);
  5297. end;
  5298. end;
  5299. procedure TTalkingForm.spbMicClick(Sender: TObject);
  5300. var
  5301. Point: TPoint;
  5302. begin
  5303. Point.X := 0;
  5304. Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
  5305. Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
  5306. miOpenMic.Visible := True;
  5307. miCloseMic.Visible := True;
  5308. miOpenMic.Enabled := not TAudioTransmitter.GetSendAudio;
  5309. miCloseMic.Enabled := TAudioTransmitter.GetSendAudio;
  5310. miOpenSpeak.Visible := False;
  5311. miCloseSpeak.Visible := False;
  5312. ppAudioSet.Popup(Point.X, Point.Y);
  5313. end;
  5314. procedure TTalkingForm.spbRemoteControlClick(Sender: TObject);
  5315. begin
  5316. if FRemoteControlMission <> nil then
  5317. begin
  5318. MessageBox(Handle, '请先结束已存在的远程协助任务! ', '提示', MB_ICONINFORMATION);
  5319. Exit;
  5320. end;
  5321. FRealICQClient.CreateRemoteControlTransmitter(Receiver);
  5322. end;
  5323. //------------------------------------------------------------------------------
  5324. procedure TTalkingForm.TeamUpFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: string);
  5325. var
  5326. Completed: Integer;
  5327. begin
  5328. if ulProgressMax = 0 then
  5329. Exit;
  5330. Completed := ulProgress * 100 div ulProgressMax;
  5331. spbUploadTeamFileProcess.Caption := IntToStr(Completed) + '%';
  5332. end;
  5333. procedure TTalkingForm.TimerForCheckPastedContentTimer(Sender: TObject);
  5334. begin
  5335. TimerForCheckPastedContent.Tag := TimerForCheckPastedContent.Tag + 1;
  5336. if TimerForCheckPastedContent.Tag >= 2 then
  5337. TimerForCheckPastedContent.Enabled := False;
  5338. CheckPastedContent(False);
  5339. end;
  5340. procedure TTalkingForm.TimerForGetUserInformationTimer(Sender: TObject);
  5341. var
  5342. FRealICQUser: TRealICQUser;
  5343. begin
  5344. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  5345. if not Assigned(FRealICQUser) then
  5346. Exit;
  5347. TimerForGetUserInformation.Enabled := False;
  5348. if FRealICQUser.DisplayName = '' then
  5349. TUsersService.GetUsersService.GetOrRequestUser(FRealICQUser.LoginName, FRealICQClient);
  5350. if not FRealICQUser.GettedOffliceAutoResponseSet then
  5351. FRealICQClient.GetOffliceAutoResponseSet(FRealICQUser.LoginName);
  5352. end;
  5353. //------------------------------------------------------------------------------
  5354. procedure TTalkingForm.tsMyHeadImageShow(Sender: TObject);
  5355. begin
  5356. if FMinWidthOfYourPanel < pnlUserInformation.Width then
  5357. pnlUserInformation.Width := FMinWidthOfYourPanel;
  5358. if (FMinWidthOfYourPanel <= 114) then
  5359. begin
  5360. pnlUserInformation.Width := 114;
  5361. end;
  5362. FMinWidthOfMyPanel := 114;
  5363. lblMyInfo.Caption := '我的头像';
  5364. pnlMyInfo.Constraints.MinHeight := 146;
  5365. pnlMyInfo.Height := 146;
  5366. rndMyInfo.Top := 0;
  5367. rndMyInfo.Height := 140;
  5368. rndMy.Height := 100;
  5369. end;
  5370. //------------------------------------------------------------------------------
  5371. procedure TTalkingForm.tsMyCardShow(Sender: TObject);
  5372. begin
  5373. if (FMinWidthOfYourPanel <= 200) then
  5374. begin
  5375. pnlUserInformation.Width := 200;
  5376. end;
  5377. FMinWidthOfMyPanel := 200;
  5378. lblMyInfo.Caption := '我的名片';
  5379. pnlMyInfo.Constraints.MinHeight := 174;
  5380. pnlMyInfo.Height := 174;
  5381. rndMyInfo.Top := 0;
  5382. rndMyInfo.Height := 168;
  5383. rndMy.Height := 128;
  5384. end;
  5385. //------------------------------------------------------------------------------
  5386. procedure TTalkingForm.tsMyVideoShow(Sender: TObject);
  5387. begin
  5388. lblMyInfo.Caption := '我的视频';
  5389. if miMyVideoBigSize.Checked then
  5390. begin
  5391. if (FMinWidthOfYourPanel <= 180 + 160) then
  5392. begin
  5393. pnlUserInformation.Width := 180 + 160;
  5394. end;
  5395. FMinWidthOfMyPanel := 180 + 160;
  5396. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 244;
  5397. pnlMyInfo.Height := 40 + 6 + 244;
  5398. rndMyInfo.Top := 0;
  5399. rndMyInfo.Height := 284;
  5400. rndMy.Height := 244;
  5401. imgMyVideo.Width := 320;
  5402. imgMyVideo.Height := 240;
  5403. end
  5404. else if miMyVideoMiddleSize.Checked then
  5405. begin
  5406. if (FMinWidthOfYourPanel <= 180 + 80) then
  5407. begin
  5408. pnlUserInformation.Width := 180 + 80;
  5409. end;
  5410. FMinWidthOfMyPanel := 180 + 80;
  5411. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 184;
  5412. pnlMyInfo.Height := 40 + 6 + 184;
  5413. rndMyInfo.Top := 0;
  5414. rndMyInfo.Height := 224;
  5415. rndMy.Height := 184;
  5416. imgMyVideo.Width := 240;
  5417. imgMyVideo.Height := 180;
  5418. end
  5419. else
  5420. begin
  5421. if (FMinWidthOfYourPanel <= 180) then
  5422. begin
  5423. pnlUserInformation.Width := 180;
  5424. end;
  5425. FMinWidthOfMyPanel := 180;
  5426. pnlMyInfo.Constraints.MinHeight := 40 + 6 + 124;
  5427. pnlMyInfo.Height := 40 + 6 + 124;
  5428. rndMyInfo.Top := 0;
  5429. rndMyInfo.Height := 164;
  5430. rndMy.Height := 124;
  5431. imgMyVideo.Width := 160;
  5432. imgMyVideo.Height := 120;
  5433. end;
  5434. end;
  5435. //------------------------------------------------------------------------------
  5436. procedure TTalkingForm.tsYourHeadImageShow(Sender: TObject);
  5437. begin
  5438. if FMinWidthOfMyPanel < pnlUserInformation.Width then
  5439. pnlUserInformation.Width := FMinWidthOfMyPanel;
  5440. if (FMinWidthOfMyPanel <= 114) then
  5441. begin
  5442. pnlUserInformation.Width := 114;
  5443. end;
  5444. FMinWidthOfYourPanel := 114;
  5445. lblYourInfo.Caption := '他的头像';
  5446. pnlYourInfo.Constraints.MinHeight := 146;
  5447. pnlYourInfo.Height := 146;
  5448. rndYourInfo.Top := 0;
  5449. rndYourInfo.Height := 140;
  5450. rndYour.Height := 100;
  5451. end;
  5452. //------------------------------------------------------------------------------
  5453. procedure TTalkingForm.tsYourCardShow(Sender: TObject);
  5454. begin
  5455. if (FMinWidthOfMyPanel <= 200) then
  5456. begin
  5457. pnlUserInformation.Width := 200;
  5458. end;
  5459. FMinWidthOfYourPanel := 200;
  5460. lblYourInfo.Caption := '他的名片';
  5461. pnlYourInfo.Constraints.MinHeight := 174;
  5462. pnlYourInfo.Height := 174;
  5463. rndYourInfo.Top := 0;
  5464. rndYourInfo.Height := 168;
  5465. rndYour.Height := 128;
  5466. end;
  5467. procedure TTalkingForm.tsYourVideoShow(Sender: TObject);
  5468. begin
  5469. lblMyInfo.Caption := '他的视频';
  5470. if miYourVideoBigSize.Checked then
  5471. begin
  5472. if (FMinWidthOfMyPanel <= 180 + 160) then
  5473. begin
  5474. pnlUserInformation.Width := 180 + 160;
  5475. end;
  5476. FMinWidthOfYourPanel := 180 + 160;
  5477. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 244;
  5478. pnlYourInfo.Height := 40 + 6 + 244;
  5479. rndYourInfo.Top := 0;
  5480. rndYourInfo.Height := 284;
  5481. rndYour.Height := 244;
  5482. imgYourVideo.Width := 320;
  5483. imgYourVideo.Height := 240;
  5484. end
  5485. else if miYourVideoMiddleSize.Checked then
  5486. begin
  5487. if (FMinWidthOfMyPanel <= 180 + 80) then
  5488. begin
  5489. pnlUserInformation.Width := 180 + 80;
  5490. end;
  5491. FMinWidthOfYourPanel := 180 + 80;
  5492. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 184;
  5493. pnlYourInfo.Height := 40 + 6 + 184;
  5494. rndYourInfo.Top := 0;
  5495. rndYourInfo.Height := 224;
  5496. rndYour.Height := 184;
  5497. imgYourVideo.Width := 240;
  5498. imgYourVideo.Height := 180;
  5499. end
  5500. else
  5501. begin
  5502. if (FMinWidthOfMyPanel <= 180) then
  5503. begin
  5504. pnlUserInformation.Width := 180;
  5505. end;
  5506. FMinWidthOfYourPanel := 180;
  5507. pnlYourInfo.Constraints.MinHeight := 40 + 6 + 124;
  5508. pnlYourInfo.Height := 40 + 6 + 124;
  5509. rndYourInfo.Top := 0;
  5510. rndYourInfo.Height := 164;
  5511. rndYour.Height := 124;
  5512. imgYourVideo.Width := 160;
  5513. imgYourVideo.Height := 120;
  5514. end;
  5515. end;
  5516. //------------------------------------------------------------------------------
  5517. procedure TTalkingForm.miShowYourCardClick(Sender: TObject);
  5518. begin
  5519. Application.ProcessMessages;
  5520. Sleep(200);
  5521. (Sender as TMenuItem).Checked := True;
  5522. pgcYourInfo.ActivePageIndex := 1;
  5523. Application.ProcessMessages;
  5524. end;
  5525. //------------------------------------------------------------------------------
  5526. procedure TTalkingForm.miShowYourHeadImageClick(Sender: TObject);
  5527. begin
  5528. Application.ProcessMessages;
  5529. Sleep(200);
  5530. (Sender as TMenuItem).Checked := True;
  5531. pgcYourInfo.ActivePageIndex := 0;
  5532. Application.ProcessMessages;
  5533. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5534. end;
  5535. procedure TTalkingForm.miShowYourVideoClick(Sender: TObject);
  5536. begin
  5537. Application.ProcessMessages;
  5538. Sleep(200);
  5539. (Sender as TMenuItem).Checked := True;
  5540. pgcYourInfo.ActivePageIndex := 2;
  5541. Application.ProcessMessages;
  5542. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5543. end;
  5544. //------------------------------------------------------------------------------
  5545. procedure TTalkingForm.miStopAudioTransmiteClick(Sender: TObject);
  5546. begin
  5547. if FAudioMission <> nil then
  5548. FAudioMission.Stop;
  5549. end;
  5550. procedure TTalkingForm.miTeamAddFriendClick(Sender: TObject);
  5551. begin
  5552. miAddFriendClick(nil);
  5553. end;
  5554. procedure TTalkingForm.miTeamSeeUserInfoClick(Sender: TObject);
  5555. begin
  5556. SeeUserInformation(ALoginName);
  5557. end;
  5558. procedure TTalkingForm.miTeamSendMessageClick(Sender: TObject);
  5559. begin
  5560. if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
  5561. begin
  5562. //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
  5563. Exit;
  5564. end;
  5565. OpenTalkingForm(ALoginName);
  5566. end;
  5567. procedure TTalkingForm.miTeamSMSClick(Sender: TObject);
  5568. begin
  5569. OpenSMSForm(ALoginName);
  5570. end;
  5571. procedure TTalkingForm.miVideoSetClick(Sender: TObject);
  5572. var
  5573. SysDev: TSysDevEnum;
  5574. begin
  5575. SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  5576. try
  5577. try
  5578. VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(FRealICQClient.VideoDeviceID);
  5579. except
  5580. VideoSourceFilter.BaseFilter.Moniker := SysDev.GetMoniker(0);
  5581. end;
  5582. CaptureGraph.Active := True;
  5583. ShowFilterPropertyPage(Self.Handle, VideoSourceFilter as IBaseFilter);
  5584. finally
  5585. FreeAndNil(SysDev);
  5586. end;
  5587. end;
  5588. //------------------------------------------------------------------------------
  5589. procedure TTalkingForm.miYourVideoSmallSizeClick(Sender: TObject);
  5590. begin
  5591. if pgcYourInfo.ActivePage = tsYourVideo then
  5592. begin
  5593. Application.ProcessMessages;
  5594. Sleep(200);
  5595. tsYourVideoShow(tsYourVideo);
  5596. Application.ProcessMessages;
  5597. end;
  5598. end;
  5599. //------------------------------------------------------------------------------
  5600. procedure TTalkingForm.miMyVideoSmallSizeClick(Sender: TObject);
  5601. begin
  5602. if pgcMyInfo.ActivePage = tsMyVideo then
  5603. begin
  5604. Application.ProcessMessages;
  5605. Sleep(200);
  5606. tsMyVideoShow(tsMyVideo);
  5607. Application.ProcessMessages;
  5608. end;
  5609. end;
  5610. //------------------------------------------------------------------------------
  5611. procedure TTalkingForm.InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
  5612. const
  5613. CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
  5614. var
  5615. CmdTarget: IOleCommandTarget;
  5616. PtrGUID: PGUID;
  5617. begin
  5618. New(PtrGUID);
  5619. if InvokeIE then
  5620. PtrGUID^ := CLSID_WebBrowser
  5621. else
  5622. PtrGuid := PGUID(nil);
  5623. if WebBrowser.Document <> nil then
  5624. try
  5625. WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget);
  5626. if CmdTarget <> nil then
  5627. try
  5628. CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
  5629. finally
  5630. CmdTarget._Release;
  5631. end;
  5632. except
  5633. end;
  5634. Dispose(PtrGUID);
  5635. end;
  5636. //------------------------------------------------------------------------------
  5637. procedure TTalkingForm.miAddFriendClick(Sender: TObject);
  5638. var
  5639. iIndex: Integer;
  5640. ListItem: TRealICQContacterListItem;
  5641. ADisplayName: string;
  5642. begin
  5643. ADisplayName := '';
  5644. if AnsiSameText(FRealICQClient.LoginName, ALoginName) then
  5645. begin
  5646. //MessageBox(Handle, '不能添加自己为好友! ', '提示', MB_ICONINFORMATION);
  5647. Exit;
  5648. end;
  5649. iIndex := FLVTeamMembers.Items.IndexOf(ALoginName);
  5650. if iIndex > -1 then
  5651. begin
  5652. ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
  5653. ADisplayName := ListItem.DisplayName;
  5654. end;
  5655. ShowAddFriendWindow(Self, ALoginName, ADisplayName);
  5656. end;
  5657. //------------------------------------------------------------------------------
  5658. //添加聊天内容到工单系统
  5659. //------------------------------------------------------------------------------
  5660. procedure TTalkingForm.miAddWorkOrderClick(Sender: TObject);
  5661. begin
  5662. miCopyFromIEClick(nil);
  5663. MainForm.WebBrowserForPostWorkOrder.Navigate('about:blank');
  5664. // TThreadPost.Create(FRealICQClient.WebAppBaseURL+'/PostWordOrder.aspx',ClipBoard.AsText);
  5665. end;
  5666. //------------------------------------------------------------------------------
  5667. procedure TTalkingForm.miCloseMicClick(Sender: TObject);
  5668. begin
  5669. ImgLstForAudio.GetIcon(1, spbMic.Icon);
  5670. TAudioTransmitter.SetSendAudio(False);
  5671. MicrophoneVolume.PeakValue := 0;
  5672. end;
  5673. //------------------------------------------------------------------------------
  5674. procedure TTalkingForm.miOpenMicClick(Sender: TObject);
  5675. begin
  5676. ImgLstForAudio.GetIcon(0, spbMic.Icon);
  5677. TAudioTransmitter.SetSendAudio(True);
  5678. end;
  5679. //------------------------------------------------------------------------------
  5680. procedure TTalkingForm.miCloseSpeakClick(Sender: TObject);
  5681. begin
  5682. ImgLstForAudio.GetIcon(3, spbSpk.Icon);
  5683. TAudioTransmitter.SetRecvAudio(False);
  5684. MasterVolume.PeakValue := 0;
  5685. end;
  5686. //------------------------------------------------------------------------------
  5687. procedure TTalkingForm.miOpenSpeakClick(Sender: TObject);
  5688. begin
  5689. ImgLstForAudio.GetIcon(2, spbSpk.Icon);
  5690. TAudioTransmitter.SetRecvAudio(True);
  5691. end;
  5692. procedure TTalkingForm.miPasteImgClick(Sender: TObject);
  5693. begin
  5694. end;
  5695. //------------------------------------------------------------------------------
  5696. procedure TTalkingForm.miCopyFromIEClick(Sender: TObject);
  5697. var
  5698. vaIn, vaOut: Olevariant;
  5699. begin
  5700. if actSaveImgAs.Enabled then
  5701. begin
  5702. CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + FFaceMenuAtFileName + '">'));
  5703. end
  5704. else
  5705. begin
  5706. InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  5707. end;
  5708. end;
  5709. //----------复制图片到剪贴版------------------------------
  5710. procedure TTalkingForm.miCopyImageClick(Sender: TObject);
  5711. var
  5712. Face: TFace;
  5713. begin
  5714. if FRightMouseClickedFace.FaceIndex >= BaseTempFaceIndex then
  5715. Face := MainForm.TempFaceList.Objects[FRightMouseClickedFace.FaceIndex - BaseTempFaceIndex] as TFace
  5716. else
  5717. Face := MainForm.FaceList.Objects[FRightMouseClickedFace.FaceIndex] as TFace;
  5718. CopyHTMLToClipBoard('', UTF8Encode('<img src="file:///' + Face.FileName + '">'));
  5719. //CopyFilesToClipboard(Face.FileName);
  5720. end;
  5721. //------------------------------------------------------------------------------
  5722. procedure TTalkingForm.miSelAllFromIEClick(Sender: TObject);
  5723. var
  5724. vaIn, vaOut: Olevariant;
  5725. begin
  5726. InvokeCmd(FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  5727. end;
  5728. procedure TTalkingForm.miSendMessageClick(Sender: TObject);
  5729. begin
  5730. if AnsiSameText(ALoginName, FRealICQClient.LoginName) then
  5731. begin
  5732. //MessageBox(Handle, '不可以和自己对话! ', '提示', MB_ICONINFORMATION);
  5733. Exit;
  5734. end;
  5735. OpenTalkingForm(ALoginName);
  5736. end;
  5737. procedure TTalkingForm.miSendSmsClick(Sender: TObject);
  5738. begin
  5739. OpenSmsForm(ALoginName);
  5740. end;
  5741. //------------------------------------------------------------------------------
  5742. procedure TTalkingForm.miSaveMyVideoImageAsClick(Sender: TObject);
  5743. begin
  5744. SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
  5745. if SaveDialog.Execute then
  5746. begin
  5747. ImgMyVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
  5748. end;
  5749. end;
  5750. procedure TTalkingForm.miSaveToWebClick(Sender: TObject);
  5751. begin
  5752. miCopyFromIEClick(nil);
  5753. Application.ProcessMessages;
  5754. Sleep(100);
  5755. Application.ProcessMessages;
  5756. MainForm.RealICQClient.CallServerDBProcedure('YJ_AddTempRemark', ClipBoard.AsText);
  5757. end;
  5758. //------------------------------------------------------------------------------
  5759. procedure TTalkingForm.miSaveYourVideoImageAsClick(Sender: TObject);
  5760. begin
  5761. SaveDialog.FileName := '照片_' + FormatDateTime('yyyy-mm-dd', Now()) + '.BMP';
  5762. if SaveDialog.Execute then
  5763. begin
  5764. ImgYourVideo.Picture.Bitmap.SaveToFile(SaveDialog.FileName);
  5765. end;
  5766. end;
  5767. //------------------------------------------------------------------------------
  5768. procedure TTalkingForm.miSeeTeamDetailInformationClick(Sender: TObject);
  5769. var
  5770. iIndex: Integer;
  5771. ATeam: TRealICQTeam;
  5772. begin
  5773. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  5774. if ATeam <> nil then
  5775. OpenTeamOptionsForm(ATeam);
  5776. end;
  5777. //------------------------------------------------------------------------------
  5778. procedure TTalkingForm.miSeeUserInformationClick(Sender: TObject);
  5779. begin
  5780. SeeUserInformation(ALoginName);
  5781. end;
  5782. //------------------------------------------------------------------------------
  5783. procedure TTalkingForm.miSeeYourDetailInformationClick(Sender: TObject);
  5784. begin
  5785. SeeUserInformation(Receiver);
  5786. end;
  5787. //------------------------------------------------------------------------------
  5788. procedure TTalkingForm.miShowMyCardClick(Sender: TObject);
  5789. begin
  5790. Application.ProcessMessages;
  5791. Sleep(200);
  5792. (Sender as TMenuItem).Checked := True;
  5793. pgcMyInfo.ActivePageIndex := 1;
  5794. Application.ProcessMessages;
  5795. end;
  5796. //------------------------------------------------------------------------------
  5797. procedure TTalkingForm.miShowMyHeadImageClick(Sender: TObject);
  5798. begin
  5799. Application.ProcessMessages;
  5800. Sleep(200);
  5801. (Sender as TMenuItem).Checked := True;
  5802. pgcMyInfo.ActivePageIndex := 0;
  5803. Application.ProcessMessages;
  5804. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5805. end;
  5806. procedure TTalkingForm.miShowMyVideoClick(Sender: TObject);
  5807. begin
  5808. Application.ProcessMessages;
  5809. Sleep(200);
  5810. (Sender as TMenuItem).Checked := True;
  5811. pgcMyInfo.ActivePageIndex := 2;
  5812. Application.ProcessMessages;
  5813. FOldWidthOfUserInfo := pnlUserInformation.Width;
  5814. end;
  5815. //------------------------------------------------------------------------------
  5816. procedure TTalkingForm.miShowVideoFormClick(Sender: TObject);
  5817. begin
  5818. miShowVideoForm.Checked := not miShowVideoForm.Checked;
  5819. if miShowVideoForm.Checked then
  5820. begin
  5821. miShowYourHeadImageClick(miShowYourHeadImage);
  5822. if VideoForm = nil then
  5823. VideoForm := TVideoForm.Create(Self);
  5824. VideoForm.TalkingForm := Self;
  5825. VideoForm.Show;
  5826. miShowYourVideo.Enabled := False;
  5827. end
  5828. else
  5829. begin
  5830. miShowYourVideoClick(miShowYourVideo);
  5831. FreeAndNil(VideoForm);
  5832. miShowYourVideo.Enabled := True;
  5833. end;
  5834. end;
  5835. //------------------------------------------------------------------------------
  5836. procedure TTalkingForm.UpdateMyInfo;
  5837. var
  5838. GIFImage: TGIFImage;
  5839. begin
  5840. if FRealICQClient.Me = nil then
  5841. Exit;
  5842. Application.ProcessMessages;
  5843. if FileExists(FRealICQClient.Me.HeadImageFile) then
  5844. begin
  5845. try
  5846. if (FRealICQClient.Me.HeadImageFileType = htGIF) then
  5847. begin
  5848. GIFImage := TGIFImage.Create;
  5849. GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
  5850. try
  5851. GIFImage.LoadFromFile(FRealICQClient.Me.HeadImageFile);
  5852. if GIFImage.Animate then
  5853. ImgHeadForMyInfo.Picture.Assign(GIFImage)
  5854. else
  5855. ImgHeadForMyInfo.Picture.Bitmap.Assign(GIFImage);
  5856. finally
  5857. GIFImage.Free;
  5858. end;
  5859. end
  5860. else
  5861. ImgHeadForMyInfo.Picture.LoadFromFile(FRealICQClient.Me.HeadImageFile);
  5862. except
  5863. ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  5864. end;
  5865. end
  5866. else
  5867. begin
  5868. ImgHeadForMyInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  5869. end;
  5870. cardMine.IsSeeRight := True;
  5871. cardMine.RealICQUser := FRealICQClient.Me;
  5872. // FRealICQClient.GetUserExInformation(cardMine.RealICQUser.LoginName);
  5873. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  5874. end;
  5875. procedure TTalkingForm.UpdateAliasClick(Sender: TObject);
  5876. var
  5877. AliasName: string;
  5878. begin
  5879. AliasName := ShowMyInputBox('更改别名', '请输入您喜欢的别名', '', 20);
  5880. if AliasName <> '' then
  5881. TTeamsAdapter.SetAlias(FTeamID, ALoginName, AliasName);
  5882. end;
  5883. //------------------------------------------------------------------------------
  5884. procedure TTalkingForm.UpdateTeamMember(ARealICQUser: TRealICQUser);
  5885. var
  5886. ItemIndex: Integer;
  5887. AListItem: TRealICQContacterListItem;
  5888. AAlias: string;
  5889. begin
  5890. ItemIndex := FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName);
  5891. if ItemIndex = -1 then
  5892. Exit;
  5893. AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5894. // MainForm.BindUserDataToItem(AListItem, ARealICQUser);
  5895. //TODO 解决第一次都是LoginName的问题
  5896. AAlias := TTeamsAdapter.GetAlias(FTeamID, AListItem.LoginName);
  5897. if AAlias = '' then
  5898. AAlias := ARealICQUser.DisplayName;
  5899. MainForm.BindUserDataToItemForGroup(AListItem, ARealICQUser, AAlias);
  5900. lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
  5901. //FLVTeamMembers.Invalidate;
  5902. end;
  5903. //------------------------------------------------------------------------------
  5904. procedure TTalkingForm.UpdateTeamMembers;
  5905. var
  5906. iIndex, ItemIndex, iLoop: Integer;
  5907. LoginName: string;
  5908. MemberList: TStringList;
  5909. // ATeam: TRealICQTeam;
  5910. ATeam: TRealICQTeam;
  5911. RealICQUser: TRealICQUser;
  5912. AListItem: TRealICQContacterListItem;
  5913. TeamName, AGroupAlias: string;
  5914. ActionGetMembers: TAsynGetTeamMembers;
  5915. begin
  5916. { iIndex := FRealICQClient.Teams.IndexOf(FTeamID);
  5917. if iIndex = -1 then Exit;
  5918. ATeam := FRealICQClient.Teams.Objects[iIndex] as TRealICQTeam; }
  5919. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  5920. MemberList := SplitString(ATeam.TeamMembers, Chr(10));
  5921. ActionGetMembers := TAsynGetTeamMembers.Create(Self, MemberList);
  5922. { try
  5923. for iLoop := 0 to MemberList.Count - 1 do
  5924. begin
  5925. LoginName := Trim(MemberList[iLoop]);
  5926. if Length(LoginName) = 0 then continue;
  5927. AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
  5928. RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
  5929. if not Assigned(RealICQUser) then continue;
  5930. //TODO: 获取手机信息和用户状态
  5931. // if Trim(RealICQUser.DisplayName)='' then
  5932. // MainForm.RealICQClient.GetUserInformation(LoginName,True)
  5933. // else
  5934. // MainForm.RealICQClient.GetUserLoginState(LoginName);
  5935. // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
  5936. // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
  5937. ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  5938. if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
  5939. AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5940. if Trim(AGroupAlias)='' then
  5941. MainForm.BindUserDataToItem(AListItem, RealICQUser)
  5942. else
  5943. MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
  5944. end;
  5945. ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
  5946. for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
  5947. begin
  5948. LoginName := FLVTeamMembers.Items[iLoop];
  5949. if MemberList.IndexOf(LoginName) = -1 then
  5950. begin
  5951. FLVTeamMembers.Items.Delete(iLoop);
  5952. end;
  5953. end;
  5954. finally
  5955. MemberList.Free;
  5956. end; }
  5957. // try
  5958. // for iLoop := 0 to MemberList.Count - 1 do
  5959. // begin
  5960. // LoginName := Trim(MemberList[iLoop]);
  5961. // if Length(LoginName) = 0 then continue;
  5962. // AGroupAlias := TTeamsAdapter.GetAlias(FTeamID, Trim(LoginName));
  5963. //
  5964. // RealICQUser := FRealICQClient.GetRealICQUserObject(LoginName);
  5965. // if not Assigned(RealICQUser) then continue;
  5966. // //TODO: 获取手机信息和用户状态
  5967. // if Trim(RealICQUser.DisplayName)='' then
  5968. // MainForm.RealICQClient.GetUserInformation(LoginName,True)
  5969. // else
  5970. // MainForm.RealICQClient.GetUserLoginState(LoginName);
  5971. // if (Trim(RealICQUser.Branch)='') or (Trim(RealICQUser.Tel)='') then
  5972. // MainForm.RealICQClient.GetUserExInformation(LoginName,False);
  5973. //
  5974. // ItemIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  5975. // if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(LoginName);
  5976. // AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem;
  5977. // if Trim(AGroupAlias)='' then
  5978. // MainForm.BindUserDataToItem(AListItem, RealICQUser)
  5979. // else
  5980. // MainForm.BindUserDataToItemForGroup(AListItem, RealICQUser, AGroupAlias);
  5981. // end;
  5982. // //ActionGetMembers := TAsynGetTeamMembers.Create(Self,MemberList);
  5983. // for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do
  5984. // begin
  5985. // LoginName := FLVTeamMembers.Items[iLoop];
  5986. // if MemberList.IndexOf(LoginName) = -1 then
  5987. // begin
  5988. // FLVTeamMembers.Items.Delete(iLoop);
  5989. // end;
  5990. // end;
  5991. // finally
  5992. // MemberList.Free;
  5993. // end;
  5994. if ATeam.TeamCaption = '' then
  5995. TeamName := ATeam.TeamID
  5996. else
  5997. TeamName := ATeam.TeamCaption;
  5998. if ATeam.IsTempTeam then
  5999. TeamName := '多人会话'
  6000. else
  6001. TeamName := TeamName + ' - 群组会话';
  6002. Caption := TeamName;
  6003. lblTeamMemberCount.Caption := Format('成员(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]);
  6004. end;
  6005. //------------------------------------------------------------------------------
  6006. procedure TTalkingForm.SetTeamID(Value: string);
  6007. var
  6008. iIndex: Integer;
  6009. ATeam: TRealICQTeam;
  6010. begin
  6011. //SpbEncryMessage.Visible := False;
  6012. //chkEncryMessage.Visible := False;
  6013. spbEncryMsg.Visible := False;
  6014. spbNormalMsg.Visible := False;
  6015. //spbUploadFile.Caption:='群发文件';
  6016. spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
  6017. //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
  6018. miSeeTeamDetailInformation.Visible := True;
  6019. miSeeYourDetailInformation.Visible := False;
  6020. miShowYourHeadImage.Visible := False;
  6021. miShowYourCard.Visible := False;
  6022. actSendFile.Visible := False;
  6023. actAudio.Visible := False;
  6024. actVideo.Visible := False;
  6025. actSeeTeamOptions.Visible := True;
  6026. actQuitTeam.Visible := False;
  6027. actDisbandTeam.Visible := False;
  6028. spbSendFile.Visible := False;
  6029. spbAudio.Visible := False;
  6030. spbVideo.Visible := False;
  6031. spbRemoteControl.Visible := False;
  6032. spbSendFolder.Visible := False;
  6033. spbUserInfo.Visible := False;
  6034. spbPostSMS.Visible := False;
  6035. spbSeeTeamOptions.Visible := True;
  6036. spbAddUser.Visible := True;
  6037. spbQuitTeam.Visible := False;
  6038. spbDisbandTeam.Visible := False;
  6039. spbSendSMS.Visible := True;
  6040. pnlYourInfo.Visible := False;
  6041. // pnlMyInfo.Visible := False;
  6042. pnlTeamCallBoard.Visible := True;
  6043. pnlTeamMembers.Visible := True;
  6044. spbShakeWindow.Visible := False;
  6045. spbCopyScreen.left := spbShakeWindow.left;
  6046. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6047. btnQR.Visible := False;
  6048. spbSet.left := spbQuitTeam.left + spbQuitTeam.Width + 3;
  6049. spbAbout.left := spbSet.left + spbSet.Width;
  6050. if PnlTeamWebDisk.Visible then
  6051. begin
  6052. pnlTeamCallBoard.Visible := False;
  6053. pnlTeamMembers.Visible := False;
  6054. end
  6055. else
  6056. PnlTeamWebDisk.Visible := False;
  6057. //spbUploadFile.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
  6058. spbUploadFile.Visible := False;
  6059. //spbTeamNetWorkDisk.Left := spbDisbandTeam.Left + spbDisbandTeam.Width + 2;
  6060. spbTeamNetWorkDisk.Caption := '群文件';
  6061. FTeamID := Value;
  6062. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  6063. if ATeam = nil then
  6064. begin
  6065. Caption := FTeamID + ' - 群组对话';
  6066. Log(Format('找不到群ID为%s的群', [FTeamID]), 'SetTeamID');
  6067. Exit;
  6068. end;
  6069. spbTeamNetWorkDisk.Visible := not ATeam.IsTempTeam;
  6070. if FLVTeamMembers.Tag = 0 then
  6071. begin
  6072. {$region '生成显示群组成员列表的ListView'}
  6073. if (FMinWidthOfMyPanel <= 200) then
  6074. pnlTeamMembers.Width := 200;
  6075. FMinWidthOfYourPanel := 200;
  6076. MainForm.UpdateContacterListView(FLVTeamMembers);
  6077. FLVTeamMembers.OnItemOnline := nil;
  6078. FLVTeamMembers.OnItemOffline := nil;
  6079. FLVTeamMembers.PopupMenu := ppUserItemRightMenu;
  6080. FLVTeamMembers.Style := lsSmallHeadImage;
  6081. FLVTeamMembers.CaptionStyle := csDisplayName;
  6082. FLVTeamMembers.OnItemMouseEnter := nil;
  6083. FLVTeamMembers.OnItemMouseLeave := nil;
  6084. FLVTeamMembers.OnItemIconButtonClick := nil;
  6085. //FLVTeamMembers.OnItemIconButtonDblClick := nil;
  6086. FLVTeamMembers.ShowHeadImageButton := True;
  6087. FLVTeamMembers.ChangeUIColor(FWindowColor);
  6088. FLVTeamMembers.Tag := 1;
  6089. {$endregion}
  6090. end;
  6091. UpdateTeamMembers;
  6092. actDisbandTeam.Visible := AnsiSameText(ATeam.TeamCreater, FRealICQClient.LoginName);
  6093. actQuitTeam.Visible := not actDisbandTeam.Visible;
  6094. spbQuitTeam.Visible := actQuitTeam.Visible;
  6095. spbDisbandTeam.Visible := actDisbandTeam.Visible;
  6096. mmTeamCallBoard.Text := Trim(ATeam.TeamCallBoard);
  6097. //spbSendImage.Left := spbShakeWindow.Left;
  6098. //spbCopyScreen.Left := spbSendImage.Left + spbSendImage.Width + 3;
  6099. //spbCopyScreen2.Left := spbCopyScreen.Left + spbCopyScreen.Width + 3;
  6100. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6101. PostMessage(Handle, WM_SIZE, 0, 0);
  6102. end;
  6103. procedure TTalkingForm.SetReceiver(Value: string);
  6104. var
  6105. UserName: WideString;
  6106. FRealICQUser: TRealICQUser;
  6107. GIFImage: TGIFImage;
  6108. ServerId: string;
  6109. iPos: Integer;
  6110. begin
  6111. //SpbEncryMessage.Visible := True;
  6112. //chkEncryMessage.Visible := True;
  6113. spbEncryMsg.Visible := False;
  6114. spbNormalMsg.Visible := True;
  6115. //spbUploadFile.Caption:='离线文件';
  6116. // MainForm.RealICQClient.GetUserExInformation(Value);
  6117. spbAddUser.Enabled := FRealICQClient = MainForm.RealICQClient;
  6118. //pnlMenu.Visible := FRealICQClient = MainForm.RealICQClient;
  6119. FReceiver := Value;
  6120. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Receiver);
  6121. if not Assigned(FRealICQUser) then
  6122. Exit;
  6123. if FRealICQUser.LoginAtWeb then
  6124. begin
  6125. miSeeTeamDetailInformation.Visible := False;
  6126. miSeeYourDetailInformation.Visible := True;
  6127. miShowYourHeadImage.Visible := True;
  6128. miShowYourCard.Visible := True;
  6129. actSendFile.Enabled := False;
  6130. actAudio.Enabled := False;
  6131. actVideo.Enabled := False;
  6132. actSeeTeamOptions.Visible := False;
  6133. actQuitTeam.Visible := False;
  6134. actDisbandTeam.Visible := False;
  6135. spbSendFile.Enabled := False;
  6136. spbAudio.Enabled := False;
  6137. spbVideo.Enabled := False;
  6138. spbUploadFile.Enabled := False;
  6139. spbRemoteControl.Enabled := False;
  6140. spbSendFolder.Enabled := False;
  6141. spbSendImage.Visible := False;
  6142. spbCopyScreen.Visible := False;
  6143. //spbCopyScreen2.Visible := False;
  6144. spbSeeTeamOptions.Visible := False;
  6145. spbAddUser.Visible := False;
  6146. spbQuitTeam.Visible := False;
  6147. spbDisbandTeam.Visible := False;
  6148. pnlYourInfo.Visible := True;
  6149. // pnlMyInfo.Visible := True;
  6150. pnlTeamCallBoard.Visible := False;
  6151. pnlTeamMembers.Visible := False;
  6152. spbShakeWindow.Visible := True;
  6153. btnQR.Visible := True;
  6154. spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
  6155. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6156. spbSet.left := spbAudio.left + spbAudio.Width;
  6157. btnQR.left := spbSet.left + spbSet.Width + 2;
  6158. spbAbout.left := btnQR.left + btnQR.Width + 2;
  6159. end
  6160. else
  6161. begin
  6162. miSeeTeamDetailInformation.Visible := False;
  6163. miSeeYourDetailInformation.Visible := True;
  6164. miShowYourHeadImage.Visible := True;
  6165. miShowYourCard.Visible := True;
  6166. actSendFile.Visible := True;
  6167. actAudio.Visible := True;
  6168. actVideo.Visible := True;
  6169. actSeeTeamOptions.Visible := False;
  6170. actQuitTeam.Visible := False;
  6171. actDisbandTeam.Visible := False;
  6172. spbSendFile.Visible := True;
  6173. spbAudio.Visible := True;
  6174. spbVideo.Visible := True;
  6175. spbRemoteControl.Visible := True;
  6176. spbSendFolder.Visible := True;
  6177. spbUserInfo.Visible := True;
  6178. spbPostSMS.Visible := True;
  6179. spbSeeTeamOptions.Visible := False;
  6180. spbAddUser.Visible := False;
  6181. spbQuitTeam.Visible := False;
  6182. spbDisbandTeam.Visible := False;
  6183. pnlYourInfo.Visible := True;
  6184. // pnlMyInfo.Visible := True;
  6185. pnlTeamCallBoard.Visible := False;
  6186. pnlTeamMembers.Visible := False;
  6187. spbShakeWindow.Visible := True;
  6188. btnQR.Visible := True;
  6189. spbCopyScreen.left := spbShakeWindow.left + spbShakeWindow.Width + 3;
  6190. //spbHistroyMessage.left:= spbCopyScreen.left + spbCopyScreen.Width + 3;
  6191. spbSet.left := spbAudio.left + spbAudio.Width;
  6192. btnQR.left := spbSet.left + spbSet.Width + 2;
  6193. spbAbout.left := btnQR.left + btnQR.Width + 2;
  6194. end;
  6195. PnlTeamWebDisk.Visible := False;
  6196. spbTeamNetWorkDisk.Visible := False;
  6197. if FileExists(FRealICQUser.HeadImageFile) then
  6198. begin
  6199. try
  6200. if (FRealICQUser.HeadImageFileType = htGIF) then
  6201. begin
  6202. GIFImage := TGIFImage.Create;
  6203. GIFImage.Animate := MainForm.ShowGIFInTalkingForm;
  6204. try
  6205. GIFImage.LoadFromFile(FRealICQUser.HeadImageFile);
  6206. if GIFImage.Animate then
  6207. ImgHeadForYourInfo.Picture.Assign(GIFImage)
  6208. else
  6209. ImgHeadForYourInfo.Picture.Bitmap.Assign(GIFImage);
  6210. finally
  6211. GIFImage.Free;
  6212. end;
  6213. end
  6214. else
  6215. ImgHeadForYourInfo.Picture.LoadFromFile(FRealICQUser.HeadImageFile);
  6216. except
  6217. ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  6218. end;
  6219. end
  6220. else
  6221. begin
  6222. ImgHeadForYourInfo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPicture);
  6223. end;
  6224. TimerForGetUserInformation.Enabled := True;
  6225. if FRealICQUser.DisplayName = '' then
  6226. begin
  6227. UserName := FRealICQUser.LoginName;
  6228. end
  6229. else
  6230. UserName := FRealICQUser.DisplayName;
  6231. Caption := UserName;
  6232. iPos := AnsiPos('-', FRealICQUser.LoginName);
  6233. ServerId := Copy(FRealICQUser.LoginName, 1, iPos - 1);
  6234. if AnsiPos('+', ServerId) > 0 then
  6235. begin
  6236. ServerId := Copy(ServerId, AnsiPos('+', ServerId) + 1, Length(ServerId));
  6237. end;
  6238. cardYour.CompanyName := FRealICQUser.Company;
  6239. cardYour.BranchName := FRealICQUser.Branch;
  6240. // if Trim(FRealICQUser.Company)='' then cardYour.CompanyName:=MainForm.GetCompany;
  6241. // if Trim(FRealICQUser.Branch)='' then cardYour.BranchName:=MainForm.GetBranchName(FRealICQUser.LoginName);
  6242. if TConditionConfig.GetConfig.UserInfoController then
  6243. begin
  6244. cardYour.IsSeeRight := (ServerId = MainForm.RealICQClient.ServerID);
  6245. if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slAllCannotSee) then
  6246. begin
  6247. cardYour.IsSeeRight := False;
  6248. end;
  6249. if (TConditionConfig.GetConfig.UserInfoController) and (FRealICQUser.Secret = slOnlyFriendCanSee) and not (TUsersService.GetUsersService.IsWorkmateOrFriend(FRealICQUser.LoginName)) then
  6250. begin
  6251. cardYour.IsSeeRight := False;
  6252. end;
  6253. end
  6254. else
  6255. cardYour.IsSeeRight := True;
  6256. cardYour.RealICQUser := FRealICQUser;
  6257. //FRealICQClient.GetUserExInformation(cardYour.RealICQUser.LoginName);
  6258. if FRealICQClient.Logined and FRealICQClient.Connected then
  6259. begin
  6260. (FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := nil;
  6261. //(FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox).OnP2PTypeChanged := P2PTypeChanged;
  6262. //P2PTypeChanged((FRealICQUser.RealICQPtoPBox as TRealICQPtoPBox));
  6263. end
  6264. else
  6265. begin
  6266. //lblState.Caption := '连接方式: 服务器中转';
  6267. end;
  6268. PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6269. PostMessage(Handle, WM_SIZE, 0, 0);
  6270. if FVCardFrom.pb1.Parent = FVCardFrom then
  6271. begin
  6272. FVCardFrom.pb1.Parent := Self.pnlUserInformation;
  6273. FVCardFrom.pb1.Align := alTop;
  6274. FVCardFrom.pb1.Height := Self.pnlUserInformation.Width;
  6275. pnlYourInfo.Top := 0;
  6276. end;
  6277. FVCardFrom.LoginName := FReceiver;
  6278. end;
  6279. function RoundEx(R: Real): Integer;
  6280. begin
  6281. Result := Trunc(R);
  6282. if Frac(R) >= 0.5 then
  6283. Result := Result + 1;
  6284. end;
  6285. //-----设置LblSendSMS的位置----------------------------------
  6286. procedure TTalkingForm.SetLblSendSMSPosition(HIntMsg: string);
  6287. var
  6288. iPos, TextWidth, Rows: integer;
  6289. SubStr: string;
  6290. chrWidth: Integer;
  6291. begin
  6292. iPos := AnsiPos('手机短信', HIntMsg);
  6293. chrWidth := LblHint.Canvas.TextWidth('发');
  6294. SubStr := Copy(HIntMsg, 1, iPos);
  6295. TextWidth := LblHint.Canvas.TextWidth(SubStr + '手机短信');
  6296. if TextWidth <= LblHint.Width then
  6297. begin
  6298. LblSendSMS.Caption := '手机短信';
  6299. LblSendSMS.Left := LblHint.Left + LblHint.Canvas.TextWidth(SubStr) - 5;
  6300. LblSendSMS.Top := LblHint.Top - 1;
  6301. LblSendSMS1.Visible := false;
  6302. end
  6303. else
  6304. begin
  6305. Rows := TextWidth div LblHint.Width;
  6306. iPos := LblHint.Width * Rows - LblHint.Canvas.TextWidth(SubStr);
  6307. if iPos < (chrWidth div 2) then
  6308. begin
  6309. LblSendSMS.Caption := '手机短信';
  6310. if abs(iPos) < (chrWidth div 2) then
  6311. LblSendSMS.Left := lblHint.Left
  6312. else
  6313. begin
  6314. iPos := RoundEx(abs(iPos) / chrWidth);
  6315. LblSendSMS.Left := lblHint.Left + iPos * chrWidth;
  6316. end;
  6317. LblSendSMS.Top := LblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * (Rows);
  6318. LblSendSMS1.Visible := false;
  6319. end
  6320. else
  6321. begin
  6322. iPos := RoundEx(iPos / chrWidth);
  6323. LblSendSMS.Caption := Copy('手机短信', 1, iPos * 2);
  6324. LblSendSMS.Left := lblHint.Left + lblHint.Canvas.TextWidth(SubStr) - 5;
  6325. LblSendSMS.Top := lblHint.Top - 1;
  6326. LblSendSMS1.Caption := Copy('手机短信', iPos * 2 + 1, Length('手机短信') - iPos * 2);
  6327. LblSendSMS1.Left := lblHint.Left;
  6328. LblSendSMS1.Top := lblHint.Top + LblHint.Canvas.TextHeight(HIntMsg) * Rows;
  6329. LblSendSMS1.BringToFront;
  6330. LblSendSMS1.Visible := True;
  6331. end;
  6332. end;
  6333. LblSendSMS.BringToFront;
  6334. end;
  6335. //------------------------------------------------------------------------------
  6336. procedure TTalkingForm.pnlDisplayerResize(Sender: TObject);
  6337. var
  6338. UserName, TeamName, AStateMsg, HIntMsg, HDestIntMsg: WideString;
  6339. FRealICQUser: TRealICQUser;
  6340. iIndex: Integer;
  6341. ATeam: TRealICQTeam;
  6342. begin
  6343. FRealICQUser := nil;
  6344. if FRealICQClient = nil then
  6345. Exit;
  6346. if FCategory = tcNormal then
  6347. begin
  6348. {$region '一对一的对话窗口'}
  6349. if Length(FReceiver) = 0 then
  6350. Exit;
  6351. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(FReceiver);
  6352. if Assigned(FRealICQUser) then
  6353. begin
  6354. if FRealICQUser.DisplayName = '' then
  6355. UserName := FRealICQUser.LoginName
  6356. else
  6357. UserName := FRealICQUser.DisplayName;
  6358. if (FRealICQUser.LoginState = stLeave) or (FRealICQUser.LoginState = stBusy) then
  6359. AStateMsg := FRealICQUser.LeaveMessage
  6360. else
  6361. begin
  6362. if FRealICQUser.LoginState = stMobileOnline then
  6363. AStateMsg := StateValues[Integer(FRealICQUser.LoginState)]
  6364. else
  6365. AStateMsg := StateValues[Integer(FRealICQUser.LoginState) mod 5];
  6366. end;
  6367. if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
  6368. HDestIntMsg := '发送至: ' + UserName + '(出差)'
  6369. else if FRealICQUser.Watchword = '' then
  6370. HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ')'
  6371. else
  6372. HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ') - ' + FRealICQUser.Watchword;
  6373. end
  6374. else //这种情况是与服务器的连接已断开了
  6375. begin
  6376. HDestIntMsg := LblDest.Hint;
  6377. end;
  6378. {$endregion}
  6379. end
  6380. else
  6381. begin
  6382. {$region '群组模式对话窗体'}
  6383. if Length(Trim(FTeamID)) <= 0 then
  6384. Exit;
  6385. ATeam := TTeamsAdapter.GetTeam(FTeamID);
  6386. if ATeam = nil then //这种情况是与服务器的连接已断开了,或不再是这个群的成员了
  6387. begin
  6388. HDestIntMsg := LblDest.Hint;
  6389. Log('与服务器的连接已断开了,或不再是这个群的成员', 'TTalkingForm.pnlDisplayerResize');
  6390. end
  6391. else
  6392. begin
  6393. if ATeam.TeamCaption = '' then
  6394. TeamName := ATeam.TeamID
  6395. else
  6396. TeamName := ATeam.TeamCaption;
  6397. if ATeam.IsTempTeam then
  6398. TeamName := '多人对话'
  6399. else
  6400. TeamName := TeamName + '(群组对话)';
  6401. if ATeam.TeamIntro = '' then
  6402. HDestIntMsg := '参与群组: ' + TeamName
  6403. else
  6404. HDestIntMsg := '参与群组: ' + TeamName + ' - ' + AnsiReplaceStr(ATeam.TeamIntro, #$D#$A, ' ');
  6405. end;
  6406. {$endregion}
  6407. end;
  6408. {$region '相关提示信息'}
  6409. pnlClient.Enabled := True;
  6410. if (FRealICQClient.Me = nil) then
  6411. begin
  6412. AStateMsg := StateValues[Integer(stOffline)];
  6413. HIntMsg := '您当前处于“' + AStateMsg + '”状态,不能发送任何消息!';
  6414. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6415. // pnlHint.Visible := True;
  6416. pnlClient.Enabled := False;
  6417. end
  6418. else if FCategory = tcNormal then
  6419. begin
  6420. if FRealICQClient.Blacklists.IndexOf(FRealICQUser.LoginName) >= 0 then
  6421. begin
  6422. //检查是否在黑名单列表中
  6423. HIntMsg := '该用户已列入黑名单,将无法收到任何消息!';
  6424. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6425. // pnlHint.Visible := True;
  6426. end
  6427. else if FRealICQUser.LoginState <> stOnline then
  6428. begin
  6429. if ((FRealICQUser.LoginState = stOffline) or (FRealICQUser.LoginState = stHidden)) and (FRealICQUser.OfflineAutoResponseEnabled) then
  6430. HIntMsg := '对方处于“出差”状态,您可以发送手机短信联系他 - ' + FRealICQUser.OfflineAutoResponseText
  6431. else
  6432. HIntMsg := '对方处于“' + AStateMsg + '”状态,' + '您可以发送手机短信联系他。';
  6433. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6434. // pnlHint.Visible := True;
  6435. SetLblSendSMSPosition(HIntMsg);
  6436. end
  6437. else
  6438. pnlHint.Visible := False;
  6439. end
  6440. else if FCategory = tcTeam then
  6441. begin
  6442. if TTeamsAdapter.GetTeam(FTeamID) = nil then
  6443. begin
  6444. HIntMsg := '您已不是群组“' + Caption + '”的成员,不能收发任何消息!';
  6445. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6446. LblHint.Caption := HIntMsg;
  6447. pnlHint.Height := LblHint.Height + 10;
  6448. // pnlHint.Visible := True;
  6449. pnlClient.Enabled := False;
  6450. end
  6451. else
  6452. pnlHint.Visible := False;
  6453. end
  6454. else
  6455. pnlHint.Visible := False;
  6456. if (pnlHint.Visible = False) and (FRealICQClient.Me <> nil) and (FRealICQClient.Me.LoginState <> stOnline) then
  6457. begin
  6458. if (FRealICQClient.Me.LoginState = stLeave) or (FRealICQClient.Me.LoginState = stBusy) then
  6459. AStateMsg := FRealICQClient.Me.LeaveMessage
  6460. else
  6461. AStateMsg := StateValues[Integer(FRealICQClient.Me.LoginState)];
  6462. HIntMsg := '您的当前状态为:' + AStateMsg;
  6463. LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1);
  6464. // pnlHint.Visible := True;
  6465. end;
  6466. LblHint.Caption := HIntMsg;
  6467. pnlHint.Height := LblHint.Height + 10;
  6468. {$endregion}
  6469. {$region '消息接收方信息'}
  6470. LblDest.Hint := HDestIntMsg;
  6471. LblDest.ShowHint := False;
  6472. //字符串长度过长时,截短字符串并在后面显示“...”
  6473. while LblDest.Canvas.TextWidth(HDestIntMsg) > LblDest.Width do
  6474. begin
  6475. if Length(HDestIntMsg) > 3 then
  6476. begin
  6477. if Copy(HDestIntMsg, Length(HDestIntMsg) - 2, Length(HDestIntMsg)) = '...' then
  6478. HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 3);
  6479. HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 1) + '...';
  6480. end
  6481. else
  6482. break;
  6483. LblDest.ShowHint := True;
  6484. end;
  6485. LblDest.Caption := HDestIntMsg;
  6486. {$endregion}
  6487. end;
  6488. procedure TTalkingForm.pnlTalkingAreaClick(Sender: TObject);
  6489. begin
  6490. end;
  6491. //------------------------------------------------------------------------------
  6492. function GetTalkingFormCount: Integer;
  6493. begin
  6494. Result := TalkingForms.Count;
  6495. end;
  6496. //------------------------------------------------------------------------------
  6497. procedure CloseAllTalkingForm;
  6498. var
  6499. AForm: TTalkingForm;
  6500. begin
  6501. while TalkingForms.Count > 0 do
  6502. begin
  6503. AForm := TalkingForms[0];
  6504. FreeAndNil(AForm);
  6505. end;
  6506. end;
  6507. //------------------------------------------------------------------------------
  6508. procedure UpdateAllTakingFormGIFHeadImage;
  6509. var
  6510. iLoop: Integer;
  6511. AForm: TTalkingForm;
  6512. FRealICQUser: TRealICQUser;
  6513. begin
  6514. for iLoop := TalkingForms.Count - 1 downto 0 do
  6515. begin
  6516. AForm := TalkingForms[iLoop];
  6517. FRealICQUser := TUsersService.GetUsersService.GetOrRequestUser(AForm.FReceiver);
  6518. if Assigned(FRealICQUser) then
  6519. begin
  6520. if FRealICQUser.HeadImageFileType = htGIF then
  6521. AForm.SetReceiver(AForm.FReceiver);
  6522. end;
  6523. if AForm.FRealICQClient.Me.HeadImageFileType = htGIF then
  6524. begin
  6525. AForm.UpdateMyInfo;
  6526. end;
  6527. end;
  6528. end;
  6529. procedure UpdateAllTakingFormHotKeySet;
  6530. var
  6531. iLoop: Integer;
  6532. AForm: TTalkingForm;
  6533. begin
  6534. for iLoop := TalkingForms.Count - 1 downto 0 do
  6535. begin
  6536. AForm := TalkingForms[iLoop];
  6537. AForm.actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage;
  6538. AForm.actEnter.Checked := not MainForm.CtrlEnterSendMessage;
  6539. end;
  6540. end;
  6541. //------------------------------------------------------------------------------
  6542. procedure SetAllTakingFormEnabledState(AEnableValue: Boolean);
  6543. var
  6544. iLoop: Integer;
  6545. AForm: TTalkingForm;
  6546. begin
  6547. for iLoop := TalkingForms.Count - 1 downto 0 do
  6548. begin
  6549. AForm := TalkingForms[iLoop];
  6550. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6551. begin
  6552. FreeAndNil(AForm);
  6553. continue;
  6554. end;
  6555. PostMessage(AForm.pnlDisplayer.Handle, WM_SIZE, 0, 0);
  6556. AForm.pnlClient.Enabled := AEnableValue;
  6557. if not AEnableValue then
  6558. AForm.CancelAllSendFile;
  6559. end;
  6560. end;
  6561. //------------------------------------------------------------------------------
  6562. procedure SetTalkingFormPosition(APrevForm, ATalkingForm: TTalkingForm; AShowActive: Boolean);
  6563. begin
  6564. if APrevForm <> nil then
  6565. begin
  6566. ATalkingForm.Left := APrevForm.Left + 20;
  6567. ATalkingForm.Top := APrevForm.Top + 20;
  6568. if (ATalkingForm.Left + ATalkingForm.Width > Screen.WorkAreaWidth) or (ATalkingForm.Top + ATalkingForm.Height > Screen.WorkAreaHeight) then
  6569. begin
  6570. ATalkingForm.Left := 0;
  6571. ATalkingForm.Top := 0;
  6572. end;
  6573. end
  6574. else
  6575. begin
  6576. //TalkingForm.Left := (Screen.WorkAreaWidth - TalkingForm.Width) div 2;
  6577. //TalkingForm.Top := (Screen.WorkAreaHeight - TalkingForm.Height) div 2;
  6578. end;
  6579. if AShowActive then
  6580. ATalkingForm.WindowState := wsNormal
  6581. else
  6582. ATalkingForm.WindowState := wsMinimized;
  6583. ATalkingForm.Show;
  6584. if AShowActive then
  6585. begin
  6586. ShowWindow(ATalkingForm.Handle, SW_SHOW);
  6587. ForceForeGroundWindow(ATalkingForm.Handle);
  6588. end;
  6589. end;
  6590. //------------------------------------------------------------------------------
  6591. procedure UpdateTalkingForm(ARealICQUser: TRealICQUser);
  6592. var
  6593. iLoop: Integer;
  6594. AForm: TTalkingForm;
  6595. begin
  6596. for iLoop := TalkingForms.Count - 1 downto 0 do
  6597. begin
  6598. AForm := TalkingForms[iLoop];
  6599. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6600. FreeAndNil(AForm)
  6601. else
  6602. AForm.UpdateMyInfo;
  6603. if AForm.FCategory = tcNormal then
  6604. begin
  6605. if (AForm.FReceiver = ARealICQUser.LoginName) then
  6606. begin
  6607. AForm.SetReceiver(ARealICQUser.LoginName);
  6608. end;
  6609. end
  6610. else
  6611. begin
  6612. if AForm.FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName) >= 0 then
  6613. begin
  6614. AForm.UpdateTeamMember(ARealICQUser);
  6615. end;
  6616. end;
  6617. end;
  6618. end;
  6619. //------------------------------------------------------------------------------
  6620. function GetTalkingForm(AReceiver: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6621. var
  6622. iLoop: Integer;
  6623. TalkingForm: TTalkingForm;
  6624. RealICQClient: TRealICQClient;
  6625. begin
  6626. Result := nil;
  6627. if ARealICQClient = nil then
  6628. RealICQClient := MainForm.RealICQClient
  6629. else
  6630. RealICQClient := ARealICQClient;
  6631. for iLoop := 0 to TalkingForms.Count - 1 do
  6632. begin
  6633. TalkingForm := TalkingForms[iLoop];
  6634. if TalkingForm.FCategory <> tcNormal then
  6635. Continue;
  6636. if AnsiSameText(TalkingForm.Receiver, AReceiver) and (TalkingForm.FRealICQClient = RealICQClient) then
  6637. begin
  6638. Result := TalkingForm;
  6639. Exit;
  6640. end;
  6641. end;
  6642. end;
  6643. //------------------------------------------------------------------------------
  6644. procedure ChangeTalkingFormVisible(AVisible: Boolean);
  6645. var
  6646. iLoop: Integer;
  6647. AForm: TTalkingForm;
  6648. begin
  6649. for iLoop := 0 to TalkingForms.Count - 1 do
  6650. begin
  6651. AForm := TalkingForms[iLoop];
  6652. AForm.Visible := AVisible;
  6653. if AVisible then
  6654. end;
  6655. end;
  6656. //------------------------------------------------------------------------------
  6657. function OpenTalkingForm(AReceiver: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6658. var
  6659. iLoop: Integer;
  6660. AForm, TalkingForm: TTalkingForm;
  6661. begin
  6662. // if MainForm.RealICQClient.Friends.IndexOf(AReceiver)<0 then
  6663. MainForm.RealICQClient.GetUserLoginState(AReceiver);
  6664. AForm := nil;
  6665. Result := nil;
  6666. if OpenningTalkingForm then
  6667. Exit;
  6668. try
  6669. OpenningTalkingForm := True;
  6670. for iLoop := 0 to TalkingForms.Count - 1 do
  6671. begin
  6672. AForm := TalkingForms[iLoop];
  6673. if AForm.FCategory <> tcNormal then
  6674. Continue;
  6675. if AnsiSameText(AForm.Receiver, AReceiver) then
  6676. begin
  6677. if AShowActive then
  6678. ForceForeGroundWindow(AForm.Handle);
  6679. Result := AForm;
  6680. Exit;
  6681. end;
  6682. end;
  6683. TalkingForm := TTalkingForm.Create(MainForm);
  6684. TalkingForm.FCategory := tcNormal;
  6685. if ARealICQClient = nil then
  6686. TalkingForm.FRealICQClient := MainForm.RealICQClient
  6687. else
  6688. TalkingForm.FRealICQClient := ARealICQClient;
  6689. TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
  6690. TalkingForm.Receiver := AReceiver;
  6691. TalkingForm.UpdateMyInfo;
  6692. TalkingForm.LoadWindowColor;
  6693. TalkingForm.LoadBackGround;
  6694. SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
  6695. Result := TalkingForm;
  6696. finally
  6697. OpenningTalkingForm := False;
  6698. end;
  6699. MainForm.HideMainForm;
  6700. end;
  6701. //------------------------------------------------------------------------------
  6702. function OpenTeamTalkingForm(ATeamID: string; AShowActive: Boolean = True; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6703. var
  6704. iLoop: Integer;
  6705. AForm, TalkingForm: TTalkingForm;
  6706. begin
  6707. AForm := nil;
  6708. Result := nil;
  6709. if OpenningTalkingForm then
  6710. Exit;
  6711. try
  6712. OpenningTalkingForm := True;
  6713. for iLoop := 0 to TalkingForms.Count - 1 do
  6714. begin
  6715. AForm := TalkingForms[iLoop];
  6716. if AForm.FCategory <> tcTeam then
  6717. Continue;
  6718. if AForm.FTeamID = ATeamID then
  6719. begin
  6720. if AShowActive then
  6721. ForceForeGroundWindow(AForm.Handle);
  6722. Result := AForm;
  6723. Exit;
  6724. end;
  6725. end;
  6726. //Dialogs.ShowMessage('TTalkingForm.Create');
  6727. TalkingForm := TTalkingForm.Create(MainForm);
  6728. //Dialogs.ShowMessage('TTalkingForm.Created');
  6729. TalkingForm.FCategory := tcTeam;
  6730. if ARealICQClient = nil then
  6731. TalkingForm.FRealICQClient := MainForm.RealICQClient
  6732. else
  6733. TalkingForm.FRealICQClient := ARealICQClient;
  6734. TalkingForm.FSender := TalkingForm.FRealICQClient.LoginName;
  6735. TalkingForm.TeamID := ATeamID;
  6736. TalkingForm.UpdateMyInfo;
  6737. TalkingForm.LoadWindowColor;
  6738. TalkingForm.LoadBackGround;
  6739. SetTalkingFormPosition(AForm, TalkingForm, AShowActive);
  6740. Result := TalkingForm;
  6741. finally
  6742. OpenningTalkingForm := False;
  6743. TTeamsAdapter.MessageMiscMust(ATeamID);
  6744. end;
  6745. MainForm.HideMainForm;
  6746. end;
  6747. //------------------------------------------------------------------------------
  6748. function GetTeamTalkingForm(ATeamID: string; ARealICQClient: TRealICQClient = nil): TTalkingForm;
  6749. var
  6750. iLoop: Integer;
  6751. TalkingForm: TTalkingForm;
  6752. RealICQClient: TRealICQClient;
  6753. begin
  6754. Result := nil;
  6755. if ARealICQClient = nil then
  6756. RealICQClient := MainForm.RealICQClient
  6757. else
  6758. RealICQClient := ARealICQClient;
  6759. for iLoop := 0 to TalkingForms.Count - 1 do
  6760. begin
  6761. TalkingForm := TalkingForms[iLoop];
  6762. if TalkingForm.FCategory <> tcTeam then
  6763. Continue;
  6764. if (AnsiSameText(TalkingForm.FTeamID, ATeamID)) and (TalkingForm.FRealICQClient = RealICQClient) then
  6765. begin
  6766. Result := TalkingForm;
  6767. Exit;
  6768. end;
  6769. end;
  6770. end;
  6771. //------------------------------------------------------------------------------
  6772. procedure UpdateTeamTalkingForm(ATeam: TRealICQTeam);
  6773. var
  6774. iLoop: Integer;
  6775. AForm: TTalkingForm;
  6776. begin
  6777. for iLoop := TalkingForms.Count - 1 downto 0 do
  6778. begin
  6779. AForm := TalkingForms[iLoop];
  6780. if AForm.FCategory <> tcTeam then
  6781. Continue;
  6782. if not AnsiSameText(AForm.FRealICQClient.LoginName, AForm.FSender) and (AForm.FSender <> '') then
  6783. FreeAndNil(AForm)
  6784. else
  6785. AForm.UpdateMyInfo;
  6786. if (AForm.FTeamID = ATeam.TeamID) then
  6787. begin
  6788. AForm.SetTeamID(ATeam.TeamID);
  6789. Exit;
  6790. end;
  6791. end;
  6792. end;
  6793. //------------------------------------------------------------------------------
  6794. function InTalkingFormAdvertisement(AHandle: THandle): Boolean;
  6795. var
  6796. iLoop: Integer;
  6797. AForm: TTalkingForm;
  6798. begin
  6799. Result := False;
  6800. for iLoop := 0 to TalkingForms.Count - 1 do
  6801. begin
  6802. AForm := TalkingForms[iLoop];
  6803. if IsChild(AForm.WebBrowserForAdvertisement.Handle, AHandle) then
  6804. begin
  6805. Result := True;
  6806. Exit;
  6807. end;
  6808. end;
  6809. end;
  6810. //------------------------------------------------------------------------------
  6811. function InTalkingFormTeamDisk(AHandle: THandle): Boolean;
  6812. var
  6813. iLoop: Integer;
  6814. AForm: TTalkingForm;
  6815. begin
  6816. Result := False;
  6817. for iLoop := 0 to TalkingForms.Count - 1 do
  6818. begin
  6819. AForm := TalkingForms[iLoop];
  6820. if IsChild(AForm.WebBrowserForTeamDisk.Handle, AHandle) then
  6821. begin
  6822. Result := True;
  6823. Exit;
  6824. end;
  6825. end;
  6826. end;
  6827. //------------------------------------------------------------------------------
  6828. procedure ChangeTalkingFormColor(AColor: TColor);
  6829. var
  6830. iLoop: Integer;
  6831. AForm: TTalkingForm;
  6832. begin
  6833. for iLoop := 0 to TalkingForms.Count - 1 do
  6834. begin
  6835. AForm := TalkingForms[iLoop];
  6836. if not AForm.FUseSelfColor then
  6837. AForm.ChangeUIColor(AColor);
  6838. end;
  6839. end;
  6840. //------------------------------------------------------------------------------
  6841. procedure UpdateTalkingFormAdversement;
  6842. var
  6843. iLoop: Integer;
  6844. AForm: TTalkingForm;
  6845. begin
  6846. for iLoop := 0 to TalkingForms.Count - 1 do
  6847. begin
  6848. AForm := TalkingForms[iLoop];
  6849. AForm.LoadAdvertisement;
  6850. end;
  6851. end;
  6852. //------------------------------------------------------------------------------
  6853. procedure ChangeTalkingFormSkin(ASkinName: string);
  6854. var
  6855. iLoop: Integer;
  6856. AForm: TTalkingForm;
  6857. OldSkin: string;
  6858. begin
  6859. ASkinName := AnsiReplaceText(ASkinName, 'MainForm', '');
  6860. for iLoop := 0 to TalkingForms.Count - 1 do
  6861. begin
  6862. AForm := TalkingForms[iLoop];
  6863. OldSkin := AForm.SkinName;
  6864. try
  6865. AForm.SkinName := ASkinName;
  6866. except
  6867. AForm.SkinName := OldSkin;
  6868. end;
  6869. if not AForm.FUseSelfColor then
  6870. AForm.ChangeUIColor(MainForm.UIMainColor)
  6871. else
  6872. AForm.ChangeUIColor(AForm.FWindowColor);
  6873. end;
  6874. end;
  6875. procedure TTalkingForm.SaveImageInfo(TempFaceFileName: string; iFlag: Integer);
  6876. var
  6877. tempImgInfo: PImageInfo;
  6878. begin
  6879. tempImgInfo := new(PImageInfo);
  6880. tempImgInfo.Name := TempFaceFileName;
  6881. tempImgInfo.iFlag := iFlag;
  6882. ImagesList.Add(tempImgInfo);
  6883. end;
  6884. //------------
  6885. function TTalkingForm.HasMobilePhone(LoginName: string): Boolean;
  6886. var
  6887. iIndex: Integer;
  6888. ListItem: TRealICQContacterListItem;
  6889. begin
  6890. Result := False;
  6891. iIndex := FLVTeamMembers.Items.IndexOf(LoginName);
  6892. if iIndex > -1 then
  6893. begin
  6894. ListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem;
  6895. Result := ListItem.HasSMS;
  6896. end;
  6897. end;
  6898. procedure TTalkingForm.spbUserInfoClick(Sender: TObject);
  6899. begin
  6900. miSeeYourDetailInformationClick(nil);
  6901. end;
  6902. //------------------------------------------------------------------------------
  6903. procedure TTalkingForm.spbCopyScreenClick(Sender: TObject);
  6904. var
  6905. Point1, Point2: TPoint;
  6906. begin
  6907. point1 := Point(0, 0);
  6908. point2 := Point(0, 0);
  6909. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6910. GetCursorPos(point2);
  6911. if (point2.X - point1.X) <= 17 then
  6912. begin
  6913. if MainForm.CopyScreenHideTalkForm then
  6914. begin
  6915. WindowState := wsMinimized;
  6916. MainForm.Close;
  6917. end;
  6918. try
  6919. ShowCopyScreenForm(Self);
  6920. finally
  6921. if MainForm.CopyScreenHideTalkForm then
  6922. Self.WindowState := wsNormal;
  6923. self.RichEdInputer.SetFocus;
  6924. end;
  6925. end
  6926. else
  6927. begin
  6928. Point1.X := 0;
  6929. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  6930. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6931. ppForSnap.Popup(Point1.X, Point1.Y);
  6932. end;
  6933. end;
  6934. procedure TTalkingForm.spbEncryMsgClick(Sender: TObject);
  6935. begin
  6936. spbEncryMsg.Tag := 0;
  6937. spbEncryMsg.Visible := false;
  6938. spbNormalMsg.Visible := true;
  6939. end;
  6940. procedure TTalkingForm.spbNormalMsgClick(Sender: TObject);
  6941. begin
  6942. spbEncryMsg.Tag := 1;
  6943. spbEncryMsg.Visible := true;
  6944. spbNormalMsg.Visible := false;
  6945. end;
  6946. //procedure TTalkingForm.chkEncryMessageClick(Sender: TObject);
  6947. //begin
  6948. // SpbEncryMessage.Enabled:= chkEncryMessage.Checked;
  6949. //end;
  6950. //------------------------------------------------------------------------------
  6951. procedure TTalkingForm.actClearEditExecute(Sender: TObject);
  6952. begin
  6953. RichEdInputer.Clear;
  6954. RichEditTemp.Clear;
  6955. end;
  6956. procedure TTalkingForm.actClearWebExecute(Sender: TObject);
  6957. begin
  6958. ClearHTML(self.WebBrowser);
  6959. end;
  6960. procedure TTalkingForm.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
  6961. begin
  6962. Accept := (NewSize >= 1) and ((self.ClientHeight - NewSize) >= 250);
  6963. end;
  6964. procedure TTalkingForm.spbSetClick(Sender: TObject);
  6965. var
  6966. Point1: TPoint;
  6967. begin
  6968. point1 := Point(0, 0);
  6969. Point1.Y := (Sender as TRealICQSpeedButton).Height + 1;
  6970. Point1 := (Sender as TRealICQSpeedButton).ClientToScreen(Point1);
  6971. ppForSet.Popup(Point1.X, Point1.Y);
  6972. end;
  6973. initialization
  6974. CoInitialize(nil);
  6975. OleInitialize(nil);
  6976. finalization
  6977. try
  6978. OleUninitialize;
  6979. CoUninitialize;
  6980. except
  6981. end;
  6982. end.