Маленькая аська :) https://rnq.ru
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

5312 lines
147 KiB

{
This file is part of R&Q.
Under same license
}
unit chatDlg;
{$I RnQConfig.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
ComCtrls, StdCtrls, Menus, ExtCtrls, ToolWin, ActnList, RnQButtons,
VirtualTrees, StrUtils, System.Threading,
history, historyVCL,
Commctrl, selectContactsDlg,
ShockwaveFlashObjects_TLB,
// FlashPlayerControl,
RDGlobal,
RnQGraphics32,
// RnQAni,
// rnqCtrls,
RnQProtocol, RnQNet,
incapsulate, events,
pluginLib, RQMenuItem, System.Actions,
GR32, GR32_Backends;
{$I NoRTTI.inc}
const
minimizedScroll = 5;
maximizedScroll = 16;
ClrHistBG = 'history.bg';
type
THintWindowEx = class(THintWindow)
private
FParent: TForm;
animTimer: TTimer;
alphaValue: Integer;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure onAnimTimer(Sender: TObject);
public
bmp: TBitmap32;
constructor Create(AOwner: TComponent); override;
procedure ActivateHintWithFade(Rect: TRect; const AHint: string); virtual;
procedure Hide();
procedure startTimer();
procedure stopTimer();
protected
procedure Paint; override;
end;
TscrollBarEx = class(Tscrollbar)
protected
P_entering: boolean;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
public
onEnter, onLeave: procedure of object;
property entering: boolean read P_entering;
end;
TAvatr = record
AvtPBox: TPaintBox;
// Pic : TRnQBitmap;
PicAni: TRnQAni;
swf: TShockwaveFlash;
// swf : TFlashPlayerControl;
// swf : TTransparentFlashPlayerControl;
end;
TPanel = class(ExtCtrls.TPanel)
private
procedure WMEraseBkgnd(var msg: TWMEraseBkgnd); message WM_ERASEBKGND;
end;
TTimerEx = Class(TTimer)
public
X, Y: Integer;
end;
TChatType = (CT_IM, CT_PLUGING);
PChatInfo = ^TchatInfo;
TchatInfo = class
public
ID: Integer;
chatType: TChatType;
// panelID: Integer;
// who:Tcontact;
who: TRnQContact;
single: boolean; // single-message
// whole:boolean; // see whole history
// autoscroll:boolean; // auto scrolls along messages
// newSession:integer; // where, in the history, does start new session
// simpleMsg: Boolean;
lastInputText: string; // last input.text before quoting sequence
quoteIdx: Integer;
wasTyped: boolean; // input was not clear?
historyBox: ThistoryBox;
splitter: Tsplitter;
inputPnl: TPanel;
input: TMemo;
btnPnl: TPanel;
avtsplitr: Tsplitter;
avtPic: TAvatr;
// rsb:TscrollBar;
lsb: TscrollBarEx;
constructor Create;
procedure setAutoscroll(v: boolean);
procedure repaint();
procedure repaintAndUpdateAutoscroll();
procedure updateAutoscroll(Sender: TObject);
procedure updateLSB;
procedure CheckTypingTime;
end; // TchatInfo
Tchats = class(Tlist)
function validIdx(i: Integer): boolean;
function idxOf(c: TRnQContact): Integer;
function idxOfUIN(const uin: TUID): Integer;
function byIdx(i: Integer): TchatInfo;
function byContact(c: TRnQContact): TchatInfo;
procedure CheckTypingTimeAll;
end; // Tchats
TPageControl = class(ComCtrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TchatFrm = class(TForm)
pagectrl: TPageControl;
histmenu: TPopupMenu;
copylink2clpbd: TMenuItem;
copy2clpb: TMenuItem;
selectall1: TMenuItem;
viewmessageinwindow1: TMenuItem;
saveas1: TMenuItem;
html1: TMenuItem;
txt1: TMenuItem;
del1: TMenuItem;
addlink2fav: TMenuItem;
panel: TPanel;
sbar: TStatusBar;
chatshowlsb1: TMenuItem;
chatpopuplsb1: TMenuItem;
N1: TMenuItem;
add2rstr: TMenuItem;
ActList1: TActionList;
hAaddtoroaster: TAction;
hAsaveas: TAction;
hAdelete: TAction;
hAchatshowlsb: TAction;
hAchatpopuplsb: TAction;
hACopy: TAction;
hASelectAll: TAction;
N2: TMenuItem;
toantispam: TMenuItem;
sendBtn: TRnQToolButton;
closeBtn: TRnQToolButton;
toolbar: TToolBar;
historyBtn: TRnQSpeedButton;
findBtn: TRnQSpeedButton;
smilesBtn: TRnQSpeedButton;
prefBtn: TRnQSpeedButton;
autoscrollBtn: TRnQSpeedButton;
infoBtn: TRnQSpeedButton;
quoteBtn: TRnQSpeedButton;
singleBtn: TRnQSpeedButton;
btnContacts: TRnQSpeedButton;
RnQPicBtn: TRnQSpeedButton;
RnQFileBtn: TRnQSpeedButton;
tb0: TToolBar;
N3: TMenuItem;
Openchatwith1: TMenuItem;
savePicMnu: TMenuItem;
fp: TBevel;
caseChk: TCheckBox;
reChk: TCheckBox;
directionGrp: TComboBox;
w2sBox: TEdit;
SBSearch: TRnQButton;
CLPanel: TPanel;
CLSplitter: Tsplitter;
hAViewInfo: TAction;
ViewinfoM: TMenuItem;
hAShowSmiles: TAction;
chtShowSmiles: TMenuItem;
stickersBtn: TRnQSpeedButton;
ShowStickers: TAction;
ShowSmiles: TAction;
ShowSearch: TAction;
SelectAll: TAction;
BuzzBtn: TRnQSpeedButton;
procedure closemenuPopup(Sender: TObject);
procedure prefBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SBSearchClick(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure toantispamClick(Sender: TObject);
procedure RnQPicBtnClick(Sender: TObject);
procedure FileUploadUncompressed(Sender: TObject);
procedure FileUploadCompressed(Sender: TObject);
procedure FileUpload(Compress: Boolean);
procedure CloseallandAddtoIgnorelist1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure SplitterMoved(Sender: TObject);
procedure splitterMoving(Sender: TObject; var NewSize: Integer; var Accept: boolean);
procedure AvtSplitterMoved(Sender: TObject);
procedure AvtsplitterMoving(Sender: TObject; var NewSize: Integer; var Accept: boolean);
procedure FormCreate(Sender: TObject);
procedure sendBtnClick(Sender: TObject);
procedure pagectrl00MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure pagectrlChange(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Viewinfo1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure selectall1Click(Sender: TObject);
procedure viewmessageinwindow1Click(Sender: TObject);
procedure txt1Click(Sender: TObject);
procedure html1Click(Sender: TObject);
procedure infoBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure findBtnClick(Sender: TObject);
procedure quoteBtnClick(Sender: TObject);
procedure smilesBtnClick(Sender: TObject);
procedure autoscrollBtnClick(Sender: TObject);
procedure singleBtnClick(Sender: TObject);
procedure copylink2clpbdClick(Sender: TObject);
procedure copy2clpbClick(Sender: TObject);
procedure btnContactsClick(Sender: TObject);
procedure chatDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: boolean);
procedure chatDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure addlink2favClick(Sender: TObject);
procedure historyBtnClick(Sender: TObject);
procedure sbarDrawPanel(StatusBar: TStatusBar; panel: TStatusPanel; const Rect: TRect);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure sbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Sendwhenimvisibletohimher1Click(Sender: TObject);
procedure Sendmultiple1Click(Sender: TObject);
procedure del1Click(Sender: TObject);
procedure Closeall1Click(Sender: TObject);
procedure Closeallbutthisone1Click(Sender: TObject);
procedure CloseallOFFLINEs1Click(Sender: TObject);
procedure pagectrlChanging(Sender: TObject; var AllowChange: boolean);
procedure chatsendmenuopen1Click(Sender: TObject);
procedure chatcloseignore1Click(Sender: TObject);
procedure closeBtnClick(Sender: TObject);
procedure prefBtnClick(Sender: TObject);
{$IFDEF USE_SMILE_MENU}
procedure smilesMenuPopup(Sender: TObject);
procedure smilesMenuClose(Sender: TObject);
{$ENDIF USE_SMILE_MENU}
procedure histmenuPopup(Sender: TObject);
procedure chatshowlsb1Click(Sender: TObject);
procedure chathide1Click(Sender: TObject);
procedure chatpopuplsb1Click(Sender: TObject);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: boolean);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: boolean);
procedure pagectrl00MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ANothingExecute(Sender: TObject);
procedure hAchatshowlsbUpdate(Sender: TObject);
procedure hAchatpopuplsbUpdate(Sender: TObject);
procedure pagectrlDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: boolean);
procedure pagectrlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure pagectrlDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure savePicMnuClick(Sender: TObject);
procedure pagectrlMouseLeave(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CLPanelDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
procedure CLPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: boolean);
procedure CLPanelUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: boolean);
procedure quoteBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure findBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure smilesBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure hAViewInfoExecute(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{$IFDEF USE_SECUREIM}
procedure EncryptSendInit(Sender: TObject);
{$ENDIF USE_SECUREIM}
procedure EncryptSetPWD(Sender: TObject);
procedure EncryptClearPWD(Sender: TObject);
procedure hAShowSmilesUpdate(Sender: TObject);
procedure hAShowSmilesExecute(Sender: TObject);
procedure sbarDblClick(Sender: TObject);
procedure pagectrlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: boolean);
procedure popupHistmenu(X, Y: Integer);
procedure onHintTimer(Sender: TObject);
procedure stickersBtnClick(Sender: TObject);
procedure ShowStickersExecute(Sender: TObject);
procedure ShowSmilesExecute(Sender: TObject);
procedure ShowSearchExecute(Sender: TObject);
procedure SelectAllExecute(Sender: TObject);
procedure w2sBoxKeyPress(Sender: TObject; var Key: Char);
procedure BuzzBtnClick(Sender: TObject);
procedure RnQFileBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
{$IFDEF usesDC}
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
{$ENDIF usesDC}
procedure OnBeforeHeaderSend(Sender: TObject; const Method : String; Headers: TStrings);
procedure OnSendData(Sender: TObject; Buffer: Pointer; Len: Integer);
procedure RnQFileBtnClick(Sender: TObject);
protected
procedure WndProc(var Message: TMessage); override;
// procedure StartWheelPanning(Position: TPoint); virtual;
// procedure StopWheelPanning; virtual;
// procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
procedure WMEXITSIZEMOVE(var Message: TMessage); message WM_EXITSIZEMOVE;
procedure CreateParams(var Params: TCreateParams); override;
procedure ShowTabHint(X, Y: Integer);
// procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
procedure historyAllShowChange(ch: TchatInfo; histBtnDown: boolean);
procedure WMWINDOWPOSCHANGING(Var msg: TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
// procedure showSmilePanel(p : TPoint);
procedure WMAppCommand(var msg: TMessage); message WM_APPCOMMAND;
private
lastClick: Tdatetime;
lastClickIdx: Integer;
// lastContact : Tcontact;
lastContact: TRnQContact;
// окно хинта для отображения на закладках окна чата
// hintwnd: TVirtualTreeHintWindow = nil;
hintwnd: THintWindowEx;
// будем запоминать параметры хинта, чтобы не создавать несколько раз один и тот же хинт
LastMousePos: TPoint;
// hintTab: Integer;
last_tabindex: Integer;
FAniTimer: TTimer;
PagesEnumStr: RawByteString;
procedure TickAniTimer(Sender: TObject);
// procedure checkGifTime;
// procedure BooButton1Click(Sender: TObject);
procedure inputChange(Sender: TObject);
procedure inputPopup(Sender: TObject; MousePos: TPoint; var Handled: boolean);
procedure inputKeydown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure onHistoryRepaint(Sender: TObject);
procedure searchFrom(const start: Integer);
public
chats: Tchats;
poppedup: TPoint;
selectedUIN: TUID;
plugBtns: TPlugButtons;
sendMenuExt: TPopupMenu;
closeMenuExt: TPopupMenu;
{ $IFDEF USE_SECUREIM }
EncryptMenyExt: TPopupMenu;
{ $ENDIF USE_SECUREIM }
enterCount: Integer;
{$IFDEF USE_SMILE_MENU}
smile_theme_token: Integer;
smileMenuExt: TRnQPopupMenu;
{$ENDIF USE_SMILE_MENU}
MainFormWidth: Integer;
// favMenuExt: TPopupMenu;
menuWasCancelled: boolean;
FileSendMenu: TPopupMenu;
procedure SetSmilePopup(pIsMenu: boolean);
procedure UpdatePluginPanel;
function isChatOpen(otherHand: TRnQContact): boolean;
function openchat(otherHand: TRnQContact; ForceActive: boolean = false; isAuto: boolean = false): boolean;
function addEvent_openchat(otherHand: TRnQContact; ev: Thevent): boolean;
// opens chat if not already open
// function addEvent(uin:TUID; ev:Thevent):boolean; overload;// tells if ev has been inserted in a list, or can be freed
function addEvent(c: TRnQContact; ev: Thevent): boolean; overload;
// tells if ev has been inserted in a list, or can be freed
procedure openOn(c: TRnQContact; focus: boolean = true; pShow: boolean = true);
// procedure openOn(uid : TUID; focus:boolean=true);
procedure open(focus: boolean = true);
function newIMchannel(c: TRnQContact): Integer;
function thisChat: TchatInfo;
function thisChatUID: TUID;
procedure setTab(idx: Integer);
procedure userChanged(c: TRnQContact);
procedure redrawTab(c: TRnQContact);
function pageIndex: Integer;
procedure closeThisPage;
procedure closeAllPages(isAuto: boolean = false);
procedure closePageAt(idx: Integer);
procedure closeChatWith(c: TRnQContact);
function sawAllhere: boolean;
function isVisible: boolean;
procedure applyFormXY;
procedure lsbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure lsbEnter;
procedure updateContactStatus;
procedure quote(qs: String = ''; MakeCarret: boolean = true);
function pageIdxAt(X, Y: Integer): Integer;
procedure setCaptionFor(c: TRnQContact);
procedure setCaption(idx: Integer);
procedure updateChatfrmXY;
procedure setStatusbar(s: string);
function moveToTime(c: TRnQContact; time: Tdatetime; NeedOpen: boolean = true): boolean;
function moveToTimeOrEnd(c: TRnQContact; time: Tdatetime; NeedOpen: boolean = true): boolean;
procedure sendMessageAction(Sender: TObject);
procedure send; overload;
procedure send(flags_: Integer; msg: string = ''); overload;
procedure select(c: TRnQContact);
function thisContact: TRnQContact;
procedure flash;
procedure shake;
function grabThisText: string;
function Pages2String: RawByteString;
// procedure savePages;
procedure loadPages(const s: RawByteString);
procedure updateGraphics;
procedure addSmileAction(Sender: TObject);
procedure setLeftSB(visible: boolean);
procedure addcontactAction(Sender: TObject);
procedure AvtPBoxPaint(Sender: TObject);
end; // TchatFrm
function CHAT_TAB_ADD(Control: Integer; iIcon: HIcon; const TabCaption: string): Integer;
procedure CHAT_TAB_MODIFY(Control: Integer; iIcon: HIcon; const TabCaption: string);
procedure CHAT_TAB_DELETE(Control: Integer);
var
chatFrm: TchatFrm;
hintTimer: TTimerEx;
uploadCallbacks: TCallbacks;
implementation
uses
Clipbrd, ShellAPI, Themes,
math, Types,
Base64,
RDFileUtil, RQUtil, RDUtils, RnQSysUtils,
globalLib, viewInfoDlg, // searchhistDlg,
outboxlib, utilLib, outboxDlg, RnQTips, RnQPics,
langLib, roasterLib,
{$IFNDEF DB_ENABLED}
// RegExpr,
// RegularExpressions,
{$ENDIF ~DB_ENABLED}
// prefDlg,
{$IFDEF RNQ_AVATARS}
RnQ_Avatars, {UxTheme,}
{$ENDIF}
Protocols_all,
{$IFDEF PROTOCOL_ICQ}
Protocol_ICQ, ICQv9, ICQConsts, ICQContacts, RQ_ICQ,
{$ENDIF PROTOCOL_ICQ}
RQThemes, themesLib,
{$IFDEF USE_SECUREIM}
cryptoppWrap,
{$ENDIF USE_SECUREIM}
{$IFDEF UNICODE}
AnsiStrings,
Character,
{$ENDIF UNICODE}
RnQMenu, RnQLangs, RnQDialogs, menusUnit, RnQGlobal,
MenuSmiles, MenuStickers, mainDlg;
{$IFDEF SEND_FILE}
uses
RnQ_FAM;
{$ENDIF}
{$R *.DFM}
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color1: TColor;
Color2: TColor;
Rect: TRect;
Rgn: HRGN;
c: TRnQContact;
ci: TchatInfo;
hnd: HDC;
ev: Thevent;
pic, p: TPicName;
ss: String;
begin
hnd := Message.DrawItemStruct.HDC;
Rect := Message.DrawItemStruct.rcItem;
SelectClipRgn(hnd, 0);
ci := chatFrm.chats.byIdx(Message.DrawItemStruct.itemID);
if ci = nil then
exit;
Inc(Rect.Left, 2);
Inc(Rect.Top, 2);
if Message.DrawItemStruct.itemState = 1 then
begin
Color1 := theme.GetColor('button.bg.selected', clWebLightgrey);
Color2 := theme.GetColor('button.frame.selected', clWebGray);;
if not(ci.chatType = CT_IM) then
Inc(Rect.Right, 4);
FillRect(hnd, Rect, CreateSolidBrush(Color1));
FrameRect(hnd, Rect, CreateSolidBrush(Color2));
end;
c := ci.who;
with Canvas do
begin
Inc(Rect.Left, 4);
Inc(Rect.Top, 4);
dec(Rect.Right);
// dec(Rect.bottom);
SetBKMode(hnd, TRANSPARENT);
if ci.chatType = CT_IM then
begin
ev := eventQ.firstEventFor(c);
if (ev <> nil) and ((blinking or c.fProto.getStatusDisable.blinking) or not blinkWithStatus) then
begin
if (blinking or c.fProto.getStatusDisable.blinking) then
Inc(Rect.Left, 1 + ev.Draw(hnd, Rect.Left, Rect.Top).cx)
else
Inc(Rect.Left, 1 + ev.PicSize.cx);
end
else
begin
{$IFDEF RNQ_FULL}
if c.typing.bIsTyping then
pic := PIC_TYPING
else
{$ENDIF}
if showStatusOnTabs then
begin
{$IFDEF RNQ_FULL}
{$IFDEF CHECK_INVIS}
if c.isInvisible and c.isOffline then
pic := status2imgName(byte(SC_ONLINE), true)
else
{$ENDIF}
{$ENDIF}
pic := c.statusImg;
end;
Inc(Rect.Left, 1 + theme.drawPic(hnd, Rect.Left, Rect.Top, pic).cx)
end;
if UseContactThemes and Assigned(ContactsTheme) then
begin
ContactsTheme.ApplyFont(TPicName('group.') + TPicName(AnsiLowerCase(groups.id2name(c.group))) + '.' + p, Canvas.Font);
ContactsTheme.ApplyFont(TPicName(c.UID2cmp) + '.' + p, Canvas.Font);
end;
end
else
begin
Inc(Rect.Left, 4 + theme.drawPic(hnd, Rect.Left, Rect.Top,
'plugintab' + IntToStrA(chatFrm.chats.byIdx(Message.DrawItemStruct.itemID).ID)).cx);
end;
if (Message.DrawItemStruct.itemState = 1) then
p := 'chat.tab.active'
else
p := 'chat.tab.inactive';
theme.ApplyFont(p, Canvas.Font);
if ci.chatType = CT_IM then
begin
Inc(Rect.Left, 4);
ss := dupAmperstand(c.displayed);
end
else
begin
Inc(Rect.Right, 4);
ss := dupAmperstand(ci.lastInputText);
end;
dec(Rect.Top, 4);
DrawText(hnd, PChar(ss), Length(ss), Rect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
end;
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.HDC, Rgn);
DeleteObject(Rgn);
Message.Result := 1;
inherited;
end;
procedure TscrollBarEx.CMMouseEnter(var msg: TMessage);
begin
P_entering := true;
if Assigned(onEnter) then
onEnter
end;
procedure TscrollBarEx.CMMouseLeave(var msg: TMessage);
begin
P_entering := false;
if Assigned(onLeave) then
onLeave
end;
procedure TPanel.WMEraseBkgnd(var msg: TWMEraseBkgnd);
begin
msg.Result := 1;
msg.msg := 0;
end;
constructor TchatInfo.Create;
begin
inherited;
quoteIdx := -1;
end;
procedure TchatInfo.setAutoscroll(v: boolean);
begin
chatFrm.autoscrollBtn.down := v;
// historyBox.autoscroll:=v;
// historyBox.setAutoScrollForce(v);
historyBox.autoScrollVal := v;
end;
procedure TchatInfo.repaint();
begin
if not Assigned(self) then
exit;
if chatType = CT_IM then
begin
// if historyBox.autoscroll then historyBox.go2end
// else
if chatFrm.visible { and not IsIconic(chatFrm.handle) } then
begin
// needRepaint:= False;
historyBox.repaint;
end
// else
// needRepaint:= True;
end;
end;
procedure TchatInfo.repaintAndUpdateAutoscroll();
begin
repaint;
updateAutoscroll(historyBox)
end;
/// //////////////////////// Tchats /////////////////////////////////
{$WARN UNSAFE_CAST OFF}
function Tchats.idxOfUIN(const uin: TUID): Integer;
begin
Result := 0;
while Result < count do
begin
if TchatInfo(items[Result]).chatType = CT_IM then
if TchatInfo(items[Result]).who.equals(uin) then
exit;
Inc(Result);
end;
Result := -1;
end; // idxOfUIN
function Tchats.idxOf(c: TRnQContact): Integer;
begin
Result := 0;
while Result < count do
begin
if TchatInfo(items[Result]).chatType = CT_IM then
if TchatInfo(items[Result]).who.equals(c) then
exit;
Inc(Result);
end;
Result := -1;
end; // idxOf
function Tchats.byIdx(i: Integer): TchatInfo;
begin
Result := NIL;
if validIdx(i) then
Result := TchatInfo(items[i])
end; // byIdx
{$WARN UNSAFE_CAST ON}
function Tchats.byContact(c: TRnQContact): TchatInfo;
begin
Result := byIdx(idxOf(c))
end;
function Tchats.validIdx(i: Integer): boolean;
begin
Result := (i >= 0) and (i < count)
end;
procedure Tchats.CheckTypingTimeAll;
var
i: Integer;
begin
if Assigned(Account.AccProto) then
if (Account.AccProto.SupportTypingNotif) and (Account.AccProto.isSendTypingNotif) then
if count > 0 then
for i := count - 1 downto 0 do
if TchatInfo(items[i]).chatType = CT_IM then
if Assigned(TchatInfo(items[i]).who) then
TchatInfo(items[i]).CheckTypingTime;
end;
/// //////////////////////////////////////////////////////////////
procedure TchatFrm.FormResize(Sender: TObject);
var
ch: TchatInfo;
begin
if (w2sBox.Left + w2sBox.Width + 6) > directionGrp.Left then
w2sBox.Width := Max(directionGrp.Left - w2sBox.Left - 6, 10);
updateChatfrmXY;
ch := thisChat;
if ch = NIL then
exit;
if ch.chatType = CT_PLUGING then
plugins.castEv(PE_SELECTTAB, ch.ID)
else
begin
if Assigned(ch.inputPnl) then
begin
if (ch.inputPnl.height > pagectrl.ActivePage.ClientHeight) and (ch.inputPnl.height > 32) then
ch.inputPnl.height := pagectrl.ActivePage.ClientHeight - 30
end
else if (ch.input.height > pagectrl.ActivePage.ClientHeight) and (ch.input.height > 32) then
ch.input.height := pagectrl.ActivePage.ClientHeight - 30;
// updatea
ch.repaint; // AndUpdateAutoscroll();
// ch.repaintAndUpdateAutoscroll();
end;
end; // formResize
function TchatFrm.addEvent_openchat(otherHand: TRnQContact; ev: Thevent): boolean;
begin
openchat(otherHand);
Result := addEvent(otherHand, ev);
end; // addEvent_openchat
{ function TchatFrm.addEvent(uin: TUID; ev:Thevent):boolean;
var
i:integer;
ch : TchatInfo;
begin
result:=FALSE;
i:=chats.idxOfUIN(uin);
ch:=chats.byIdx(i);
if ch=NIL then
ev.free
else
begin
result:=true;
ch.historyBox.history.add(ev);
if i = pageIndex then
ch.repaint();
// ch.repaintAndUpdateAutoscroll();
end
end; // addEvent }
function TchatFrm.addEvent(c: TRnQContact; ev: Thevent): boolean;
// tells if ev has been inserted in a list, or can be freed
var
i: Integer;
ch: TchatInfo;
begin
Result := false;
i := chats.idxOf(c);
ch := chats.byIdx(i);
if ch = NIL then
ev.free
else
begin
Result := true;
ch.historyBox.addEvent(ev);
{ if i = pageIndex then
ch.repaint();
}
// ch.repaintAndUpdateAutoscroll();
end
end; // addEvent
function TchatFrm.pageIndex: Integer;
begin
if pagectrl.ActivePage = NIL then
Result := -1
else
Result := pagectrl.ActivePage.pageIndex
end;
// pageIndex
function TchatFrm.openchat(otherHand: TRnQContact; ForceActive: boolean = false; isAuto: boolean = false): boolean;
const
MaxNILpages = 101;
var
i, k: Integer;
wasEmpty, alreadyThere: boolean;
cnt: TRnQContact;
firstNILpage, NILcount: Integer;
begin
wasEmpty := pagectrl.pageCount = 0;
i := chats.idxOf(otherHand);
alreadyThere := i = pageIndex;
Result := i < 0;
if Result then
i := newIMchannel(otherHand);
if wasEmpty then
begin
setTab(i);
if docking.Docked2chat then
applyDocking;
end
else
begin
if not alreadyThere then
begin
if ForceActive then
begin
pagectrl.activePageIndex := i;
pagectrlChange(self);
end;
end;
if isAuto then
begin // protection against bruteforce
firstNILpage := -1;
NILcount := 0;
for k := 0 to chats.count - 1 do
begin
if chats.byIdx(k).chatType = CT_IM then
begin
cnt := chats.byIdx(k).who;
if Assigned(cnt) and notInList.exists(cnt) then
begin
Inc(NILcount);
if firstNILpage < 0 then
firstNILpage := k;
end;
end;
end;
if (firstNILpage >= 0) and (NILcount > MaxNILpages) then
closePageAt(firstNILpage);
end;
end;
if ForceActive and not visible then
visible := true;
end;
// openchat
function TchatFrm.isChatOpen(otherHand: TRnQContact): boolean;
begin
Result := chats.idxOf(otherHand) >= 0
end;
procedure TchatFrm.applyFormXY;
begin
with chatfrmXY do
if Width > 0 then
begin
if maximized then
begin
SetBounds(Left, Top, Width, height);
windowState := wsMaximized;
end
else
begin
SetBounds(Left, Top, Width, height);
windowState := wsNormal
end;
end;
end; // applyFormXY
procedure TchatFrm.onHintTimer(Sender: TObject);
begin
hintTimer.Enabled := false;
if not Assigned(hintwnd) or not hintwnd.visible then
ShowTabHint(hintTimer.X, hintTimer.Y);
end;
procedure TchatFrm.FormCreate(Sender: TObject);
begin
menuWasCancelled := false;
lastClickIdx := -1;
chats := Tchats.Create;
plugBtns := TPlugButtons.Create;
InitMenuChats;
createMenuAs(aSendMenu, sendMenuExt, self);
createMenuAs(aCloseMenu, closeMenuExt, self);
{$IFDEF USE_SECUREIM}
if useSecureIM then
createMenuAs(aEncryptMenu, EncryptMenyExt, self);
{$ENDIF USE_SECUREIM}
createMenuAs(aEncryptMenu2, EncryptMenyExt, self);
createMenuAs(aFileSendMenu, FileSendMenu, self);
sendBtn.DropdownMenu := sendMenuExt;
closeBtn.DropdownMenu := closeMenuExt;
{$IFDEF USE_SMILE_MENU}
smileMenuExt := TRnQPopupMenu.Create(self);
smileMenuExt.OnPopup := smilesMenuPopup;
smileMenuExt.OnClose := smilesMenuClose;
// smilesBtn.PopupMenu := smileMenuExt;
if Assigned(FSmiles) then
SetSmilePopup(false)
else
{$ENDIF USE_SMILE_MENU}
SetSmilePopup(true);
// favMenuExt := TPopupMenu.Create(self);
// favMenuExt.OnPopup := favMenuPopup;
plugBtns.PluginsTB := NIL;
plugBtns.btnCnt := 0;
hintwnd := nil;
last_tabindex := -1;
FAniTimer := TTimer.Create(nil);
FAniTimer.Enabled := false;
FAniTimer.Interval := 40;
// timer.Enabled:= UseAnime;
FAniTimer.OnTimer := TickAniTimer;
// DoubleBuffered := true;
sbar.DoubleBuffered := StyleServices.Enabled;
// pagectrl.DoubleBuffered := true;
DragAcceptFiles(self.handle, true);
applyFormXY;
applyTaskButton(self);
hintTimer := TTimerEx.Create(chatFrm);
hintTimer.Interval := 500;
hintTimer.Enabled := false;
hintTimer.OnTimer := onHintTimer;
end;
procedure TchatFrm.setTab(idx: Integer);
var
bool: boolean;
begin
if Assigned(pagectrl.Onchanging) then
begin
bool := true;
pagectrl.Onchanging(self, bool);
if bool = false then
exit;
end;
with pagectrl do
if idx < pageCount then
ActivePage := pages[idx]
else
msgDlg('Error: bad page', true, mtError); // should never reach this
if Assigned(pagectrl.onChange) then
pagectrl.onChange(self);
end; // setTab
procedure TchatFrm.userChanged(c: TRnQContact);
var
i: Integer;
ch: TchatInfo;
begin
if c = NIL then
exit;
ch := thisChat;
if (ch = NIL) then
exit;
if c.fProto.isMyAcc(c) then
begin
ch.repaint();
// ch.repaintAndUpdateAutoscroll();
// exit;
end;
i := chats.idxOf(c);
if i < 0 then
exit;
setCaptionFor(c);
redrawTab(c);
updateContactStatus;
if i = pageIndex then
ch.repaint();
// ch.repaintAndUpdateAutoscroll();
end; // userChanged
procedure TchatFrm.openOn(c: TRnQContact; focus: boolean = true; pShow: boolean = true);
var
i: Integer;
wasEmpty: boolean;
begin
if c = NIL then
exit;
wasEmpty := pagectrl.pageCount = 0;
i := chats.idxOf(c);
if i < 0 then
i := newIMchannel(c);
setTab(i);
if wasEmpty then
if docking.Docked2chat then
applyDocking;
if pShow then
open(focus);
end; // openOn
{ procedure TchatFrm.openOn(uid:TUID; focus:boolean=true);
var
i:integer;
cnt : Tcontact;
begin
cnt := contactsDB.get(uid);
if cnt=NIL then exit;
i:=chats.idxOf(cnt);
if i < 0 then
i:=newIMchannel(cnt);
setTab(i);
open(focus);
end; // openOn }
function TchatFrm.newIMchannel(c: TRnQContact): Integer;
var
sheet: TtabSheet;
chat: TchatInfo;
pnl: TPanel;
begin
{$IFDEF RNQ_FULL}
// rqSmiles.ClearAniParams;
theme.ClearAniParams;
{$ENDIF RNQ_FULL}
chat := TchatInfo.Create;
chat.who := c;
// chat.who := c;
chat.chatType := CT_IM;
chat.single := singleDefault;
chat.who.typing.bIAmTyping := false;
// if not assigned(pTCE(c.data).history0) then
// pTCE(c.data).history0:=Thistory.create;
sheet := TtabSheet.Create(self);
chats.Add(chat);
sheet.PageControl := pagectrl;
Result := sheet.pageIndex;
setCaption(Result);
sheet.ControlStyle := sheet.ControlStyle + [csOpaque];
sheet.BorderWidth := 0;
// setCaptionFor(c);
// sheet.ShowHint := true;
// sheet.Hint := c.display;
pnl := TPanel.Create(self);
pnl.parent := sheet;
pnl.align := alClient;
pnl.BevelEdges := [];
pnl.BevelKind := bkNone;
pnl.BevelInner := bvNone;
pnl.BevelOuter := bvNone;
pnl.BorderStyle := bsNone;
chat.historyBox := ThistoryBox.Create(pnl);
with chat.historyBox do
begin
chat.historyBox.parent := pnl;
who := c;
Color := theme.GetColor(ClrHistBG, clWindow); // history.bgcolor;
// history:=pTCE(c.data).history as Thistory;
history := Thistory.Create;
// history.Token := 101;
history.Reset;
align := alClient;
Realign;
onDragOver := chatDragOver;
onDragDrop := chatDragDrop;
onPainted := onHistoryRepaint;
OnScroll := chat.updateAutoscroll;
end;
chat.lsb := TscrollBarEx.Create(pnl);
with chat.lsb do
begin
parent := pnl;
align := alLeft;
tabStop := false;
OnScroll := lsbScroll;
onEnter := lsbEnter;
onLeave := lsbEnter;
Kind := sbVertical;
position := 0;
min := 0;
Max := 0;
if popupLSB then
Width := minimizedScroll
else
Width := maximizedScroll;
smallChange := 1;
largeChange := 5;
Enabled := false;
visible := showLSB;
hint := getTranslation('Scrolls the message line by line');
end;
{$IFDEF RNQ_FULL}
// rqSmiles.ClearAniParams;
theme.ClearAniParams;
{$ENDIF RNQ_FULL}
// pnl.insertControl(chat.historyBox);
chat.avtPic.swf := NIL;
chat.avtPic.PicAni := NIL;
chat.avtPic.AvtPBox := NIL;
chat.avtsplitr := NIL;
if avatarShowInChat then
begin
chat.inputPnl := TPanel.Create(self);
chat.inputPnl.parent := sheet;
chat.inputPnl.align := alBottom;
chat.inputPnl.BorderWidth := 0;
chat.inputPnl.BorderStyle := bsNone;
chat.inputPnl.BevelOuter := bvNone;
chat.inputPnl.BevelInner := bvNone;
chat.inputPnl.BevelKind := bkNone;
chat.inputPnl.ControlStyle := chat.inputPnl.ControlStyle + [csOpaque];
chat.inputPnl.FullRepaint := false;
chat.inputPnl.DoubleBuffered := true;
chat.input := TMemo.Create(chat.inputPnl);
chat.input.BorderStyle := bsNone;
chat.input.BevelKind := bkFlat;
chat.input.BevelInner := bvNone;
chat.input.BevelOuter := bvRaised;
chat.input.parent := chat.inputPnl;
chat.input.align := alClient;
sheet.ControlStyle := sheet.ControlStyle + [csOpaque];
sheet.DoubleBuffered := true;
if splitY > 0 then
chat.inputPnl.height := splitY
else
chat.inputPnl.height := 50;
// chat.avtsplitr.cursor:=crVsplit;
// chat.avtsplitr.onMoved:=splitterMoved;
// chat.avtsplitr.OnCanResize:=splitterMoving;
end
else
begin
chat.inputPnl := NIL;
chat.input := TMemo.Create(sheet);
chat.input.parent := sheet;
chat.input.align := alBottom;
if splitY > 0 then
chat.input.height := splitY
else
chat.input.height := 50;
end;
chat.input.WordWrap := true;
theme.ApplyFont('history.my', chat.input.Font);
chat.input.ScrollBars := ssVertical;
chat.input.onChange := inputChange;
chat.input.OnContextPopup := inputPopup;
chat.input.onKeyDown := inputKeydown;
chat.input.onDragOver := chatDragOver;
chat.input.onDragDrop := chatDragDrop;
{ if theme.GetPicSize( PIC_CHAT_BG+'5').cx > 0 then
begin
if not Assigned(chat.input.Brush.Bitmap) then
chat.input.Brush.Bitmap := TBitmap.Create;
// chat.input.Brush.Handle := theme.GetBrush(PIC_CHAT_BG+'5')
theme.GetPic(PIC_CHAT_BG+'5', chat.input.Brush.Bitmap, false);
end
else }
chat.input.Color := theme.GetColor(ClrHistBG, clWindow); // history.bgcolor;
chat.splitter := Tsplitter.Create(self);
chat.splitter.ResizeStyle := rsUpdate;
chat.splitter.minsize := 1;
chat.splitter.parent := sheet;
chat.splitter.align := alBottom;
chat.splitter.cursor := crVsplit;
chat.splitter.onMoved := SplitterMoved;
chat.splitter.OnCanResize := splitterMoving;
if usePlugPanel and (plugBtns.PluginsTB <> toolbar) then
begin
chat.btnPnl := TPanel.Create(self);
// chat.btnPnl.minsize:=1;
chat.btnPnl.parent := pnl;
chat.btnPnl.align := alBottom;
chat.btnPnl.height := 24;
chat.btnPnl.BorderWidth := 0;
chat.btnPnl.BorderStyle := bsNone;
chat.btnPnl.FullRepaint := false;
chat.btnPnl.BevelOuter := bvNone;
chat.btnPnl.BevelInner := bvNone;
chat.btnPnl.BevelKind := bkTile;
chat.btnPnl.BevelEdges := [beTop];
if Assigned(chat.btnPnl) then
if Assigned(plugBtns) then
chat.btnPnl.visible := plugBtns.btnCnt > 0
else
chat.btnPnl.visible := false;
// chat.btnPnl.cursor:=crVsplit;
end;
{$IFDEF RNQ_AVATARS}
updateAvatarFor(c);
{$ENDIF RNQ_AVATARS}
{ chat.avtPic := TImage.create(self);
chat.avtPic.parent := chat.inputPnl;
chat.avtPic.align := alRight;
if Assigned(c.icon) then
begin
chat.avtPic.Width := c.icon.Width + 5;
chat.avtPic.Picture.Assign(c.icon);
// chat.avtPic.Picture.Bitmap.TransparentMode := tmAuto;
// chat.avtPic.Picture.Bitmap.Transparent := true;
chat.avtPic.Transparent := c.icon.Transparent;
end
else
chat.avtPic.Width := 0;
}
chat.historyBox.Realign;
resize;
// savePages;
saveListsDelayed := true;
{$IFDEF RNQ_FULL}
// rqSmiles.ClearAniParams;
theme.ClearAniParams;
{$ENDIF RNQ_FULL}
chat.historyBox.updateRSB(false);
end; // newIMchannel
procedure TchatFrm.lsbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
var
ch: TchatInfo;
begin
with Sender as Tscrollbar do
begin
if position = ScrollPos then
exit;
ch := thisChat;
if ch = NIL then
exit;
ch.historyBox.topOfs := ScrollPos;
if ScrollPos > 0 then
hideScrollTimer := 0;
ch.historyBox.repaint();
ch.updateAutoscroll(nil);
end;
end; // lsbScroll
procedure TchatInfo.updateLSB;
begin
// if ch=NIL then exit;
if (historyBox.topEventNrows < 2) then
begin
lsb.Enabled := false;
if popupLSB then
lsb.Width := minimizedScroll;
// updateAutoscroll(nil);
end
else
begin
lsb.min := 0;
lsb.Max := historyBox.topEventNrows - 1;
lsb.pagesize := 1;
if lsb.position <> historyBox.topOfs then
lsb.position := historyBox.topOfs;
if lsb.position > 0 then
lsb.Width := maximizedScroll
else if not lsb.MouseInClient then
hideScrollTimer := 10;
// if lsb.Position = 0 then
lsb.Enabled := true;
end;
end; // updateLSB
procedure TchatInfo.CheckTypingTime;
begin
try
if (chatType = CT_IM) and Assigned(who) then
if (who.typing.bIAmTyping) and ((now - who.typing.typingTime) * SecsPerDay > typingInterval) then
who.fProto.InputChangedFor(who, false, true);
except
end;
end;
function TchatFrm.thisChat: TchatInfo;
begin
if (chats.count = 0) or (not Assigned(pagectrl.ActivePage)) then
Result := NIL
else
Result := chats.byIdx(pagectrl.ActivePage.pageIndex)
end;
function TchatFrm.thisContact: TRnQContact;
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = NIL then
Result := NIL
else if ch.chatType = CT_IM then
thisContact := ch.who
else
Result := NIL;
end; // thisContact
function TchatFrm.thisChatUID: TUID;
var
cnt: TRnQContact;
begin
cnt := thisContact;
if (cnt <> NIL) then
Result := cnt.UID2cmp
else
Result := '';
end;
procedure TchatFrm.sendBtnClick(Sender: TObject);
begin
send
end;
function TchatFrm.pageIdxAt(X, Y: Integer): Integer;
var
R: TRect;
begin
Result := 0;
while Result < chats.count do
begin
SendMessage(pagectrl.handle, TCM_GETITEMRECT, Result, Longint(@R));
if Types.ptInRect(R, Types.point(X, Y)) then
exit;
Inc(Result);
end;
Result := -1;
end; // pageIdxAt
procedure TchatFrm.pagectrl00MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
diff: Tdatetime;
i: Integer;
ev: Thevent;
b: boolean;
begin
case Button of
mbRight:
begin
i := pageIdxAt(X, Y);
if i < 0 then
exit;
if i <> pageIndex then
begin
b := true;
pagectrlChanging(Sender, b);
if b then
begin
pagectrl.ActivePage := pagectrl.pages[i];
pagectrlChange(Sender);
end;
end;
end;
mbLeft:
begin
i := pageIdxAt(X, Y);
if i = lastClickIdx then
diff := now - lastClick
else
diff := dblClickTime + 1;
lastClick := now;
lastClickIdx := i;
if diff < dblClickTime then
begin
ev := eventQ.firstEventFor(thisContact);
if ev <> nil then
begin
// realizeEvents(ev.kind, ev.who);
// eventQ.removeEvent(ev.kind, ev.who);
eventQ.remove(ev);
realizeEvent(ev);
pagectrl.EndDrag(true);
end
else
closeThisPage;
end;
end;
mbMiddle:
begin
i := pageIdxAt(X, Y);
if i < 0 then
exit;
if i = pageIndex then
closeThisPage
else
try
closePageAt(i);
except
end;
end;
end;
end; // pagectrl mousedown
procedure TchatFrm.closeThisPage;
Var
ClosePgIdx: Integer;
begin
if (pagectrl.ActivePage = NIL) or (thisChat = NIL) then
exit;
ClosePgIdx := pagectrl.ActivePage.TabIndex;
pagectrl.SelectNextPage(true);
closePageAt(ClosePgIdx);
end;
procedure TchatFrm.CLPanelDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
// var
// a : Integer;
begin
// a := chatFrm.Width;
// CLPanel.Align := alRight;
// ChatPnl.Align := alClient;
// Splitter1.Align := alRight;
if Source.Control is TRnQmain then
CLPanel.Width := Max(MainFormWidth + 2, 42);
docking.Docked2chat := true;
docking.Active := false;
mainfrmHandleUpdate;
// chatFrm.Width := a + 202;
end;
procedure TchatFrm.CLPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: boolean);
begin
Accept := Source.Control = mainDlg.RnQmain;
MainFormWidth := mainDlg.RnQmain.Width;
end;
procedure TchatFrm.CLPanelUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: boolean);
// var
// a : Integer;
begin
// { a := CLPanel.Width;
Allow := true;
CLPanel.Width := 2;
if pagectrl.pageCount > 0 then
docking.Docked2chat := false;
// mainfrmHandleUpdate;
{ CLPanel.Align := alClient;
ChatPnl.Align := alLeft;
Splitter1.Align := alLeft;
if Sender is TPanel then
TPanel(Sender).Width := 1;
MainDlg.RnQmain.Width := a + 2; }
end;
// closeThisPage
procedure TchatFrm.updateGraphics;
var
ch: TchatInfo;
i: Integer;
begin
ch := thisChat;
if ch = NIL then
exit;
if ch.chatType = CT_PLUGING then
exit;
theme.ApplyFont('history.my', ch.input.Font);
smilesBtn.down := useSmiles;
historyBtn.down := ch.historyBox.whole;
singleBtn.down := ch.single;
autoscrollBtn.down := ch.historyBox.autoScrollVal;
// SimplMsgBtn.Down := ch.simpleMsg;
updateContactStatus;
ch.input.Color := theme.GetColor(ClrHistBG, clWindow);
if Assigned(ch.btnPnl) then
if Assigned(plugBtns) then
ch.btnPnl.visible := plugBtns.btnCnt > 0
else
ch.btnPnl.visible := false;
// sbar.panels[0].Width:=80;
with theme.getPicSize(RQteDefault, PIC_OUTBOX, 16) do
begin
sbar.panels[1].Width := cx + 8;
i := cy + 6;
end;
with theme.getPicSize(RQteDefault, PIC_KEY, 16) do
begin
sbar.panels[3].Width := cx + 8;
i := Max(i, cy + 6);
end;
with theme.getPicSize(RQteDefault, PIC_CLI_QIP, 16) do
begin
sbar.panels[3].Width := sbar.panels[3].Width + cx + 3;
i := Max(i, cy + 6);
end;
sbar.height := boundInt(i, 22, 50);
sbar.repaint;
if popupLSB then
if ch.lsb.Enabled and (ch.lsb.position > ch.lsb.min) then
ch.lsb.Width := maximizedScroll
else
ch.lsb.Width := minimizedScroll
else
ch.lsb.Width := maximizedScroll;
ch.historyBox.Color := ch.input.Color;
if chatFrm.visible and not IsIconic(chatFrm.handle) then
ch.historyBox.repaint;
panel.Realign;
panel.repaint;
i := 21;
with theme.getPicSize(RQteButton, status2imgName(byte(SC_ONLINE)), icon_size) do
begin
i := Max(i, cy + 6);
end;
with theme.getPicSize(RQteButton, PIC_CLOSE, icon_size) do
begin
i := Max(i, cy + 6);
end;
toolbar.height := i + 2;
toolbar.ButtonHeight := i;
toolbar.Top := (panel.ClientHeight - toolbar.height) div 2;
sendBtn.height := i;
closeBtn.height := i;
sendBtn.Top := (panel.ClientHeight - sendBtn.height) div 2;
closeBtn.Top := (panel.ClientHeight - closeBtn.height) div 2;
end; // updateGraphics
procedure TchatFrm.pagectrlChanging(Sender: TObject; var AllowChange: boolean);
begin
with thisChat do
begin
lastContact := who;
if chatType = CT_PLUGING then
plugins.castEv(PE_DESELECTTAB, ID);
if Assigned(who) then
pTCE(who.data).keylay := GetKeyboardLayout(0)
end;
end;
procedure TchatFrm.pagectrlChange(Sender: TObject);
var
ch: TchatInfo;
i: Integer;
begin
{$IFDEF RNQ_FULL}
// rqSmiles.ClearAniParams;
theme.ClearAniParams;
{$ENDIF RNQ_FULL}
ch := thisChat;
if ch = NIL then
exit;
if ch.chatType = CT_IM then
begin
lastClick := now;
inputChange(self); // update char counter
setLeftSB(showLSB);
if autoSwitchKL and Assigned(lastContact) and (lastContact <> ch.who) and (pTCE(ch.who.data).keylay <> 0) then
ActivateKeyboardLayout(pTCE(ch.who.data).keylay, 0);
if chatFrm.visible and not IsIconic(chatFrm.handle) then
{ if ch.historyBox.autoscroll then
ch.historyBox.go2end
else }
ch.historyBox.repaint;
updateGraphics;
SBSearch.Enabled := true;
fp.visible := findBtn.down;
// SearchPnl.Visible := findBtn.Down;
if usePlugPanel then
begin
if plugBtns.PluginsTB <> toolbar then
try
plugBtns.PluginsTB.parent := ch.btnPnl;
plugBtns.PluginsTB.visible := true;
except
end;
end
else
for i := Low(plugBtns.btns) to High(plugBtns.btns) do
if Assigned(plugBtns.btns[i]) then
if not plugBtns.btns[i].Enabled then
plugBtns.btns[i].Enabled := true;
lastContact := NIL;
// if Assigned(ch.avtPic.PicAni) then
if Assigned(ch.avtPic.PicAni) and (ch.avtPic.PicAni.Animated) then
FAniTimer.Enabled := true
else
FAniTimer.Enabled := false;
if isVisible and Enabled and pagectrl.visible and pagectrl.Enabled then
ch.input.setFocus;
BuzzBtn.Visible := CAPS_big_Buzz in TICQContact(ch.who).capabilitiesBig;
BuzzBtn.Left := RnQFileBtn.Left + RnQFileBtn.Width;
stickersBtn.Enabled := EnableStickers;
end
else if (ch.chatType = CT_PLUGING) then
begin
// ch.input.visible:= false;
// ch.splitter.visible:= false;
if usePlugPanel then
begin
if plugBtns.PluginsTB <> toolbar then
begin
plugBtns.PluginsTB.parent := self;
plugBtns.PluginsTB.visible := false;
end;
end
else
for i := Low(plugBtns.btns) to High(plugBtns.btns) do
if Assigned(plugBtns.btns[i]) then
plugBtns.btns[i].Enabled := false;
SBSearch.Enabled := false;
// fp.Visible:= false;
plugins.castEv(PE_SELECTTAB, ch.ID);
BuzzBtn.Visible := False;
stickersBtn.Enabled := False;
end;
sendBtn.Enabled := ch.chatType <> CT_PLUGING;
historyBtn.Enabled := sendBtn.Enabled;
findBtn.Enabled := sendBtn.Enabled;
smilesBtn.Enabled := sendBtn.Enabled;
autoscrollBtn.Enabled := sendBtn.Enabled;
infoBtn.Enabled := sendBtn.Enabled;
quoteBtn.Enabled := sendBtn.Enabled;
btnContacts.Enabled := sendBtn.Enabled;
singleBtn.Enabled := sendBtn.Enabled;
RnQPicBtn.Enabled := sendBtn.Enabled;
// SimplMsgBtn.Enabled := sendBtn.Enabled;
// panel.visible := ch.who.uin <> 5000;
end; // pageCtrlChange
procedure TchatFrm.inputKeydown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
X, Y, i: Integer;
m: TMemo;
s: string;
b: boolean;
begin
if thisChat <> NIL then
begin
m := thisChat.input;
if Shift = [ssCtrl] then
case Key of
VK_BACK:
begin
X := m.caretpos.X;
Y := m.caretpos.Y;
s := m.lines[Y];
if X = 0 then
if Y = 0 then
exit
else
begin
m.lines.Delete(Y);
dec(Y);
X := Length(m.lines[Y]);
m.lines[Y] := m.lines[Y] + s;
end
else
begin
while (X > 0) and ((X > Length(s)) or (s[X] = ' ')) do
dec(X);
i := X - 1;
{$IFDEF UNICODE}
b := TCharacter.IsLetterOrDigit(s[X]);
while (i > 0) and ((i > Length(s)) or ((b) = TCharacter.IsLetterOrDigit(s[i]))) do
{$ELSE nonUNICODE}
b := s[X] in ALPHANUMERIC;
while (i > 0) and ((i > Length(s)) or ((b) = (s[i] in ALPHANUMERIC))) do
{$ENDIF UNICODE}
dec(i);
Delete(s, i + 1, m.caretpos.X - i);
m.lines[Y] := s;
X := i;
end;
m.caretpos := Types.point(X, Y);
Key := 0;
end;
end;
end;
end;
procedure TchatFrm.inputPopup(Sender: TObject; MousePos: TPoint; var Handled: boolean);
begin
enterCount := 0
end;
procedure TchatFrm.inputChange(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch <> NIL then
with ch do
begin
if not Assigned(who) then
exit;
// send typing notify
sbar.panels[0].text := getTranslation('Chars:') + ' ' + intToStr(Length(input.text));
quoteIdx := -1;
{ $IFDEF RNQ_FULL }
who.fProto.InputChangedFor(who, Length(input.text) = 0);
{ $ENDIF }
end;
end;
procedure TchatFrm.Close1Click(Sender: TObject);
begin
closeThisPage
end;
procedure TchatFrm.Viewinfo1Click(Sender: TObject);
var
cnt: TRnQContact;
begin
cnt := thisContact;
if Assigned(cnt) then
cnt.ViewInfo;
end;
function TchatFrm.sawAllhere: boolean;
const
// clearEvents : array[0..4] of byte = (EK_msg, EK_url, EK_auth, EK_authDenied, EK_addedYou);
clearEvents = [EK_msg, EK_url, EK_auth, EK_authDenied, EK_addedYou];
var
c: TRnQContact;
ch: TchatInfo;
// t : byte;
k: Integer;
ev0: Thevent;
found: boolean;
begin
Result := false;
found := false;
ch := thisChat;
if ch = NIL then
exit;
if ch.chatType <> CT_IM then
exit;
c := ch.who;
// for t in clearEvents do
begin
k := -1;
repeat
k := eventQ.getNextEventFor(c, k);
// if (ev0 = nil) then
// Break;
// if ev0.kind in clearEvents then
// begin
// if not chatFrm.moveToTimeOrEnd(c, ev0.when) then
// chatFrm.addEvent(c, ev0.clone);
// k := eventQ.find(t, c);
if (k >= 0) and (k < eventQ.count) then
begin
ev0 := Thevent(eventQ.items[k]);
if ev0.Kind in clearEvents then
begin
found := true;
eventQ.removeAt(k);
if BE_history in behaviour[ev0.Kind].trig then
if not chatFrm.moveToTimeOrEnd(c, ev0.when, false) then
// if fo then
chatFrm.addEvent(c, ev0.clone);
try
// FreeAndNil(ev);
ev0.free;
except
end;
end
// eventQ.Remove(ev0);
else
Inc(k);
end
else
k := -1;
until (k < 0);
end;
{
if eventQ.removeEvent(EK_msg, c)
or eventQ.removeEvent(EK_url, c)
or eventQ.removeEvent(EK_auth, c)
or eventQ.removeEvent(EK_authDenied, c)
or eventQ.removeEvent(EK_addedYou, c) then }
if found then
begin
Result := true;
roasterLib.redraw(c);
saveinboxDelayed := true;
end;
TipRemove(c);
end; // sawAllHere
procedure TchatFrm.FormKeyPress(Sender: TObject; var Key: Char);
var
s: string;
i, l, k: Integer;
ch: TchatInfo;
begin
if Key <> #13 then
enterCount := 0
else
begin
ch := thisChat;
if ch <> NIL then
if ch.chatType = CT_IM then
if ActiveControl = w2sBox then
begin
SBSearchClick(NIL);
exit;
end
else if (ActiveControl = ch.input) then
begin
Inc(enterCount);
if (enterCount = sendOnEnter) then
begin
s := ch.input.text;
l := 2 * pred(enterCount);
k := l;
// i := 1 + ch.input.SelStart;
i := ch.input.SelStart;
while (l > 0) and ((s[i] = #10) or (s[i] = #13)) do
begin
dec(i);
dec(l);
end;
dec(k, l);
// delete(s,1 + ch.input.SelStart-l, l);
Delete(s, 1 + i, k);
ch.input.text := s;
Key := #0;
send;
// Exit;
end;
end;
end;
case Key of
#27:
begin
close;
Key := #0;
end;
#127, // ctrl+bs
#10:
Key := #0;
// else
// Inherited;
end;
end;
procedure TchatFrm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
ch: TchatInfo;
i: Integer;
b: boolean;
// wm : TWMKey;
begin
ch := thisChat;
// MainDlg.RnQmain.fin
// if ActiveControl then
if ch = nil then
exit;
if Shift = [] then
case Key of
VK_APPS:
if Assigned(ch) and (ch.chatType = CT_IM) then
begin
clickedContact := ch.who;
with ch.historyBox.ClientToScreen(ch.historyBox.margin.TopLeft) do
mainDlg.RnQmain.contactMenu.popup(X, Y);
end;
VK_BROWSER_BACK:
begin
pagectrl.SelectNextPage(false);
end;
VK_BROWSER_FORWARD:
begin
pagectrl.SelectNextPage(true);
end;
end
else if (Shift = [ssAlt]) and (ch.chatType = CT_IM) then
case Key of
VK_A:
begin
with autoscrollBtn do
down := not down;
autoscrollBtnClick(self);
end;
VK_P:
prefBtnClick(self);
VK_I:
infoBtnClick(self);
VK_Q:
quote();
VK_H:
begin
with historyBtn do
down := not down;
historyBtnClick(self);
end;
VK_M:
begin
// with smilesBtn do down:=not down;
// smilesBtnClick(self);
hAShowSmilesExecute(self);
end;
VK_BACK:
ch.input.Undo();
VK_S:
begin
send;
Key := 0;
end;
end;
// else
if (not useCtrlNumInstAlt and (Shift = [ssAlt])) or (useCtrlNumInstAlt and (Shift = [ssCtrl])) then
case Key of
byte('1') .. byte('9'):
begin
i := Key - byte('1');
if chats.validIdx(i) then
if pagectrl.activePageIndex <> i then
begin
b := true;
pagectrlChanging(pagectrl, b);
if b then
pagectrl.activePageIndex := i;
pagectrlChange(pagectrl);
Key := 0;
Shift := [];
exit;
end;
end;
end;
if (Shift = [ssAlt]) or (Shift = [ssAlt, ssCtrl]) then
case Key of
VK_LEFT:
pagectrl.SelectNextPage(false);
VK_RIGHT:
pagectrl.SelectNextPage(true);
VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
if ch.chatType = CT_IM then
case Key of
VK_UP:
ch.historyBox.histScrollEvent(-1);
VK_DOWN:
ch.historyBox.histScrollEvent(+1);
VK_PRIOR:
ch.historyBox.histScrollEvent(-5);
VK_NEXT:
ch.historyBox.histScrollEvent(+5);
end;
VK_HOME:
if ch.chatType = CT_IM then
ch.historyBox.histScrollEvent(-ch.historyBox.rsb_position);
VK_END:
if ch.chatType = CT_IM then
begin
// ch.historyBox.setautoscrollForce(TRUE);
// autoscrollBtn.down := True;
ch.setAutoscroll(true);
end;
end
else if Shift = [ssCtrl] then
case Key of
VK_PRIOR:
if ch.chatType = CT_IM then
ch.historyBox.histScrollEvent(-5);
VK_NEXT:
if ch.chatType = CT_IM then
ch.historyBox.histScrollEvent(+5);
VK_RETURN:
if ch.chatType = CT_IM then
if sendOnEnter = 1 then
begin
i := ch.input.SelStart;
ch.input.text := Copy(ch.input.text, 1, i) + CRLF + Copy(ch.input.text, i + 1, Length(ch.input.text) - i);
ch.input.SelStart := i + 2;
ch.input.Perform(EM_SCROLLCARET, 0, 0);
end
else
send;
VK_UP:
if ch.chatType = CT_IM then
ch.historyBox.histScrollLine(-1);
VK_DOWN:
if ch.chatType = CT_IM then
ch.historyBox.histScrollLine(+1);
VK_C:
if ch.chatType = CT_IM then
if ch.input.selLength = 0 then
if Length(ch.historyBox.getSelText) > 0 then
clipboard.asText := ch.historyBox.getSelText;
VK_F6:
pagectrl.SelectNextPage(true);
VK_F4, VK_W:
try
sawAllhere;
closeThisPage;
Key := 0;
// Shift := [];
exit;
except
end;
end;
if (Shift <> []) or (Key <> 13) then
enterCount := 0;
if Assigned(ch) and (ch.chatType = CT_PLUGING) then
begin
SendMessage(ch.ID, WM_KEYDOWN, Key, 0);
{ wm.Msg := WM_KEYDOWN;
wm.CharCode := Key;
wm.KeyData KeyDataToShiftState
TControl(ch.ID).WindowProc(
Perform(WM_KEYDOWN, ) }
end;
inherited;
end; // keydown
procedure TchatFrm.open(focus: boolean = true);
var
bak: Thandle;
ch: TchatInfo;
begin
if chats.count = 0 then
exit;
if not visible then
bak := getForegroundWindow
else
bak := 0;
showForm(self);
if (bak > 0) and not focus then
forceforegroundwindow(bak);
SetWindowPos(handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE); // bring it atop if it is not
ch := thisChat;
if focus then
begin
bringForeground := handle;
if Assigned(ch) then
if ch.chatType = CT_IM then
ch.input.setFocus;
end
else if isVisible then
if Assigned(ch) then
if ch.chatType = CT_IM then
ch.input.setFocus;
end; // open
function TchatFrm.isVisible: boolean;
begin
Result := getForegroundWindow = handle
end;
procedure TchatFrm.quote(qs: String = ''; MakeCarret: boolean = true);
var
i: Integer;
AddToInput: boolean;
oldPos: TPoint;
selected, s, Result, leading: string;
function addquote(s: string): string;
begin
if (Length(leading) > 0) and (leading[1] = '>') then
Result := '>' + s
else
Result := '> ' + s;
end; // addquote
begin
if thisChat = NIL then
exit;
with thisChat do
begin
if Assigned(input) and (input.visible) and input.Enabled then
input.setFocus;
if Length(qs) > 0 then
begin
selected := qs;
AddToInput := true;
end
else
begin
if historyBox.history.count = 0 then // there's nothing to quote for sure
exit;
AddToInput := true;
if quoting.quoteselected then
selected := trim(historyBox.getSelText)
else
selected := '';
if selected = '' then
begin
AddToInput := false;
// save original reply at the beginning of a quoting-cycle
if quoteIdx < 0 then
lastInputText := input.text;
selected := historyBox.getQuoteByIdx(quoteIdx);
end;
end;
Result := '';
while selected > '' do
begin
s := trimright(chop(#10, selected));
if s = '' then
continue;
leading := getLeadingInMsg(s);
if MakeCarret then
s := wraptext(s, 50);
Result := Result + addquote(chop(CRLF, s)) + CRLF;
while s > '' do
Result := Result + addquote(chop(CRLF, s)) + CRLF;
end;
i := quoteIdx;
// Delete(result, length(result)-1, 2);
oldPos := input.caretpos;
if AddToInput then
input.SelText := Result
else
begin
input.text := lastInputText;
input.lines.Add(Result);
if quoting.cursorBelow then
input.SelStart := Length(input.text)
else
input.caretpos := oldPos;
end;
// input.SelText := result;
quoteIdx := i;
end;
end; // quote
procedure TchatFrm.FormActivate(Sender: TObject);
begin
{$IFDEF RNQ_FULL}
if thisChat <> NIL then
thisChat.repaint;
{$ENDIF RNQ_FULL}
end;
procedure TchatFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
updateChatfrmXY;
ClearChatImageCache;
// if searchhistFrm <> nil then
// searchhistFrm.Close;
end; // form close
procedure TchatFrm.selectall1Click(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = NIL then
exit;
with ch.historyBox do
if historyNowCount > 0 then
begin
select(historyNowOffset, history.count - 1);
// clipboard.asText:=getSelText;
repaint;
ch.updateAutoscroll(nil);
end;
end; // select all
procedure TchatFrm.SelectAllExecute(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = nil then
exit;
if (ch.chatType = CT_IM) then
if (ActiveControl = ch.input) then
ch.input.SelectAll
else
selectall1Click(self);
end;
procedure TchatFrm.viewmessageinwindow1Click(Sender: TObject);
begin
if thisChat = NIL then
exit;
with thisChat.historyBox do
if somethingIsSelected then
begin
if (pointedItem.Kind = PK_RQPIC) or (pointedItem.Kind = PK_RQPICEX) then
viewHeventWindow(pointedItem.ev)
else
viewTextWindow(getTranslation('selection'), getSelText, '')
end
else if clickedItem.Kind <> PK_NONE then
viewHeventWindow(clickedItem.ev)
else if (pointedSpace.Kind = PK_ARROWS_UP) or (pointedSpace.Kind = PK_ARROWS_DN) then
viewHeventWindow(pointedSpace.ev);
end; // open
procedure TchatFrm.w2sBoxKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
SBSearchClick(Sender);
Key := #0;
end;
end;
procedure TchatFrm.txt1Click(Sender: TObject);
var
fn: string;
begin
if thisChat = NIL then
exit;
fn := openSavedlg(self, 'Save text as UTF-8 file', false, 'txt');
if fn = '' then
exit;
savefile2(fn, StrToUTF8(thisChat.historyBox.getSelText));
end; // txt
procedure TchatFrm.html1Click(Sender: TObject);
var
fn: string;
begin
if thisChat = NIL then
exit;
fn := openSavedlg(self, '', false, 'html');
if fn = '' then
exit;
savefile2(fn, thisChat.historyBox.getSelHtml2(false));
end; // html
procedure TchatFrm.infoBtnClick(Sender: TObject);
var
cnt: TRnQContact;
begin
cnt := thisContact;
if Assigned(cnt) then
cnt.ViewInfo;
end;
procedure TchatFrm.updateContactStatus;
var
cnt: TRnQContact;
begin
cnt := thisContact;
if cnt = NIL then
begin
sendBtn.ImageName := status2imgName(byte(SC_UNK), false);
exit;
end;
sendBtn.ImageName := rosterImgNameFor(cnt);
sendBtn.Invalidate;
sbar.Invalidate;
if (thisChat.chatType = CT_IM) and not (thisChat.who = nil) then
begin
BuzzBtn.Visible := CAPS_big_Buzz in TICQContact(thisChat.who).capabilitiesBig;
BuzzBtn.Left := RnQFileBtn.Left + RnQFileBtn.Width;
end;
{$IFDEF RNQ_AVATARS}
if not cnt.icon.IsBmp then
with thisChat.avtPic do
if Assigned(swf) then
// Статусы: stam, smile, laugh, mad, sad, cry, offline, busy, love
case cnt.GetStatus of
byte(SC_OCCUPIED) .. byte(SC_AWAY):
swf.TGotoLabel('face', 'busy');
byte(SC_F4C):
swf.TGotoLabel('face', 'smile');
byte(SC_OFFLINE):
swf.TGotoLabel('face', 'offline');
byte(SC_UNK):
swf.TGotoLabel('face', 'stam');
byte(SC_Evil):
swf.TGotoLabel('face', 'mad');
byte(SC_Depression):
swf.TGotoLabel('face', 'sad');
// swf.TGotoFrame('face', 'stam');
else
swf.TGotoFrame('face', 0);
end;
{$ENDIF RNQ_AVATARS}
end; // updateSendBtn
procedure TchatFrm.closePageAt(idx: Integer);
var
old: TtabSheet;
oldCh: TchatInfo;
begin
if (idx < 0) or (idx >= pagectrl.pageCount) then
exit;
{$IFDEF RNQ_FULL}
// rqSmiles.ClearAniParams;
theme.ClearAniParams;
{$ENDIF RNQ_FULL}
oldCh := chats.byIdx(idx);
// with do
begin
if plugBtns.PluginsTB.parent = oldCh.btnPnl then
plugBtns.PluginsTB.parent := pagectrl;
lastContact := oldCh.who;
if oldCh.chatType = CT_PLUGING then
begin
plugins.castEv(PE_CLOSETAB, oldCh.ID);
// chatFrm.RemoveControl(TWinControl(id));
end
else if oldCh.chatType = CT_IM then
begin
{ $IFDEF RNQ_FULL }
// end typing
oldCh.who.fProto.InputChangedFor(oldCh.who, true);
{ $ENDIF }
oldCh.historyBox.newSession := 0;
if oldCh.historyBox.history <> NIL then
begin
// historyBox.history.reset;
oldCh.historyBox.history.free;
oldCh.historyBox.history := NIL;
end;
end;
old := pagectrl.pages[idx];
// with old do
begin
{
while controlCount > 0 do
// FreeAndNil(controls[0]);
controls[0].free;
}
old.PageControl := NIL;
// free;
end;
chats.Delete(idx);
oldCh.free;
// chats.byIdx(idx).Free;
old.free;
end;
if pagectrl.pageCount = 0 then
begin
if docking.Docked2chat then
begin
// docking.Dock2Chat := False;
applyDocking(true);
end;
close
end
else
begin
pagectrl.repaint;
if pagectrl.ActivePage = NIL then
pagectrl.SelectNextPage(true)
else
pagectrlChange(self)
end;
if userTime > 0 then
// savePages;
saveListsDelayed := true;
end; // closePageAt
procedure TchatFrm.closeChatWith(c: TRnQContact);
begin
closePageAt(chats.idxOf(c))
end;
procedure TchatFrm.FormShow(Sender: TObject);
// var
// i:integer;
begin
// theme.getIco2(PIC_MSG, icon);
theme.pic2ico(RQteFormIcon, PIC_MSG, icon);
// icon:=getIco2('msg');
applyFormXY;
lastContact := NIL;
updateContactStatus;
if thisChat <> NIL then
thisChat.repaint();
// toolbar.buttonheight:=panel.Height -18+5;
// toolbar.buttonheight:= 21;
if plugBtns.PluginsTB <> toolbar then
begin
if Assigned(plugBtns.PluginsTB) then
plugBtns.PluginsTB.ButtonHeight := 21;
end;
// i:=getWindowLong(pagectrl.handle, GWL_EXSTYLE);
// setWindowLong(pagectrl.handle, GWL_EXSTYLE, i and (not TCS_OWNERDRAWFIXED) );
// i := GetClassLong(pagectrl.Handle, GCL_STYLE);
// SetClassLong(pagectrl.Handle, GCL_STYLE, i and (not TCS_OWNERDRAWFIXED));
end;
procedure TchatFrm.findBtnClick(Sender: TObject);
begin
{ if not Assigned(searchHistFrm) then
begin
searchHistFrm := TsearchhistFrm.Create(Application);
translateWindow(searchHistFrm);
end;
showForm(searchHistFrm) }
w2sBox.visible := findBtn.down;
directionGrp.visible := findBtn.down;
directionGrp.ItemIndex := 0;
caseChk.visible := findBtn.down;
// reChk.visible := findBtn.down;
SBSearch.visible := findBtn.down;
if thisChat <> NIL then
thisChat.historyBox.w2s := '';
fp.visible := findBtn.down;
// SearchPnl.Visible := findBtn.Down;
if not(historyBtn.down) and (findBtn.down) then
begin
historyBtn.down := true;
historyBtnClick(Sender);
end;
if w2sBox.visible then
ActiveControl := w2sBox
else if thisChat <> NIL then
ActiveControl := thisChat.input;
end;
procedure TchatFrm.findBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
showForm(WF_SEARCH);
end;
procedure TchatFrm.quoteBtnClick(Sender: TObject);
begin
quote
end;
procedure TchatFrm.quoteBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
// quote(clipboard.asText, false);
quote(clipboard.asText, ssCtrl in Shift);
end;
procedure TchatFrm.smilesBtnClick(Sender: TObject);
// var
// ch:Tchatinfo;
begin
// ShowSmileMenu(TRnQSpeedButton(Sender).ClientToScreen(Point(
// TRnQSpeedButton(Sender).Left, TRnQSpeedButton(Sender).Top)));
ShowSmileMenu(toolbar.ClientToScreen(Types.point(TRnQSpeedButton(Sender).Left, TRnQSpeedButton(Sender).Top)));
enterCount := 0;
{ useSmiles:=smilesBtn.down;
ch:=thischat;
if ch=NIL then exit;
inc(ch.historyBox.history.Token);
ch.repaint;
if visible then
ch.input.SetFocus; }
end;
procedure TchatFrm.smilesBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button <> mbRight) then
exit;
ShowSmileMenu(TRnQSpeedButton(Sender).ClientToScreen(Types.point(X, Y)));
enterCount := 0;
end;
procedure TchatFrm.closeAllPages(isAuto: boolean = false);
begin
if isAuto then
PagesEnumStr := Pages2String
else
PagesEnumStr := '';
pagectrl.Hide;
while pagectrl.pageCount > 1 do
if pageIndex = 0 then
closePageAt(1)
else
closePageAt(0);
closePageAt(0);
pagectrl.show;
end; // closeAllPages
procedure TchatFrm.autoscrollBtnClick(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = NIL then
exit;
ch.setAutoscroll(autoscrollBtn.down);
ch.repaint();
if visible then
ch.input.setFocus;
end;
procedure TchatFrm.redrawTab(c: TRnQContact);
var
i: Integer;
R: TRect;
begin
i := chats.idxOf(c);
if (i < 0) or (i >= pagectrl.pageCount) then
exit;
SendMessage(pagectrl.handle, TCM_GETITEMRECT, i, Longint(@R));
R.Right := R.Left + 30;
Inc(R.Top, 1);
dec(R.Bottom, 1);
invalidateRect(pagectrl.handle, @R, true);
end;
procedure TchatFrm.setCaptionFor(c: TRnQContact);
var
i: Integer;
w: Integer;
begin
i := chats.idxOf(c);
if (i >= 0) AND (i < pagectrl.pageCount) then
begin
w := Max(pagectrl.Canvas.TextWidth('_'), 5);
pagectrl.pages[i].caption :=
// additional spaces for icon
// StringOfChar('_',2+theme.getPicSize(RQteDefault, status2imgName(byte(SC_ONLINE)), 16).cx div w);
StringOfChar('_', 2 + statusDrawExt(0, 0, 0, byte(SC_ONLINE)).cx div w) + dupAmperstand(c.displayed);
{$IFDEF RNQ_FULL}
{$IFDEF CHECK_INVIS}
// if c.invisibleState > 0 then
// pageCtrl.pages[i].caption := pageCtrl.pages[i].caption +
// StringOfChar('_',1+theme.getPicSize(status2imgName(SC_ONLINE, true), 5).cx div w);
{$ENDIF}
// if c.typing.bIsTyping then
// pageCtrl.pages[i].caption := pageCtrl.pages[i].caption +
// StringOfChar('_',1+theme.getPicSize(PIC_TYPING, 5).cx div w);
{$ENDIF}
end;
end; // setCaptionFor
procedure TchatFrm.setCaption(idx: Integer);
var
// i:integer;
c: TRnQContact;
R: TRect;
w: Integer;
begin
// i:=chats.idxOf(c);
if not chats.validIdx(idx) then
exit;
w := Max(pagectrl.Canvas.TextWidth('_'), 5);
if chats.byIdx(idx).chatType = CT_IM then
begin
c := chats.byIdx(idx).who;
begin
pagectrl.pages[idx].caption :=
// additional spaces for icon
// StringOfChar('_',2+theme.getPicSize(RQteDefault, status2imgName(byte(SC_ONLINE)), 16).cx div w);
StringOfChar('_', 2 + statusDrawExt(0, 0, 0, byte(SC_ONLINE)).cx div w) + dupAmperstand(c.displayed);
{$IFDEF RNQ_FULL}
{$IFDEF CHECK_INVIS}
// if c.invisibleState > 0 then
// pageCtrl.pages[idx].caption := pageCtrl.pages[idx].caption +
// StringOfChar('_',1+theme.getPicSize(status2imgName(SC_ONLINE, true), 5).cx div w);
{$ENDIF}
// if c.typing.bIsTyping then
// pageCtrl.pages[idx].caption := pageCtrl.pages[idx].caption +
// StringOfChar('_',1+theme.getPicSize(PIC_TYPING, 5).cx div w);
{$ENDIF}
end;
end
else
begin
pagectrl.pages[idx].caption := chats.byIdx(idx).lastInputText + // additional spaces for icon
StringOfChar('_', 2 + theme.getPicSize(RQteDefault, 'plugintab' + IntToStrA(chats.byIdx(idx).ID), 16).cx div w);
SendMessage(pagectrl.handle, TCM_GETITEMRECT, idx, Longint(@R));
// R.right:=R.left+20;
invalidateRect(pagectrl.handle, @R, true);
end;
end; // setCaption
procedure TchatFrm.singleBtnClick(Sender: TObject);
begin
thisChat.single := singleBtn.down
end;
procedure TchatFrm.WndProc(var Message: TMessage);
// var
// ShiftState: TShiftState;
// var
// ti : TTCItem;
begin
case message.msg of
WM_SYSCOMMAND:
updateChatfrmXY;
WM_mousewheel, WM_VSCROLL:
if (Assigned(chats)) and (thisChat <> NIL) and (thisChat.chatType = CT_IM) then
if message.WParam shr 31 > 0 then
thisChat.historyBox.histScrollEvent(+wheelVelocity)
else
thisChat.historyBox.histScrollEvent(-wheelVelocity);
{ WM_VSCROLL:
if (Assigned(chats))and(thisChat <> NIL) and (thisChat.chatType = CT_IM) then
if message.wparam shr 31 > 0 then
thisChat.historyBox.histScrollEvent(+wheelVelocity)
else
thisChat.historyBox.histScrollEvent(-wheelVelocity);
}
// WM_ENTERMENULOOP:
// begin
// thisChat.historyBox.histScrollEvent(+wheelVelocity)
// end;
// WM_EXITMENULOOP:
// begin
// clearMenu(smileMenuExt.Items);
// end;
// 256:
// begin
// end;
WM_KEYDOWN:
if (thisChat <> nil) and (thisChat.chatType = CT_PLUGING) then
begin
TControl(thisChat.ID).WindowProc(Message);
// Perform(WM_KEYDOWN, )
end;
{
with TWMKey(Message) do
begin
ShiftState := KeyDataToShiftState(KeyData);
if (ssCtrl in ShiftState) and (CharCode = VK_F4) then
try
sawAllHere;
closeThisPage;
Exit;
except
end;
end; }
WM_HELP:
begin
exit;
end;
{
TCItem.iImage := GetImageIndex(I);
if SendMessage(Handle, TCM_SETITEM, I,
Longint(@TCItem)) = 0 then
TabControlError(Format(sTabFailSet, [FTabs[I], I]));
end;
TabsChanged;
}
end;
inherited;
end; // WMmouseWheel
procedure TchatFrm.copylink2clpbdClick(Sender: TObject);
begin
// with thisChat.historyBox do
// if pointedItem.kind=PK_LINK then
// clipboard.asText := pointedItem.link.str;
// with thisChat.historyBox.pointedItem do
with thisChat.historyBox.clickedItem do
if Kind = PK_LINK then
clipboard.asText := link.str;
end;
procedure TchatFrm.copy2clpbClick(Sender: TObject);
begin
clipboard.asText := thisChat.historyBox.getSelText
end;
procedure TchatFrm.btnContactsClick(Sender: TObject);
begin
openSendContacts(thisContact)
end;
procedure TchatFrm.chatDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: boolean);
begin
Accept := Source = mainDlg.RnQmain.roster
end;
procedure TchatFrm.chatDragDrop(Sender, Source: TObject; X, Y: Integer);
var
cl: TRnQCList;
begin
if (clickedContact = NIL) or (thisContact = NIL) then
exit;
cl := TRnQCList.Create;
cl.Add(clickedContact);
Proto_Outbox_add(OE_contacts, thisContact, 0, cl);
cl.free;
end;
procedure TchatFrm.addlink2favClick(Sender: TObject);
begin
// with thisChat.historyBox.pointedItem do
with thisChat.historyBox.clickedItem do
if Kind = PK_LINK then
addLinkToFavorites(link.str);
end;
procedure TchatFrm.updateChatfrmXY;
begin
if not visible then
exit;
if windowState <> wsMaximized then
begin
chatfrmXY.Top := Top;
chatfrmXY.Left := Left;
chatfrmXY.height := height;
chatfrmXY.Width := Width;
end;
if windowState <> wsMinimized then
chatfrmXY.maximized := windowState = wsMaximized;
end; // updatechatfrmXY
procedure TchatFrm.historyAllShowChange(ch: TchatInfo; histBtnDown: boolean);
var
olds, news: Integer;
// i : Integer;
oldTime: Tdatetime;
// ch:TchatInfo;
// str : TStream;
begin
// ch:=thisChat;
if ch = NIL then
exit;
with ch.historyBox do
begin
whole := histBtnDown;
autoScroll := autoScrollVal;
if whole then
begin
offset := 0;
with history do
if not loaded then
begin
olds := count;
if olds > 0 then
oldTime := getAt(0).when
else
oldTime := 0;
Clear;
// fromString(loadFile(userPath+historyPath + ch.who.uid));
load(ch.who);
// str := GetStream(userPath+historyPath + ch.who.uid);
// fromSteam(str);
// str.Free;
news := count;
if oldTime > 0 then
begin
// olds := news;
while (news > 0) and (getAt(news - 1).when >= oldTime) do
dec(news);
// dec(news, max(0, olds));
// news:=count-olds;
end;
// with ch.historyBox do
begin
Inc(newSession, news);
Inc(startSel.evIdx, news);
Inc(endSel.evIdx, news);
Inc(topVisible, news)
end;
end
// else
// begin
// go2end;
// end;
end
else
begin
autoScroll := true;
offset := newSession;
if topVisible < offset then
topVisible := offset;
end;
// setAutoScrollForce(autoScroll);
autoScrollVal := autoScroll;
ch.repaintAndUpdateAutoscroll();
updateRSB(false, 0, true);
if self.visible then
if ch = thisChat then
try
ch.input.setFocus;
except
end;
end;
end;
procedure TchatFrm.historyBtnClick(Sender: TObject);
var
// olds,news:integer;
ch: TchatInfo;
begin
ch := thisChat;
if ch = NIL then
exit;
historyAllShowChange(ch, historyBtn.down);
end;
procedure TchatFrm.ShowSearchExecute(Sender: TObject);
begin
if not( { (ActiveControl = MainDlg.RnQmain.roaster) or
(ActiveControl = MainDlg.RnQmain.FilterEdit)) }
childParent(getFocus, mainDlg.RnQmain.handle)) then
begin
findBtn.down := not findBtn.down;
findBtnClick(self);
end;
end;
procedure TchatFrm.ShowSmilesExecute(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = nil then
exit;
if ch.chatType = CT_IM then
{$IFDEF USE_SMILE_MENU}
if Assigned(smilesBtn.PopupMenu) then
with smilesBtn.ClientOrigin do // ClientToScreen(smilesBtn.ClientOrigin) do
smileMenuExt.popup(X, Y)
else
{$ENDIF USE_SMILE_MENU}
ShowSmileMenu(smilesBtn.ClientOrigin);
end;
procedure TchatFrm.ShowStickersExecute(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = nil then
exit;
ShowStickersMenu(ch.who, stickersBtn.ClientOrigin);
end;
procedure TchatFrm.sbarDblClick(Sender: TObject);
var
ch: TchatInfo;
begin
with sbar.ScreenToClient(MousePos) do
case whatStatusPanel(sbar, X) of
2:
begin
if Assigned(TranslitList) then
if TranslitList.count > 0 then
begin
ch := thisChat;
if Assigned(ch) and (ch.chatType = CT_IM) and Assigned(ch.who) then
begin
ch.who.SendTransl := not ch.who.SendTransl;
sbar.Invalidate;
end;
end;
end;
end;
end;
procedure TchatFrm.sbarDrawPanel(StatusBar: TStatusBar; panel: TStatusPanel; const Rect: TRect);
var
Details: TThemedElementDetails;
ch: TchatInfo;
// s : String;
Arect: TRect;
agR, r2: TGPRect;
begin
// statusbar.canvas.Brush.Color := clBtnFace
StatusBar.Canvas.Font.Assign(Screen.MenuFont);
// statusbar.canvas.FillRect(rect);
Arect := Rect;
Arect.Top := 0;
// dec(Arect.Right);
// inc(Arect.Left);
Inc(Arect.Right);
dec(Arect.Left);
Inc(Arect.Bottom);
case panel.index of
1, 2, 3:
if StyleServices.Enabled then
begin
// Details := StyleServices.GetElementDetails(tsGripperPane);
// Details := StyleServices.GetElementDetails(tsStatusDontCare);
// Details := StyleServices.GetElementDetails(tsPane);
// Details := StyleServices.GetElementDetails(tsPane);
Details := StyleServices.GetElementDetails(tsStatusRoot);
// StyleServices.DrawElement();
// StyleServices.DrawElement(statusbar.canvas.Handle, Details, Rect, nil);
StyleServices.DrawElement(StatusBar.Canvas.handle, Details, Arect, nil);
StyleServices.DrawParentBackground(StatusBar.handle, StatusBar.Canvas.handle, @Details, false);
end
else
StatusBar.Canvas.FillRect(Rect);
end;
ch := thisChat;
agR.X := Rect.Left;
agR.Y := Rect.Top + 1;
agR.Width := Rect.Right - Rect.Left;
agR.height := Rect.Bottom - Rect.Top;
case panel.index of
1:
begin
if Account.outbox.stFor(thisContact) then
theme.drawPic(StatusBar.Canvas.handle, agR, PIC_OUTBOX)
else
theme.drawPic(StatusBar.Canvas.handle, agR, PIC_OUTBOX_EMPTY, false);
end;
2:
if Assigned(ch) then
begin
// s := 'TRLT';
SetBKMode(StatusBar.Canvas.handle, TRANSPARENT);
if (ch.chatType = CT_IM) and Assigned(TranslitList) and (TranslitList.count > 0) then
begin
if ch.who.SendTransl then // and Assigned(TranslitList) and (TranslitList.Count > 0) then
begin
StatusBar.Canvas.Font.Style := [fsBold];
// statusbar.canvas.TextRect(Rect, Rect.Left , Rect.Top, 'TRLT')
// statusbar.canvas.TextRect(Rect, Rect.Left + (36 - statusbar.canvas.TextWidth(s)) div 2 , Rect.Top+2, 'TRLT')
// statusbar.canvas.TextRect(Rect, s)
end
else
begin
StatusBar.Canvas.Font.Color := clGrayText;
// statusbar.canvas.Font.Color := clInactiveCaptionText;
// statusbar.canvas.TextRect(Rect, Rect.Left , Rect.Top, 'TRLT');
// statusbar.canvas.TextRect(Rect, Rect.Left + (36 - statusbar.canvas.TextWidth(s)) div 2 , Rect.Top+2, 'TRLT')
end;
DrawText(StatusBar.Canvas.handle, 'TRLT', 4, Arect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;
end;
3:
if Assigned(ch) then
if ch.chatType = CT_IM then
if ch.who.fProto.ProtoID = ICQProtoID then
if TICQSession(ch.who.fProto).UseCryptMsg and
(TICQContact(ch.who).crypt.supportCryptMsg or TICQSession(ch.who.fProto).useMsgType2for(TICQContact(ch.who))) then
begin
if TICQContact(ch.who).crypt.supportCryptMsg then
// theme.drawPic(statusbar.canvas.Handle, rect.left,rect.top+1, PIC_KEY);
theme.drawPic(StatusBar.Canvas.handle, agR, PIC_KEY)
else if CAPS_big_QIP_Secure in TICQContact(ch.who).capabilitiesBig then
begin
if TICQContact(ch.who).crypt.qippwd > 0 then
with theme.getPicSize(RQteDefault, PIC_CLI_QIP, 16) do
begin
r2 := agR;
Inc(r2.X, cx + 2);
dec(r2.Width, cx + 3);
agR.Width := cx + 3;
theme.drawPic(StatusBar.Canvas.handle, r2, PIC_KEY);
// dec(agR.Width, cx+2);
end;
theme.drawPic(StatusBar.Canvas.handle, agR, PIC_CLI_QIP)
end;
end;
end;
end;
procedure TchatFrm.setStatusbar(s: string);
begin
with sbar.panels do
if isUploading then
Items[Count - 1].text := GetTranslation('Uploading file') + ': ' + IntToStr(Trunc(uploadedSize / uploadSize * 100)) + '%'
else
Items[Count - 1].text := s
end;
procedure TchatFrm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
enterCount := 0;
end;
procedure TchatFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
// var
// tabindex : Integer;
begin
hintMode := HM_comm;
{ tabindex := pagectrl.IndexOfTabAt(X, Y);
if tabindex < 0 then
begin
FreeAndNil(hintwnd);
hintTab := -1;
exit;
end;
}
end;
procedure TchatFrm.sbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// var
// ch: TchatInfo;
begin
case whatStatusPanel(sbar, X) of
1:
begin
if not Assigned(outboxFrm) then
begin
outboxFrm := ToutboxFrm.Create(Application);
translateWindow(outboxFrm);
end;
outboxFrm.open(thisContact)
end;
{ 2: begin
if Assigned(TranslitList) then
if TranslitList.Count > 0 then
begin
ch := thisChat;
if Assigned(ch) and (ch.chatType = CT_IM) and Assigned(ch.who) then
begin
ch.who.SendTransl := not ch.who.SendTransl;
sbar.Invalidate;
end;
end;
end;
}
{ $IFDEF USE_SECUREIM }
3:
begin
// if (Button = mbRight)and Assigned(EncryptMenyExt) then
if Assigned(EncryptMenyExt) then
with sbar.ClientToScreen(Types.point(X, Y)) do
EncryptMenyExt.popup(X, Y);
end;
{ $ENDIF USE_SECUREIM }
end;
end;
function TchatFrm.moveToTimeOrEnd(c: TRnQContact; time: Tdatetime; NeedOpen: boolean = true): boolean;
var
ch: TchatInfo;
ev: Thevent;
// i: integer;
begin
Result := false;
ch := chats.byContact(c);
if ch = NIL then
exit;
if ch.historyBox.history.count = 0 then
// result := True
else
begin
with ch.historyBox do
begin
// i := topVisible;
go2end(true);
ev := history.getAt(topVisible);
end;
if (ev = NIL) or (ev.when > time) then
Result := moveToTime(c, time, NeedOpen);
if not Result then
ev := ch.historyBox.history.getAt(ch.historyBox.history.count - 1);
if (ev <> NIL) then
Result := ev.when >= time
end;
end; // moveToTimeOrEnd
function TchatFrm.moveToTime(c: TRnQContact; time: Tdatetime; NeedOpen: boolean = true): boolean;
var
ch: TchatInfo;
h: Thistory;
i: Integer;
function search(ofs: Integer): Integer;
begin
Result := h.count - 1;
// while result >= 0 do
while Result >= ofs do
if h.getAt(Result).when <= time then
break
else
dec(Result);
if Result < ofs then
Result := -1;
if Result >= ofs then
if h.getAt(Result).when <> time then
Result := -1;
end; // search
begin
Result := false;
ch := chats.byContact(c);
if ch = NIL then
exit;
h := ch.historyBox.history;
i := search(ch.historyBox.offset);
if NeedOpen and (i < 0) and not ch.historyBox.whole then
begin
if ch = thisChat then
historyBtn.down := true;
historyAllShowChange(ch, true);
// historyBtnClick(self);
i := search(ch.historyBox.offset);
if i < 0 then
begin
if ch = thisChat then
historyBtn.down := false;
historyAllShowChange(ch, false);
// historyBtnClick(self);
end;
end;
if i >= 0 then
with ch.historyBox do
begin
Result := true;
updateRSB(true, i, true);
topVisible := offset + rsb_position;
topOfs := 0;
end;
ch.historyBox.repaint;
ch.updateAutoscroll(nil);
end; // moveToTime
procedure TchatFrm.Sendwhenimvisibletohimher1Click(Sender: TObject);
begin
send(IF_sendWhenImVisible)
end;
procedure TchatFrm.Sendmultiple1Click(Sender: TObject);
var
wnd: TselectCntsFrm;
msg: string;
begin
// msg:=grabThisText;
msg := thisChat.input.text;
if trim(msg) = '' then
begin
msgDlg('Can''t send an empty message', true, mtWarning);
exit;
end;
wnd := TselectCntsFrm.doAll(mainDlg.RnQmain, 'Send multiple', 'Send message', Account.AccProto,
Account.AccProto.readList(LT_ROSTER).clone.Add(notInList), sendMessageAction, [sco_multi, sco_groups, sco_predefined], @wnd);
wnd.toggle(thisContact);
// theme.getIco2(PIC_MSG, wnd.icon);
theme.pic2ico(RQteFormIcon, PIC_MSG, wnd.icon);
// wnd.extra:=Tincapsulate.aString(msg);
inputChange(self);
end;
procedure TchatFrm.sendMessageAction(Sender: TObject);
var
wnd: TselectCntsFrm;
cl: TRnQCList;
msg: string;
begin
msg := grabThisText;
wnd := (Sender as TControl).parent as TselectCntsFrm;
// msg:=(wnd.extra as Tincapsulate).str;
cl := wnd.selectedList;
wnd.extra.free;
wnd.close;
with cl do
begin
resetEnumeration;
while hasMore do
Proto_Outbox_add(OE_msg, getNext, IF_multiple, msg);
end;
cl.free;
end; // sendmessage action
procedure TchatFrm.del1Click(Sender: TObject);
var
st, en: Integer;
begin
with thisChat.historyBox do
begin
if not wholeEventsAreSelected then
exit;
st := startSel.evIdx;
en := endSel.evIdx;
if st > en then
swap4(st, en);
// chatFrm.visible:=FALSE;
visible := false;
// history.deleteFromTo(userPath+historyPath + thisContact.uid, st,en);
history.deleteFromTo(thisContact.uid, st, en);
visible := true;
// chatFrm.visible:=TRUE;
deselect();
thisChat.repaintAndUpdateAutoscroll();
end;
end;
procedure TchatFrm.lsbEnter;
begin
if not popupLSB then
exit;
with thisChat.lsb do
if not entering then
begin
if position = 0 then
hideScrollTimer := 10
end
else
begin
hideScrollTimer := 0;
Width := maximizedScroll;
end;
end;
procedure TchatFrm.Closeall1Click(Sender: TObject);
begin
closeAllPages
end;
procedure TchatFrm.Closeallbutthisone1Click(Sender: TObject);
var
i, sel: Integer;
begin
try
pagectrl.Hide;
sel := pageIndex;
for i := chats.count - 1 downto 0 do
if i <> sel then
closePageAt(i);
finally
pagectrl.show;
end;
end;
procedure TchatFrm.CloseallOFFLINEs1Click(Sender: TObject);
var
i: Integer;
c: TRnQContact;
begin
c := thisContact;
try
pagectrl.Hide;
for i := chats.count - 1 downto 0 do
if chats.byIdx(i).chatType = CT_IM then
if chats.byIdx(i).who.isOffline then
closePageAt(i);
finally
pagectrl.show;
select(c);
end;
end;
function TchatFrm.grabThisText: string;
begin
Result := thisChat.input.text;
thisChat.input.text := '';
// update char counter
inputChange(self);
end; // grabThisText
procedure TchatFrm.send;
var
s, s1: string;
Max: Integer;
flag: Integer;
ch: TchatInfo;
begin
enterCount := 0;
flag := 0;
// if SimplMsgBtn.Down then
// flag := IF_Simple;
ch := thisChat;
if (ch = nil) or (ch.who = nil) THEN
exit;
Max := ch.who.fProto.maxCharsFor(ch.who);
if Length(ch.input.text) > Max then
if MessageDlg(getTranslation('Your message is too long. Max %d characters.\n\n Split the message?',
[Max]), mtInformation, [mbYes, mbNo], 0) = mrYes then
begin
s := grabThisText;
repeat
s1 := Copy(s, 1, Max - 1);
Delete(s, 1, Max - 1);
send(flag, s1);
until Length(s) < Max;
send(flag, s);
exit;
end
else
else
begin
s := grabThisText;
if trim(s) = '' then
begin
if closeChatOnSend then
close
end
else
send(flag, s)
end;
end; // send
procedure TchatFrm.send(flags_: Integer; msg: string = '');
begin
if (thisChat = NIL) or not sendBtn.Enabled then
exit;
if msg = '' then
msg := grabThisText;
if trim(msg) = '' then
begin
msgDlg('Can''t send an empty message', true, mtWarning);
exit;
end;
sawAllhere;
Proto_Outbox_add(OE_msg, thisChat.who, flags_, msg);
thisChat.input.setFocus;
if thisChat.single then
begin
if ClosePageOnSingle then
closeThisPage
else
close;
end;
end; // send
procedure TchatFrm.select(c: TRnQContact);
var
i: Integer;
begin
if c = NIL then
exit;
i := chats.idxOf(c);
if i >= 0 then
setTab(i);
end; // select
procedure TchatFrm.flash;
var
rec: FLASHWINFO;
begin
// if doFlashChat then
begin
rec.cbSize := sizeOf(rec);
rec.hwnd := handle;
rec.dwFlags := FLASHW_CAPTION OR FLASHW_TRAY OR FLASHW_TIMERNOFG;
rec.dwTimeout := 0;
rec.uCount := dword(-1);
flashWindowEx(rec);
end;
end; // flash
procedure TchatFrm.shake;
const
MAXDELTA = 8;
SHAKETIMES = 150;
var
Task: ITask;
oRect, wRect: TRect;
wHandle: HWND;
begin
wHandle := chatFrm.handle;
GetWindowRect(wHandle, wRect);
oRect := wRect;
Randomize;
Task := TTask.Create(procedure()
var
cnt: Integer;
begin
for cnt := 0 to SHAKETIMES do
begin
wRect := oRect;
Types.OffsetRect(wRect, Round(Random(2 * MAXDELTA) - MAXDELTA), 0);
MoveWindow(wHandle, wRect.Left, wRect.Top, wRect.Right - wRect.Left, wRect.Bottom - wRect.Top, True);
Sleep(10);
end;
MoveWindow(wHandle, oRect.Left, oRect.Top, oRect.Right - oRect.Left, oRect.Bottom - oRect.Top, True);
end, TThreadPool.Default);
Task.Start;
end;
procedure TchatFrm.chatsendmenuopen1Click(Sender: TObject);
var
i: Integer;
s: string;
begin
if (thisChat = NIL) or not sendBtn.Enabled then
exit;
s := grabThisText;
if trim(s) = '' then
begin
msgDlg('Can''t send an empty message', true, mtWarning);
exit;
end;
for i := 0 to chats.count - 1 do
if chats.byIdx(i).chatType = CT_IM then
Proto_Outbox_add(OE_msg, chats.byIdx(i).who, IF_multiple, s);
thisChat.input.setFocus;
end;
procedure TchatFrm.chatcloseignore1Click(Sender: TObject);
begin
sawAllhere;
addToIgnoreList(thisContact);
if MessageDlg(getTranslation('Do you want to remove %s from your contact list?', [thisChat.who.displayed]), mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
removeFromRoster(thisContact);
closeThisPage;
end;
function TchatFrm.Pages2String: RawByteString;
var
// cl:TRnQCList;
i: Integer;
begin
if (userTime < 0) and (chats.count = 0) then
Result := PagesEnumStr
else
begin
// cl:=TRnQCList.create;
Result := '';
for i := 0 to chats.count - 1 do
if chats.byIdx(i).chatType = CT_IM then
begin
// cl.add(chats.byIdx(i).who);
Result := Result + StrToUTF8(chats.byIdx(i).who.uid) + CRLF;
end;
// result := cl.toString;
// cl.free;
end;
end;
procedure TchatFrm.savePicMnuClick(Sender: TObject);
var
pic: AnsiString;
p: string;
i, k: Integer;
RnQPicStream // , RnQPicStream2
: TMemoryStream;
// fmt : TGUID;
begin
with thisChat.historyBox do
// if pointedItem.kind=PK_RQPICEX then
if clickedItem.Kind = PK_RQPICEX then
begin
pic := clickedItem.ev.getBodyBin;
i := Pos(RnQImageExTag, pic);
k := PosEx(RnQImageExUnTag, pic, i + 12);
if (i > 0) and (k > 5) then
begin
pic := Base64DecodeString(Copy(pic, i + 12, k - i - 12));
// pic := '';
RnQPicStream := TMemoryStream.Create;
RnQPicStream.Write(pic[1], Length(pic));
pic := '';
p := PAFormat[DetectFileFormatStream(RnQPicStream)];
Delete(p, 1, 1);
p := openSavedlg(self, '', false, p);
if p > '' then
RnQPicStream.SaveToFile(p);
RnQPicStream.free;
end
end
else if clickedItem.Kind = PK_RQPIC then
begin
pic := clickedItem.ev.getBodyBin;
i := Pos(RnQImageTag, pic);
k := PosEx(RnQImageUnTag, pic, i + 10);
if (i > 0) and (k > 5) then
begin
p := openSavedlg(self, '', false, 'wbmp');
if p > '' then
begin
RnQPicStream := TMemoryStream.Create;
RnQPicStream.Write(pic[i + 10], k - i - 10);
RnQPicStream.SaveToFile(p);
RnQPicStream.free;
end;
end
end;
end;
procedure TchatFrm.loadPages(const s: RawByteString);
var
i: Integer;
s1: RawByteString;
ofs: Integer;
len: Integer;
begin
ofs := 1;
// i := 1;
len := Length(s);
while ofs < len do
begin
i := PosEx(AnsiString(#10), s, ofs);
if (i > 1) and (s[i - 1] = #13) then
dec(i);
if i = 0 then
i := len + 1;
s1 := Copy(s, ofs, i - ofs);
try
openOn(contactsDB.Add(Account.AccProto, UTF8ToStr(s1)), true, false);
except
// result:=FALSE
end;
if s[i] = #13 then
Inc(i);
// system.delete(s,1,i);
ofs := i + 1;
end;
// cl.fromString(Account.AccProto, s, contactsDB);
open(true);
end; // loadPages
procedure TchatFrm.closeBtnClick(Sender: TObject);
begin
sawAllhere;
closeThisPage
end;
procedure TchatFrm.prefBtnClick(Sender: TObject);
// var
// i : Byte;
begin
showForm(WF_PREF, 'Chat', vmShort);
{ for i := 0 to length(prefPages)-1 do
if prefPages[i].Cptn = 'Chat' then break;
prefFrm.SetViewMode(vmShort);
prefFrm.pagesBox.ItemIndex:=i;
prefFrm.pagesBoxClick(NIL); }
end;
procedure TchatFrm.prefBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
showForm(WF_PREF, 'Plugins', vmShort);
end;
{$IFDEF USE_SMILE_MENU}
procedure TchatFrm.smilesMenuPopup(Sender: TObject);
// var
// r : TRect;
begin
if smile_theme_token <> theme.token then
begin
addSmilesToMenu(self, smileMenuExt.items, addSmileAction);
smile_theme_token := theme.token;
end;
// if GetWindowRect(smileMenuExt.WindowHandle, r) then
// GPFillGradient(GetWindowDC(smileMenuExt.WindowHandle), r, theme.GetAColor('menu.fade1', clMenuBar),
// theme.GetAColor('menu.fade2', clMenu));
end;
procedure TchatFrm.smilesMenuClose(Sender: TObject);
begin
// smileMenuExt.Items.Clear;
theme.ClearAniMNUParams;
/// ...
end;
{$ENDIF USE_SMILE_MENU}
procedure TchatFrm.addSmileAction(Sender: TObject);
begin
thisChat.input.SelText := TRQmenuitem(Sender).ImageName;
end;
procedure TchatFrm.popupHistmenu(X, Y: Integer);
var
msg: tagMSG;
begin
chatFrm.histmenu.popup(X, Y);
menuWasCancelled := not PeekMessage(msg, PopupList.Window, WM_COMMAND, WM_COMMAND, PM_NOREMOVE);
end;
procedure TchatFrm.histmenuPopup(Sender: TObject);
begin
chatshowlsb1.checked := showLSB;
chatpopuplsb1.visible := showLSB;
chatpopuplsb1.checked := popupLSB;
end;
procedure TchatFrm.chatshowlsb1Click(Sender: TObject);
begin
setLeftSB(not showLSB)
end;
procedure TchatFrm.setLeftSB(visible: boolean);
var
ch: TchatInfo;
begin
showLSB := visible;
ch := thisChat;
if (ch <> NIL) and (ch.lsb <> NIL) then
ch.lsb.visible := showLSB;
end;
procedure TchatFrm.chathide1Click(Sender: TObject);
begin
setLeftSB(false)
end;
procedure TchatFrm.chatpopuplsb1Click(Sender: TObject);
begin
popupLSB := not popupLSB;
updateGraphics;
end;
procedure TchatFrm.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: boolean);
var
p: TPoint;
ch: TchatInfo;
begin
ch := thisChat;
if Assigned(ch) then
with ch do
if chatType = CT_IM then
begin
p := input.ScreenToClient(MousePos);
// if Assigned(inputPnl) then
if (p.X > 0) and (p.Y > 0) and (p.X < input.Width) and (p.Y < input.height) and (input.lines.count > 1) then
exit;
if Assigned(CLPanel) and docking.Docked2chat then
begin
p := CLPanel.ScreenToClient(MousePos);
if (p.X > 0) and (p.Y > 0) and (p.X < CLPanel.Width) and (p.Y < CLPanel.height)
// and (input.Lines.Count > 1)
then
exit;
end;
if GetKeyState(VK_CONTROL) and $8000 > 0 then
historyBox.histScrollLine(-wheelVelocity)
else
historyBox.histScrollEvent(-wheelVelocity);
Handled := true;
end;
end;
procedure TchatFrm.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: boolean);
var
p: TPoint;
ch: TchatInfo;
begin
ch := thisChat;
if Assigned(ch) then
with ch do
if chatType = CT_IM then
begin
p := input.ScreenToClient(MousePos);
if (p.X > 0) and (p.Y > 0) and (p.X < input.Width) and (p.Y < input.height) and (input.lines.count > 1) then
exit;
if Assigned(CLPanel) and docking.Docked2chat then
begin
p := CLPanel.ScreenToClient(MousePos);
if (p.X > 0) and (p.Y > 0) and (p.X < CLPanel.Width) and (p.Y < CLPanel.height)
// and (input.Lines.Count > 1)
then
exit;
end;
if GetKeyState(VK_CONTROL) and $8000 > 0 then
historyBox.histScrollLine(+wheelVelocity)
else
historyBox.histScrollEvent(+wheelVelocity);
Handled := true;
end;
end;
procedure TchatFrm.onHistoryRepaint(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if Assigned(ch) then
if ch.chatType = CT_IM then
begin
autoscrollBtn.down := ch.historyBox.autoScrollVal;
ch.historyBox.updateRSB(false);
ch.updateLSB;
end;
end; // onHistoryRepaint
procedure TchatFrm.addcontactAction(Sender: TObject);
var
cnt: TRnQContact;
begin
cnt := Account.AccProto.getContact(selectedUIN);
if Assigned(cnt) then
addToRoster(cnt, (Sender as TMenuItem).tag, cnt.CntIsLocal)
end;
procedure TchatFrm.pagectrl00MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
begin
clickedContact := thisContact;
if clickedContact <> NIL then
with MousePos do
mainDlg.RnQmain.contactMenu.popup(X, Y)
end
end;
procedure TchatFrm.AvtsplitterMoving(Sender: TObject; var NewSize: Integer; var Accept: boolean);
begin
Accept := NewSize > 0;
end;
procedure TchatFrm.AvtSplitterMoved(Sender: TObject);
// var
// ch : TchatInfo;
begin
with thisChat do
if Assigned(avtPic.AvtPBox) then
if avtsplitr.Left > avtPic.AvtPBox.Left then
avtsplitr.Left := avtPic.AvtPBox.Left - 1;
end;
var
// backup the values of autoscroll in the current chat
bakAutoScroll: boolean;
procedure TchatFrm.splitterMoving(Sender: TObject; var NewSize: Integer; var Accept: boolean);
begin
bakAutoScroll := thisChat.historyBox.autoScrollVal
end;
procedure TchatFrm.stickersBtnClick(Sender: TObject);
var
ch: TchatInfo;
begin
ch := thisChat;
if ch = nil then
exit;
ShowStickersMenu(thisChat.who, toolbar.ClientToScreen(Types.point(TRnQSpeedButton(Sender).Left, TRnQSpeedButton(Sender).Top)));
enterCount := 0;
end;
procedure TchatFrm.SplitterMoved(Sender: TObject);
begin
with thisChat do
begin
// historyBox.autoScrollVal :=bakAutoScroll;
if Assigned(inputPnl) then
splitY := inputPnl.height
else
splitY := input.height
end;
FormResize(self);
end; // splitterMoved
pr