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