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 + '(' + Copy(SenderId, Pos('-', SenderId) + 1, Length(SenderId)) + ')';
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 + '  + Action_Paste_GIF + ')
';
if not IsHistory then
begin
if AnsiSameText(SenderID, FReceiver) then
SenderColor := '#009900'
else
SenderColor := '#0000FF';
end
else
SenderColor := '#686868';
HTML := '' + MsgContent + '
';
HTML := HTML + '' + '签收消息已发送' + ''
else
MsgContent := '
' + '收到一条待签收消息' + ''
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 + '">
' + MsgContent + '
';
if not IsHistory then
begin
if AnsiSameText(SenderID, FReceiver) then
SenderColor := '#009900'
else
SenderColor := '#0000FF';
end
else
SenderColor := '#686868';
HTML := '' + MsgContent + '
';
HTML := HTML + '' + '签收消息已发送' + ''
else
MsgContent := '
' + '收到一条待签收消息' + ''
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 + '">
' + MsgContent + ' ';
HTML := HTML + ' + TeamSharePic + ') ';
HTML := HTML + '';
AFileName := ReplaceStr(ReplaceStr(RealICQTeamMessage.MessageStr, '', ''), '', '');
HTML := HTML + FilterHtmlCode(SenderName, MainForm.AllowURL) + ' 共享了文件:' + AFileName + ' 查看 ';
HTML := HTML + '';
HTML := HTML + ' |
';
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 := '';
reg.Replacement := #$D#$A;
reg.ReplaceAll;
reg.RegEx := '';
reg.Replacement := #$D#$A;
reg.ReplaceAll;
reg.RegEx := '
';
reg.Replacement := #$D#$A;
reg.ReplaceAll;
reg.RegEx := ']*?>([\w\W]*?)<\/script>';
reg.Replacement := '';
reg.ReplaceAll;
reg.RegEx := ']+color=([^ >]+)[^>]*>(.*?)<\/font>';
reg.Replacement := '$2';
reg.ReplaceAll;
reg.RegEx := ']+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] := ''
// // + ''
// // + ''
// // + ''
// // + ''
// // + ''; //????????????????????????
// 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 := '' + ExtractFileName(ADest) + '';
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 := '';
HTML := HTML + ' + InfomationPicture + ') ';
HTML := HTML + '';
if AIsSource then
HTML := HTML + '您抖动了 ' + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 的对话窗口。'
else
HTML := HTML + FilterHtmlCode(UserName, MainForm.AllowURL) + ' 抖动了您的对话窗口。';
HTML := HTML + '';
HTML := HTML + ' |
';
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('
'));
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('
'));
//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.