You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
RnQ/RnQ/CLBox.pas

1691 lines
53 KiB
Plaintext

{
This file is part of R&Q.
Under same license
}
unit CLBox;
{$I RnQConfig.inc}
interface
uses
Winapi.Windows, Winapi.Messages, Vcl.Menus, System.SysUtils, System.Classes, System.Types, System.StrUtils, System.Variants, System.Rtti,
Generics.Collections, Vcl.Controls, Vcl.Graphics, Vcl.Forms,
Sciter, SciterApi, RDGlobal, ICQCommon, ICQSession, ICQContacts, ICQConsts, Protocols_all, Nodes, globalLib, roasterLib, groupsLib,
RnQTrayLib, RnQTips, aboutDlg, BaseWindow;
{$I PubRTTI.inc}
type
TStatus = record
code: Byte;
name, caption, img: String;
end;
TThemeItem = record
index: Integer;
title: String;
current: Boolean;
end;
TCLSettings = record
blinkEnabled, blinkWithStatus, onlineOnly, helpExists,
showGroups, showEmptyGroups, combinedGroups, showHints, indentRoster, autosize, autosizeFull, autosizeUp, alwaysOnTop,
collapseGroups, avatarInHint, moreStatuses, showStatusMsgMenu, noBorderShadow: Boolean;
barPos, filterPos, sortBy, blinkTime: Integer;
mainCSS: String;
end;
{$I NoRTTI.inc}
// TNativeClass = class(TSciterClassInfo)
// public
// constructor Create; override;
// destructor Destroy; override;
// end;
TContactList = class(TBaseWindow)
public
// constructor Create;
// destructor Destroy; override;
procedure Init;
procedure ApplyTheme;
procedure InitSettings;
procedure InitThemeList;
procedure InitMenus;
procedure UpdateMenus;
procedure OpenMainMenu;
procedure OpenMainMenuDelayed;
procedure OpenStatusMenu;
procedure OpenStatusMenuDelayed;
procedure OpenContextMenu;
// procedure OpenContactMenu(const UID: TUID);
procedure OpenAddContact;
function OpenLoginDialog: Boolean;
procedure Clear;
procedure FinishBuild;
procedure InsertNode(Node: TNode);
procedure RemoveNode(Node: TNode);
procedure EditNode(Node: TNode; Reason: TGroupAction = GA_NONE);
procedure SetGroupState(Node: TNode; Expand: Boolean);
procedure UpdateCaption;
procedure UpdateStatusGlyphs;
procedure UpdateStatusImage(const Pic: TPicName);
procedure UpdateVisibilityImage;
procedure UpdateAdditionalImage;
procedure UpdateContact(Contact: TICQContact);
procedure UpdateGroup(Divisor: TDivisor; Group: TGroup); overload;
procedure UpdateGroup(Group: TGroup); overload;
procedure UpdateContactCount;
// function Focused: HELEMENT;
// function IsFilterFocused: Boolean;
// function IsMenuFocused: Boolean;
function GetContacts(Divisor: TDivisor): TArray;
function GetCurrentContact: TICQContact;
procedure FocusFilter;
procedure FocusNode(Node: TNode);
procedure SetProgress(Progress: Double);
procedure SetBorder(HasBorder: Boolean);
procedure ShowHint;
procedure Show;
procedure Hide;
procedure Close;
procedure ToggleVisible;
procedure ToggleFilter;
procedure OnTrayEvent(Sender: TObject; TrayEvent: TTrayEvent);
function EnterPassword(Title: String; MaxLength: Integer): String;
procedure SavePositionForCurrentMonitorCount;
end;
procedure DivisorToTitle(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleOnlineOnly(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleFilter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GroupStateChanged(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure BarButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GoOnline(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure RenameGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure RenameContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure RemoveGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure DeleteCurrentGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SetGroupOrder(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SetClicked(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SetStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleVisibility(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure Lock(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure Unlock(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ViewInfoAbout(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenChatWith(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ReloadLang(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GetCL(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ReloadTheme(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ReloadThemeList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenContactThemes(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SelectTheme(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SelectSmiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SelectEmojis(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SelectSounds(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenMyInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenMyWebProfile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenHelpSite(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenHelpLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ShowAndActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure Toggle(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure Quit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure DeleteEmptyGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleShowGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleShowEmptyGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ToggleStatusSeparation(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddGroupToServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure RemoveCurrentGroupFromServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure MoveAllFromCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OpenChatWithCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SendMailToCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure HasEmail(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GetSpamContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddCurrentContactToServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure IsCurrentInRoster(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure IsInRoster(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentRequestXStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentRequestAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentGrantAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentRequestAvatar(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentViewInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure MoveCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure RemoveCurrentContactFromServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure DeleteCurrentContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure DeleteCurrentContactHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure DeleteCurrentContactAndHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentIsInQuietList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddCurrentToQuietList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure CurrentIsInIgnoreList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure AddCurrentToIgnoreList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GetCurrentUIN2Show(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure IsGroupLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GetGroupName(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure GetContactGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure ContactNeedsAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure IsContactLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl
procedure AddContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SearchContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure SavePassword(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure HasBorder(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure FlashChatWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OnCLShow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OnCLHide(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OnCLActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OnCLMouseEnter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
procedure OnCLMouseLeave(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
MonPositions: TDictionary;
implementation
uses
SciterLib, iniLib, utilLib, themesLib, pluginLib, events, history,
RDUtils, RQUtil, RDFileUtil, RQThemes, RnQPics, RnQLangs, RnQSysUtils, RnQ_Avatars, RnQGraphics32, RnQStrings, RnQDialogs,
RnQdbDlg, RQlog, RnQGlobal, RnQMacros, StatusForm, usersDlg, mainDlg, outboxDlg;
//function NativeMethodHandler(vm: HVM; self: tiscript_value; tag: Pointer): tiscript_value; cdecl;
//var
// pForm: TForm;
// pInfo: ISciterMethodInfo;
//begin
// pForm := NI.get_instance_data(self);
// pInfo := ISciterMethodInfo(tag);
//
// if pInfo.Name = 'this' then
// begin
// // pForm := TForm.Create(Application) is dangerous because of
// // finalizer call followed by Application destructor call.
// // The form will be freed twice.
// pForm := TForm.CreateParented(GetDesktopWindow);
//
// pForm.Caption := 'Sciter';
// pForm.ClientWidth := 400;
// pForm.ClientHeight := 200;
// pForm.Position := poScreenCenter;
// NI.set_instance_data(self, pForm);
// end
//
// else if pInfo.Name = 'Show' then
// begin
// if pForm <> nil then
// begin
// pForm.Show;
// pForm.BringToFront();
// end;
// end
//
// else if pInfo.Name = 'Close' then
// begin
// pForm.Close;
// pForm.Free;
// NI.set_instance_data(self, nil);
// end;
//
// Result := Self;
//end;
//
//procedure NativeFinalizerHandler(vm: HVM; this: tiscript_value); cdecl;
//var
// pForm: TForm;
//begin
// pForm := TObject(NI.get_instance_data(this)) as TForm;
// if pForm <> nil then
// begin
// pForm.Free;
// NI.set_instance_data(this, nil);
// end;
//end;
//
//constructor TNativeClass.Create;
//var
// pInfo: ISciterMethodInfo;
//begin
// inherited;
// TypeName := 'NativeClass';
//
// Self.MethodHandler := NativeMethodHandler;
// Self.FinalizerHandler := NativeFinalizerHandler;
//
// pInfo := TSciterMethodInfo.Create;
// pInfo.Name := 'this';
// Self.Methods.Add(pInfo);
//
// pInfo := TSciterMethodInfo.Create;
// pInfo.Name := 'Show';
// Self.Methods.Add(pInfo);
//
// pInfo := TSciterMethodInfo.Create;
// pInfo.Name := 'Close';
// Self.Methods.Add(pInfo);
//end;
//
//destructor TNativeClass.Destroy;
//begin
// inherited;
//end;
procedure TContactList.SavePositionForCurrentMonitorCount;
var
Size: TFormPos;
Rect: TRect;
begin
Rect := GetBounds;
Size := TFormPos.Create;
Size.Top := Rect.Top;
Size.Left := Rect.Left;
MonPositions.AddOrSetValue(LastMonCnt, Size);
Size.Free;
end;
procedure TContactList.ShowHint;
begin
Call('showHintForCurrent');
end;
procedure TContactList.Show;
begin
Call('show');
end;
procedure TContactList.Hide;
begin
Call('hide');
end;
procedure TContactList.Close;
begin
Call('tryToQuit');
end;
procedure TContactList.SetBorder(HasBorder: Boolean);
begin
Call('setBorder', [HasBorder]);
end;
procedure TContactList.ToggleVisible;
begin
if Visible then
Hide
else
Show;
Application.BringToFront;
ForceForegroundWindow(Window);
end;
procedure TContactList.ToggleFilter;
begin
if FilterPos < 2 then
FilterPos := 2
else if FilterBarOnTop then
FilterPos := 0
else
FilterPos := 1;
InitSettings;
FocusFilter;
end;
procedure TContactList.UpdateCaption;
var
MyInf: TICQContact;
Caption: String;
begin
MyInf := nil;
if Assigned(Account.AccProto) then
MyInf := Account.AccProto.GetMyInfo;
if Assigned(MyInf) then
with MyInf do
Caption := template(rosterTitle, ['%displayed%', Displayed, '%nick%', Nick, '%uin%', UIN2Show, '%build%', IntToStr(RnQBuild)])
else
Caption := template(rosterTitle, ['%title%', Application.Title, '%displayed%', Str_unk, '%nick%', Str_unk, '%uin%', Str_unk, '%build%', IntToStr(RnQBuild)]);
Call('updateCaption', [Caption]);
UI.Chat.UpdateCaption(Caption + ' - ' + GetTranslation('Chat window'));
end;
procedure TContactList.UpdateStatusGlyphs;
begin
if Assigned(Account.AccProto) then
begin
if Account.AccProto.IsOnline then
UpdateStatusImage(Status2ImgName(Account.AccProto.GetStatus, Account.AccProto.Visibility = VI_invisible))
else
UpdateStatusImage(Status2ImgName(Byte(SC_OFFLINE), False));
end else
UpdateStatusImage(Status2ImgName(Byte(SC_UNK), False));
end;
procedure TContactList.OnTrayEvent(Sender: TObject; TrayEvent: TTrayEvent);
begin
if not Locked and Running then
case TrayEvent of
TE_CLICK:
if not UseSingleClickTray or (UseSingleClickTray and not AlwaysOnTop and Visible and Covered) then
SetForegroundWindow(Window)
else
TrayAction;
TE_2CLICK:
if not UseSingleClickTray then
TrayAction;
TE_RCLICK:
if GetAsyncKeyState(VK_CONTROL) shr 7 <> 0 then
EventQ.Clear
else
UI.CL.OpenMainMenuDelayed;
end;
end;
procedure TContactList.Init;
begin
Clear;
InitSettings;
InitMenus;
end;
procedure TContactList.ApplyTheme;
var
OfficialSprite, BotSprite, DeletedSprite, LocalSprite, AuthSprite: TSprite;
begin
OfficialSprite := MakeSprite(PIC_OFFICIAL);
BotSprite := MakeSprite(PIC_BOT);
DeletedSprite := MakeSprite(PIC_DELETED);
AuthSprite := MakeSprite(PIC_AUTH_NEED);
LocalSprite := MakeSprite(PIC_LOCAL);
Call('applyTheme', [
UI.RecordToVar(OfficialSprite),
UI.RecordToVar(BotSprite),
UI.RecordToVar(DeletedSprite),
UI.RecordToVar(AuthSprite),
UI.RecordToVar(LocalSprite)
]);
end;
procedure TContactList.InitSettings;
var
Icons: TParams;
Settings: TCLSettings;
i: Integer;
begin
SetLength(Icons, Length(SHOW_ICONS_ORDER));
for i := 0 to Length(Icons) - 1 do
begin
Icons[i] := VarArrayCreate([0, 1], varVariant);
Icons[i][0] := UI.RecordToVar(RnQCLIcons[SHOW_ICONS_ORDER[i]]);
Icons[i][1] := TO_SHOW_ICON[SHOW_ICONS_ORDER[i]];
end;
Settings.blinkEnabled := not Account.AccProto.GetStatusDisable.blinking;
Settings.blinkWithStatus := blinkWithStatus;
Settings.onlineOnly := showOnlyOnline;
Settings.showGroups := ShowGroups;
Settings.showEmptyGroups := ShowEmptyGroups;
Settings.combinedGroups := OnlOfflInOne;
Settings.showHints := ShowHintsInCL;
Settings.indentRoster := indentRoster;
Settings.collapseGroups := collapseGroups;
Settings.sortBy := Integer(sortBy);
Settings.blinkTime := blinkSpeed * 100 + 250;
Settings.barPos := BarPos;
Settings.filterPos := FilterPos;
Settings.helpExists := helpExists;
Settings.avatarInHint := avatarShowInHint;
Settings.moreStatuses := showNewXStatuses;
Settings.showStatusMsgMenu := showXStatusMnu;
Settings.autosize := autosizeRoster;
Settings.autosizeFull := autosizeFullRoster;
Settings.autosizeUp := autosizeUp;
Settings.alwaysOnTop := alwaysOnTop;
Settings.noBorderShadow := NoBorderWithShadow;
Settings.mainCSS := MainCSS;
try
Call('initSettings', [Icons, UI.RecordToVar(Settings)]);
SetLength(Icons, 0);
except
on e: ESciterCallException do
MsgDlg('Error in InitSettings: ' + e.Message, False, mtError);
end;
end;
procedure TContactList.InitMenus;
var
I: Integer;
StArr: TStatusArray;
StatusMenu: TStatusMenu;
Statuses: array of TStatus;
StatusesVar: TParams;
begin
StArr := Account.AccProto.Statuses;
StatusMenu := Account.AccProto.GetStatusMenu;
SetLength(Statuses, Length(StatusMenu));
SetLength(StatusesVar, Length(StatusMenu));
I := 0;
for var Code in StatusMenu do
begin
Statuses[I].code := Code;
Statuses[I].name := StArr[Code].ShortName;
Statuses[I].img := StArr[Code].ImageName;
Statuses[I].caption := GetTranslation(StArr[Code].Cptn);
StatusesVar[I] := UI.RecordToVar(Statuses[I]);
Inc(I);
end;
Call('initMenus', [StatusesVar]);
end;
procedure TContactList.UpdateMenus;
begin
Call('updateMenus', [Visible]);
end;
procedure TContactList.OpenMainMenu;
begin
Call('openMainMenu');
end;
procedure TContactList.OpenMainMenuDelayed;
begin
ForceForegroundWindow(Window);
Fire($100);
end;
procedure TContactList.OpenStatusMenu;
begin
Call('openStatusMenu');
end;
procedure TContactList.OpenStatusMenuDelayed;
begin
ForceForegroundWindow(Window);
Fire($101);
end;
procedure TContactList.OpenContextMenu;
begin
Call('openContextMenu');
end;
//procedure TCLBox.OpenContactMenu(const UID: TUID);
//begin
// Call('openContactMenu', [UID]);
//end;
procedure TContactList.OpenAddContact;
begin
Call('openAddContactDialog');
end;
function TContactList.OpenLoginDialog: Boolean;
begin
Result := Call('openLoginDialog');
end;
function TContactList.EnterPassword(Title: String; MaxLength: Integer): String;
begin
Result := Call('enterPassword', [Title, MaxLength]);
end;
procedure TContactList.InitThemeList;
var
I: Integer;
Themes: array of TThemeItem;
ThemesVar: TParams;
Smiles: array of TThemeItem;
SmilesVar: TParams;
Emojis: array of TThemeItem;
EmojisVar: TParams;
Sounds: array of TThemeItem;
SoundsVar: TParams;
begin
theme.RefreshThemelist;
SetLength(Themes, Length(theme.themelist2));
SetLength(ThemesVar, Length(theme.themelist2));
for I := 0 to Length(theme.themelist2) - 1 do
begin
Themes[I].index := I;
Themes[I].title := GetTranslation(theme.themelist2[I].title);
Themes[I].current := (LowerCase(theme.themelist2[i].fn) = LowerCase(theme.ThemePath.fn)) and (theme.ThemePath.subfn = theme.themelist2[i].subFile);
ThemesVar[I] := UI.RecordToVar(Themes[I]);
end;
SetLength(Smiles, Length(theme.smileList));
SetLength(SmilesVar, Length(theme.smileList));
if Length(theme.smileList) > 0 then
for I := 0 to Length(theme.smileList) - 1 do
begin
Smiles[I].index := I;
Smiles[I].title := GetTranslation(theme.smileList[I].title);
Smiles[I].current := (LowerCase(theme.smileList[i].fn) = LowerCase(RQSmilesPath.fn)) and (RQSmilesPath.subfn = theme.smileList[i].subFile);
SmilesVar[I] := UI.RecordToVar(Smiles[I]);
end;
SetLength(Emojis, Length(theme.emojiList));
SetLength(EmojisVar, Length(theme.emojiList));
if Length(theme.emojiList) > 0 then
for I := 0 to Length(theme.emojiList) - 1 do
begin
Emojis[I].index := I;
Emojis[I].title := GetTranslation(theme.emojiList[I].title);
Emojis[I].current := (LowerCase(theme.emojiList[i].fn) = LowerCase(RQEmojisPath.fn)) and (RQEmojisPath.subfn = theme.emojiList[i].subFile);
EmojisVar[I] := UI.RecordToVar(Emojis[I]);
end;
SetLength(Sounds, Length(theme.soundList));
SetLength(SoundsVar, Length(theme.soundList));
if Length(theme.soundList) > 0 then
for I := 0 to Length(theme.soundList) - 1 do
begin
Sounds[I].index := I;
Sounds[I].title := GetTranslation(theme.soundList[I].title);
Sounds[I].current := (LowerCase(theme.soundList[i].fn) = LowerCase(RQSoundsPath.fn)) and (RQSoundsPath.subfn = theme.soundList[i].subFile);
SoundsVar[I] := UI.RecordToVar(Sounds[I]);
end;
Call('initThemeList', [ThemesVar, SmilesVar, EmojisVar, SoundsVar]);
end;
procedure TContactList.Clear;
begin
Call('clear');
end;
procedure TContactList.InsertNode(Node: TNode);
var
Data: TNodeData;
begin
if not Assigned(Node) then
Exit;
Data := UI.GetNodeData(Node);
Call('insertNode', [UI.RecordToVar(Data), Building]);
end;
procedure TContactList.RemoveNode(Node: TNode);
var
Data: TNodeData;
begin
if not Assigned(Node) then
Exit;
Data := UI.GetNodeData(Node);
Call('removeNode', [UI.RecordToVar(Data)]);
end;
procedure TContactList.EditNode(Node: TNode; Reason: TGroupAction = GA_NONE);
var
Data: TNodeData;
begin
Data := UI.GetNodeData(Node, True);
Call('editNode', [UI.RecordToVar(Data), Reason]);
end;
procedure TContactList.SetGroupState(Node: TNode; Expand: Boolean);
var
Data: TNodeData;
begin
Data := UI.GetNodeData(Node, True);
Call('setGroupState', [UI.RecordToVar(Data), Expand]);
end;
procedure TContactList.UpdateStatusImage(const Pic: TPicName);
begin
Call('updateStatusImage', [Pic]);
end;
procedure TContactList.UpdateVisibilityImage;
begin
Call('updateVisibilityImage', [Account.AccProto.Visibility = VI_normal]);
end;
procedure TContactList.UpdateAdditionalImage;
var
XSt, Pic: String;
begin
XSt := GetXSts(nil, True);
if Assigned(Account.outbox) and not Account.outbox.empty then
Pic := PIC_OUTBOX
else
Pic := XSt;
Call('updateAdditionalImage', [XSt, Pic]);
end;
procedure TContactList.UpdateContact(Contact: TICQContact);
begin
InsertNode(TCE(Contact.data^).Node);
end;
procedure TContactList.UpdateGroup(Divisor: TDivisor; Group: TGroup);
begin
if Divisor in divsWithGroups then
if Assigned(Group.Node[Divisor]) then
InsertNode(Group.Node[Divisor]);
end;
procedure TContactList.UpdateGroup(Group: TGroup);
var
Divisor: TDivisor;
begin
for Divisor := Low(TDivisor) to High(TDivisor) do
UpdateGroup(Divisor, Group);
end;
procedure TContactList.UpdateContactCount;
begin
Call('updateContactCount', [contactsPnlStr]);
end;
function TContactList.GetContacts(Divisor: TDivisor): TArray;
var
List: Variant;
I: Integer;
begin
SetLength(Result, 0);
List := Call('getContacts', [Integer(Divisor)]);
if VarIsNull(List) or VarIsEmpty(List) then
Exit;
for I := VarArrayLowBound(List, 1) to VarArrayHighBound(List, 1) do
Result := Result + [Account.AccProto.GetContact(TUID(List[I]))];
end;
function TContactList.GetCurrentContact: TICQContact;
var
Res: Variant;
begin
Result := nil;
Res := Call('getCurrentContact');
if not (Res = '') then
Result := Account.AccProto.GetContact(String(Res));
end;
//function TContactList.Focused: HELEMENT;
//begin
// Result := UI.GetFocused(Window);
//end;
//
//function TContactList.IsFilterFocused: Boolean;
//begin
// Result := not (Focused = nil) and UI.IsVisible(Focused) and (UI.GetID(Focused) = 'clfilter');
//end;
//
//function TContactList.IsMenuFocused: Boolean;
//begin
// Result := not (Focused = nil) and UI.IsVisible(Focused) and (UI.GetTag(Focused) = 'menu');
//end;
procedure TContactList.FocusFilter;
begin
Call('focusFilter');
end;
procedure TContactList.FocusNode(Node: TNode);
var
Data: TNodeData;
begin
Data := UI.GetNodeData(Node, True);
Call('focusNode', [UI.RecordToVar(Data)]);
end;
procedure TContactList.SetProgress(Progress: Double);
begin
Call('setProgress', [Progress]);
end;
procedure TContactList.FinishBuild;
begin
Call('finishBuild');
end;
{ Native methods }
procedure DivisorToTitle(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Divisor: Integer;
DivStr: String;
begin
Divisor := 2;
API.ValueIntData(argv, Divisor);
DivStr := GetTranslation(divisor2ShowStr[TDivisor(Divisor)]);
API.ValueStringDataSet(retval, PWideChar(DivStr), Length(DivStr), 0);
end;
procedure ToggleOnlineOnly(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
ToggleOnlyOnline;
end;
procedure ToggleFilter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.CL.ToggleFilter;
end;
procedure GroupStateChanged(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Group: TGroup;
Tmp, GroupID, Divisor: Integer;
Expanded: Boolean;
begin
API.ValueIntData(argv, Tmp);
Expanded := Tmp = 1;
Inc(argv);
GroupID := 0;
API.ValueIntData(argv, GroupID);
Inc(argv);
Divisor := 2;
API.ValueIntData(argv, Divisor);
Group := groups.Get(GroupID);
// Ex := Group.Expanded[TDivisor(Divisor)];
// if not (Ex = Expanded) then
// begin
groups.SetExpanded(GroupID, TDivisor(Divisor), Expanded);
UI.CL.UpdateGroup(TDivisor(Divisor), Group);
ActionManager.Execute(AK_SAVEGROUPS, SaveDelay);
// end;
end;
procedure OpenContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
ev: Thevent;
begin
UID := SciterVarToString(argv);
clickedContact := Account.AccProto.GetContact(UID);
if UID = '' then
Exit;
ev := eventQ.firstEventFor(clickedContact);
if ev = nil then
UI.Chat.OpenOn(clickedContact)
else
begin
eventQ.Remove(ev);
realizeEvent(ev);
end;
end;
procedure BarButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
id: String;
r, x, y: Integer;
// SL: TStringList;
// TmpJSON: TJSONValue;
// ev: Thevent;
begin
if argc = 0 then
Exit;
id := SciterVarToString(argv);
r := 0;
if argc > 1 then
begin
Inc(argv);
API.ValueIntData(argv, r);
end;
x := 0;
if argc > 2 then
begin
Inc(argv);
API.ValueIntData(argv, x);
end;
y := 0;
if argc > 3 then
begin
Inc(argv);
API.ValueIntData(argv, y);
end;
with UI.CL do
if id = 'addBtn' then
begin
//SL := TStringList.Create;
//SL.LoadFromFile('C:\SpeedProgs\Inet\Chat\RnQ\Build\Distro\CL.json');
//TmpJSON := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(SL.Text), 0);
//Account.AccProto.ProcessContactList(TJSONArray(TmpJSON));
//Account.AccProto.Test;
//ev := Thevent.new(EK_Msg, Account.AccProto.GetContact('230490'), Account.AccProto.GetContact('230490'), Now, 'test+', [], 0, 0, '');
//chatFrm.ChatBox.AddEvent('230490', ev);
//ev := Thevent.new(EK_Msg, Account.AccProto.GetContact('230490'), Account.AccProto.GetContact('230490'), Now, 'test-', [], 0, 0, '');
//chatFrm.ChatBox.AddEvent('230490', ev);
//UpdateContact(Account.AccProto.GetContact('230490'));
//roasterLib.Focus(Account.AccProto.GetContact('230490'));
//roasterLib.Rebuild;
//Exit;
Call(IfThen(Assigned(Account.outbox) and not Account.outbox.Empty, 'openOutbox', 'openStatusDialog'));
end;
end;
procedure GoOnline(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
DoConnect
end;
procedure RenameGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Group: TGroup;
GroupID: Integer;
Reason: Integer;
GroupName: String;
Res: TPair;
begin
GroupID := 0;
API.ValueIntData(argv, GroupID);
Inc(argv);
GroupName := SciterVarToString(argv);
Inc(argv);
Reason := 0;
API.ValueIntData(argv, Reason);
if groups.Name2ID(GroupName) > 0 then
begin
V2S(GetTranslation('The name %s already exists.', [GroupName]), retval);
Exit;
end;
Group := groups.Get(GroupID);
if not Group.IsLocal and (Group.ID >= 0) and Account.AccProto.IsOnline then
begin
Res := groups.RenameLocal(Group.ID, GroupName);
if not (Res.Key = '') then
begin
Group := groups.Get(GroupID);
Group.ServerUpdate(TGroupAction(Reason), Res.Key);
end
end else if Group.IsLocal then
groups.RenameLocal(Group.ID, GroupName)
else
begin
V2S(GetTranslation('Group is not local and must be modified while online'), retval);
Exit;
end;
if (Reason = Integer(GA_Add)) or (Reason = Integer(GA_Rename)) then
UI.CL.UpdateGroup(Group);
ActionManager.Execute(AK_SAVEGROUPS, SaveDelay);
V2S(True, retval);
end;
procedure RenameContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Contact: TICQContact;
UID: TUID;
Reason: Integer;
ContactName: String;
begin
UID := SciterVarToString(argv);
Inc(argv);
ContactName := SciterVarToString(argv);
Inc(argv);
Reason := 0;
API.ValueIntData(argv, Reason);
if UID = '' then
begin
V2S(False, retval);
Exit;
end;
Contact := Account.AccProto.GetContact(UID);
if not (ContactName = Contact.displayed) then
Contact.SetDisplay(ContactName);
UpdateInPlace(contact);
UpdateViewInfo(contact);
ActionManager.Execute(AK_UPDATEDB, 1000);
UI.CL.UpdateContact(contact);
V2S(True, retval);
end;
procedure RemoveGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
GroupID: Integer;
begin
GroupID := 0;
API.ValueIntData(argv, GroupID);
roasterLib.RemoveGroup(GroupID);
end;
procedure DeleteCurrentGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
id: Integer;
begin
if (clickedNode = nil) or not (clickedNode.kind = NODE_GROUP) then
Exit;
id := clickedNode.groupId;
if not groups.Get(id).IsLocal and not Account.AccProto.IsOnline then
begin
MsgDlg('Group is not local and must be modified while online', True, mtInformation);
Exit;
end;
with groups.Get(id) do
if MessageDlg(GetTranslation('Are you sure you want to delete the group "%s" ?', [name]), mtConfirmation, [mbYes, mbNo]) = mrYes then
begin
if Account.AccProto.readList(LT_ROSTER).GetCount(id) > 0 then
if MessageDlg(GetTranslation('This group (%s) is not empty! All contacts in it will be lost!\nAre you sure you want to continue?', [name]), mtWarning, [mbYes, mbNo]) = mrNo then
Exit;
roasterLib.RemoveGroup(id);
end;
end;
procedure SetGroupOrder(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
GroupID, NewOrder: Integer;
begin
GroupID := 0;
API.ValueIntData(argv, GroupID);
Inc(argv);
NewOrder := 0;
API.ValueIntData(argv, NewOrder);
groups.SetOrder(GroupID, NewOrder);
roasterLib.RebuildCL;
end;
procedure SetClicked(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Kind, Divisor, GroupID: Integer;
UID: TUID;
begin
Kind := 0;
API.ValueIntData(argv, Kind);
Inc(argv);
Divisor := 2;
API.ValueIntData(argv, Divisor);
Inc(argv);
GroupID := 0;
API.ValueIntData(argv, GroupID);
Inc(argv);
UID := SciterVarToString(argv);
if Kind = NODE_DIV then
begin
clickedContact := nil;
clickedNode := nil;
end else if Kind = NODE_GROUP then
begin
clickedContact := nil;
clickedNode := GetGroupNode(TDivisor(Divisor), GroupID);
end else if Kind = NODE_CONTACT then
begin
if not (UID = '') then
begin
clickedContact := Account.AccProto.GetContact(UID);
clickedNode := TCE(clickedContact.Data^).Node;
end;
end;
end;
procedure SetStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Code: Integer;
begin
Code := 1;
API.ValueIntData(argv, Code);
Account.AccProto.UserSetStatus(Code, Account.AccProto.GetVisibility);
end;
procedure ToggleVisibility(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
Account.AccProto.SetVisibility(Byte(THelpers.IfThen(Account.AccProto.Visibility = VI_normal, VI_invisible, VI_normal)));
end;
procedure Lock(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
DoLock
end;
procedure Unlock(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
DoUnlock
end;
procedure ViewInfoAbout(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
Contact: TICQContact;
begin
UID := SciterVarToString(argv);
Contact := Account.AccProto.GetContact(UID);
if Assigned(Contact) then
Contact.ViewInfo;
end;
procedure OpenChatWith(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
begin
UID := SciterVarToString(argv);
UI.Chat.OpenOn(Account.AccProto.GetContact(UID));
end;
procedure ReloadLang(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
ReloadCurrentLang
end;
procedure GetCL(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if OnlFeature(Account.AccProto) then
TICQSession(Account.AccProto).GetCL;
end;
procedure ReloadTheme(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
ReloadCurrentTheme
end;
procedure ReloadThemeList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.CL.InitThemeList;
end;
procedure OpenContactThemes(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
S: String;
begin
if FantomWork then
Exit;
S := AccPath + contactsthemeFilename;
if not FileExists(S) then
AppendFile(S, '');
Exec(S);
end;
procedure SelectTheme(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Index: Integer;
begin
Index := 0;
API.ValueIntData(argv, Index);
if (Index >= Low(theme.themelist2)) and (Index <= High(theme.themelist2)) then
begin
with theme.themelist2[Index] do
theme.load(fn, subFile);
with RQSmilesPath do
theme.load(fn, subfn, False, tsc_smiles);
with RQSoundsPath do
theme.load(fn, subfn, False, tsc_sounds);
theme.loadThemeScript(userthemeFilename, AccPath);
ApplyTheme;
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
end else
MsgDlg('Cannot find this theme. Refresh theme list.', True, mtError);
end;
procedure SelectSmiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Index: Integer;
begin
Index := 0;
API.ValueIntData(argv, Index);
if (Index >= Low(theme.smileList)) and (Index <= High(theme.smileList)) then
begin
with theme.smileList[Index] do
begin
RQSmilesPath.pathType := pt_path;
RQSmilesPath.fn := fn;
RQSmilesPath.subfn := subFile;
if fn > '' then
begin
theme.load(fn, subFile, False, tsc_smiles);
theme.loadThemeScript(userthemeFilename, AccPath);
if Assigned(UI.Chat) then
UI.Chat.ResetHistory;
UI.CL.InitThemeList;
end else
ReloadCurrentTheme;
end;
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
if Assigned(UI.Chat) then
UI.Chat.InitSettings;
end else
MsgDlg('Cannot find this theme. Refresh theme list.', True, mtError);
end;
procedure SelectEmojis(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Index: Integer;
begin
Index := 0;
API.ValueIntData(argv, Index);
if (Index >= Low(theme.emojiList)) and (Index <= High(theme.emojiList)) then
begin
with theme.emojiList[Index] do
begin
RQEmojisPath.pathType := pt_path;
RQEmojisPath.fn := fn;
RQEmojisPath.subfn := subFile;
if fn > '' then
begin
theme.load(fn, subFile, False, tsc_emojis);
theme.loadThemeScript(userthemeFilename, AccPath);
if Assigned(UI.Chat) then
UI.Chat.ResetHistory;
UI.CL.InitThemeList;
end else
ReloadCurrentTheme;
end;
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
end else
MsgDlg('Cannot find this theme. Refresh theme list.', True, mtError);
end;
procedure SelectSounds(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Index: Integer;
begin
Index := 0;
API.ValueIntData(argv, Index);
if (Index >= Low(theme.soundList)) and (Index <= High(theme.soundList)) then
begin
with theme.soundList[Index] do
begin
RQSoundsPath.pathType := pt_path;
RQSoundsPath.fn := fn;
RQSoundsPath.subfn := subFile;
if fn > '' then
begin
theme.load(fn, subFile, False, tsc_sounds);
theme.loadThemeScript(userthemeFilename, AccPath);
UI.CL.InitThemeList;
end else
ReloadCurrentTheme;
end;
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
end else
MsgDlg('Cannot find this theme. Refresh theme list.', True, mtError);
end;
procedure OpenMyInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
Account.AccProto.GetMyInfo.ViewInfo
end;
procedure OpenMyWebProfile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
utilLib.OpenURL('https://icq.com/people/' + Account.AccProto.MyAccNum + '/edit/');
end;
procedure OpenHelpSite(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
utilLib.OpenURL('https://help.rnq.ru')
end;
procedure OpenHelpLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
utilLib.OpenURL(MyPath + docsPath + GetTranslation(helpFilename));
end;
procedure ShowAndActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.CL.Show;
Application.BringToFront;
ForceForegroundWindow(UI.CL.Window);
end;
procedure Toggle(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.CL.ToggleVisible
end;
procedure Quit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
iniLib.Quit
end;
procedure AddGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
roasterLib.AddGroup(GetTranslation('New group'));
end;
procedure DeleteEmptyGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
id: Integer;
begin
for var g in groups.GList do
begin
id := g.Value.ID;
if Account.AccProto.readList(LT_ROSTER).GetCount(id) = 0 then
roasterLib.RemoveGroup(id);
end;
end;
procedure ToggleShowGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
RnQMacros.ToggleShowGroups
end;
procedure ToggleShowEmptyGroups(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
RnQMacros.ToggleShowEmptyGroups
end;
procedure ToggleStatusSeparation(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
RnQMacros.ToggleStatusSeparation
end;
procedure AddGroupToServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
p: TGroup;
begin
if (clickedNode = nil) or (clickedNode.groupId <= 0) then
Exit;
p := groups.Get(clickedNode.groupId);
if p.IsLocal and Account.AccProto.IsReady then
if p.ServerUpdate(GA_Add) then
begin
groups.SetLocal(p.ID, False);
UI.CL.UpdateGroup(p);
end;
end;
procedure RemoveCurrentGroupFromServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
p: TGroup;
begin
if (clickedNode = nil) or (clickedNode.groupId <= 0) then
Exit;
p := groups.Get(clickedNode.groupId);
if not p.IsLocal and Account.AccProto.IsReady then
if p.ServerUpdate(GA_Remove) then
begin
groups.SetLocal(p.ID, True);
UI.CL.UpdateGroup(p);
end;
end;
procedure MoveAllFromCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
OldID, NewID: Integer;
begin
if clickedNode = nil then
Exit;
with clickedNode do
if kind = NODE_GROUP then
OldID := groupId
else
Exit;
NewID := 0;
API.ValueIntData(argv, NewID);
if NewID = 2000 then
NewID := 0; // 2000 means no group
try
for var c in Account.AccProto.readList(LT_ROSTER) do
if c.group = OldID then
SetNewGroupFor(c, newID);
except end;
end;
procedure OpenChatWithCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.Chat.OpenOn(clickedContact)
end;
procedure SendMailToCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
clickedContact.sendEmailTo
end;
procedure HasEmail(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
i: Integer;
begin
V2S(Assigned(clickedContact) and not (clickedContact.Email = '') and not TryStrToInt(clickedContact.Email, i), retval)
end;
procedure GetSpamContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
V2S(spamsFilename, retval)
end;
procedure AddCurrentContactToServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
Account.AccProto.AddContact(clickedContact);
end;
procedure IsCurrentInRoster(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
V2S(clickedContact.IsInRoster, retval)
end;
procedure IsInRoster(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
begin
UID := SciterVarToString(argv);
if not (UID = '') then
V2S(Account.AccProto.GetContact(UID).IsInRoster, retval)
end;
procedure CurrentRequestXStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) and OnlFeature(Account.AccProto) then
Account.AccProto.EventSubscribe(clickedContact);
end;
procedure CurrentRequestAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
uid: TUID;
begin
if not Assigned(clickedContact) or (Account.AccProto = nil) then
Exit;
try
uid := clickedContact.uid;
except
uid := '';
end;
if uid = '' then
Exit;
if OnlFeature(Account.AccProto) then
begin
Account.AccProto.AuthRequest(clickedContact, '');
plugins.castEv(PE_AUTHREQ_SENT, uid, '');
end;
end;
procedure CurrentGrantAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) and OnlFeature(Account.AccProto) then
Account.AccProto.Authorize(clickedContact)
end;
procedure CurrentRequestAvatar(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
reqAvatarsQ.Add(clickedContact);
ActionManager.Execute(AK_PROCESSAVATARDOWNLOAD);
end;
procedure CurrentViewInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
clickedContact.ViewInfo;
end;
procedure AddCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
NewID: Integer;
begin
NewID := 0;
API.ValueIntData(argv, NewID);
if Assigned(clickedContact) then
AddToRoster(clickedContact, NewID, clickedContact.CntIsLocal)
end;
procedure MoveCurrentToGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
NewID: Integer;
begin
if not Assigned(clickedContact) then
Exit;
NewID := 0;
API.ValueIntData(argv, NewID);
if NewID = 2000 then
NewID := 0; // 2000 means no group?
try
SetNewGroupFor(clickedContact, NewID);
except end;
end;
procedure RemoveCurrentContactFromServer(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) and Account.AccProto.IsOnline then
clickedContact.DelCntFromSrv;
end;
procedure DeleteCurrentContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
if (clickedContact.CntIsLocal or Account.AccProto.IsOnline) then
begin
if MessageDlg(GetTranslation('Are you sure you want to delete %s from your list?', [clickedContact.displayed]), mtConfirmation, [mbYes, mbNo]) = mrYes then
RemoveFromRoster(clickedContact);
end else
MsgDlg('Contact is not local and must be modified while online', True, mtInformation);
end;
procedure DeleteCurrentContactHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
DelHistWith(clickedContact.UID);
end;
procedure DeleteCurrentContactAndHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
if MessageDlg(GetTranslation('Are you sure you want to delete %s from your list with his history?', [clickedContact.displayed]), mtConfirmation, [mbYes, mbNo]) = mrYes then
RemoveFromRoster(clickedContact, True);
end;
procedure CurrentIsInQuietList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
V2S(QuietList.exists(clickedContact), retval)
end;
procedure AddCurrentToQuietList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
c: TICQContact;
begin
c := clickedContact;
if c = nil then
Exit;
if QuietList.Exists(c) then
RemoveFromQuietList(c)
else
AddToQuietList(c);
end;
procedure CurrentIsInIgnoreList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
V2S(IgnoreList.exists(clickedContact), retval)
end;
procedure AddCurrentToIgnoreList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
c: TICQContact;
begin
c := clickedContact;
if c = nil then
Exit;
if IgnoreList.Exists(c) then
RemoveFromIgnoreList(c)
else
begin
AddToIgnoreList(c);
if MessageDlg(GetTranslation('Do you want to remove %s from your contact list?', [c.displayed]), mtConfirmation, [mbYes, mbNo]) = mrYes then
RemoveFromRoster(c);
end;
end;
procedure GetCurrentUIN2Show(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
if Assigned(clickedContact) then
V2S(GetTranslation('%s (copy UIN)', [clickedContact.uin2Show]), retval);
end;
procedure IsGroupLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
GroupID: Integer;
IsLocal: Boolean;
begin
IsLocal := True;
GroupID := 0;
API.ValueIntData(argv, GroupID);
if GroupID > 0 then
IsLocal := groups.Get(GroupID).IsLocal;
V2S(IsLocal, retval);
end;
procedure GetGroupName(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
GroupID: Integer;
begin
GroupID := 0;
API.ValueIntData(argv, GroupID);
V2S(groups.ID2Name(groupId), retval)
end;
procedure GetContactGroup(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
begin
UID := SciterVarToString(argv);
if not (UID = '') then
V2S(Account.AccProto.GetContact(UID).Group, retval)
end;
procedure ContactNeedsAuth(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
begin
UID := SciterVarToString(argv);
if not (UID = '') then
V2S(not Account.AccProto.GetContact(UID).Authorized, retval)
end;
procedure IsContactLocal(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
begin
UID := SciterVarToString(argv);
if not (UID = '') then
V2S(Account.AccProto.GetContact(UID).CntIsLocal, retval);
end;
procedure AddContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
UID: TUID;
GroupID: Integer;
begin
UID := SciterVarToString(argv);
Inc(argv);
GroupID := 0;
API.ValueIntData(argv, GroupID);
if not (UID = '') then
begin
AddToRoster(Account.AccProto.GetContact(UID), GroupID, (GroupID = 0) or not Account.AccProto.IsOnline);
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
end;
end;
procedure SearchContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Keyword: String;
Anketa: TAnketa;
begin
if not OnlFeature(Account.AccProto) then
Exit;
Keyword := SciterVarToString(argv);
if Account.AccProto.SearchContact(Keyword, Anketa) then
V2S(UI.RecordToVar(Anketa), retval)
else
V2S(False, retval);
end;
procedure SavePassword(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Password: String;
begin
Password := SciterVarToString(argv);
if Password = '' then
Exit;
Account.AccProto.Pwd := Password;
if not dontSavePwd then
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
end;
procedure HasBorder(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
V2S(ShowMainBorder, retval);
end;
procedure FlashChatWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
UI.Chat.Flash;
end;
procedure OnCLShow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
{$IFDEF DEBUG_PACKETS}
// Account.AccProto.getMyInfo.ViewInfo;
// Showlogwindow1Click(Sender);
{$ENDIF DEBUG_PACKETS}
end;
procedure OnCLHide(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
clickedContact := nil;
end;
procedure OnCLActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
// Wait for active window to switch
TThread.CreateAnonymousThread(procedure
begin
TThread.Queue(nil, procedure
begin
ApplyTransparency(AW_CL);
end);
end).Start;
end;
procedure OnCLMouseEnter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
Style: Integer;
begin
if Running and Assigned(UI.CL) then
if transparency.forRoster and transparency.chgOnMouse then
begin
Style := GetWindowLong(UI.CL.Window, GWL_EXSTYLE);
if (Style and WS_EX_LAYERED) = 0 then
SetWindowLong(UI.CL.Window, GWL_EXSTYLE, Style or WS_EX_LAYERED);
SetLayeredWindowAttributes(UI.CL.Window, 0, transparency.active, LWA_ALPHA);
end;
end;
procedure OnCLMouseLeave(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
ExStyle: Integer;
begin
if Running and Assigned(UI.CL) then
if UI.CL.Window <> GetForegroundWindow then
if transparency.forRoster and transparency.chgOnMouse then
begin
ExStyle := GetWindowLong(UI.CL.Window, GWL_EXSTYLE);
if (ExStyle and WS_EX_LAYERED) = 0 then
SetWindowLong(UI.CL.Window, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(UI.CL.Window, 0, transparency.inactive, LWA_ALPHA);
end;
end;
initialization
MonPositions := TDictionary.Create;
finalization
FreeAndNil(MonPositions);
end.