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.
369 lines
9.4 KiB
Plaintext
369 lines
9.4 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit RnQTips;
|
|
{$I RnQConfig.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.Types, System.Classes, System.SysUtils, Vcl.Graphics, Generics.Collections,
|
|
SciterJS, SciterJSAPI, BaseWindow, ICQCommon, ICQContacts, RnQGraphics32, events;
|
|
|
|
{$I PubRTTI.inc}
|
|
|
|
type
|
|
TTipsAlign = (alBottomRight, alBottomLeft, alTopLeft, alTopRight, alCenter);
|
|
TTipsAlignSet = set of TTipsAlign;
|
|
|
|
TTipData = record
|
|
mode: Byte;
|
|
time: TDateTime;
|
|
counter: Integer;
|
|
uid: TUID;
|
|
who, what, body, pic, spic, xpic, avatar, event: String;
|
|
hash: LongWord;
|
|
image: TBytes;
|
|
hashes: TArray |
|
images: TArray |
|
end;
|
|
|
|
TTipsSettings = record
|
|
tipsAvatar, tipsLimitAvatar, tipsAlpha: Boolean;
|
|
tipsMaxCount, tipsSpaceBetween, tipsAlign, tipsHorIndent, tipsVerIndent, tipsMaxAvatarSize, tipsAlphaValue: Integer;
|
|
end;
|
|
|
|
TTipsMethods = class(TNativeMethods)
|
|
class procedure RegisterMethods(var ReturnValue: TSciterValue); override;
|
|
class procedure ClearTip(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
|
end;
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
TTips = class(TBaseWindow)
|
|
public
|
|
function TipsWndProc(var Message: TMessage): Boolean;
|
|
procedure InitWndProc; override;
|
|
procedure InitSettings;
|
|
procedure Add(Ev: Thevent; Bitmap: TRnQBitmap = nil; BdCnt: TICQContact = nil; Seconds: Integer = -1);
|
|
procedure Remove(Ev: Thevent); overload;
|
|
procedure Remove(Cnt: TICQContact); overload;
|
|
procedure RemoveAll;
|
|
procedure Reposition;
|
|
end;
|
|
|
|
var
|
|
PrevWnd: THandle;
|
|
TipsEvents: TObjectList |
|
TipsMaxCnt: Integer = 20;
|
|
TipsBtwSpace: Integer;
|
|
TipsAlign: TTipsAlign;
|
|
TipHorIndent: Integer;
|
|
TipVerIndent: Integer;
|
|
TipsMethods: TTipsMethods;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Murmur2, SciterLib,
|
|
RDGlobal, RQUtil, RnQBinUtils, RnQLangs, RnQPics, RnQ_Avatars,
|
|
globalLib, utilLib, Protocol_ICQ, ICQConsts;
|
|
|
|
procedure TTips.InitWndProc;
|
|
begin
|
|
MyWndProc := TipsWndProc;
|
|
inherited InitWndProc;
|
|
end;
|
|
|
|
function TTips.TipsWndProc(var Message: TMessage): Boolean;
|
|
begin
|
|
Result := False;
|
|
if Message.Msg = WM_ACTIVATE then
|
|
if Message.LParam > 0 then
|
|
PrevWnd := Message.LParam;
|
|
end;
|
|
|
|
procedure TTips.InitSettings;
|
|
var
|
|
Settings: TTipsSettings;
|
|
begin
|
|
Settings.tipsMaxCount := TipsMaxCnt;
|
|
Settings.tipsSpaceBetween := TipsBtwSpace;
|
|
Settings.tipsAlign := Integer(TipsAlign);
|
|
Settings.tipsHorIndent := TipHorIndent;
|
|
Settings.tipsVerIndent := TipVerIndent;
|
|
Settings.tipsAvatar := AvatarShowInTray;
|
|
Settings.tipsLimitAvatar := TipsMaxAvtSizeUse;
|
|
Settings.tipsMaxAvatarSize := TipsMaxAvtSize;
|
|
Settings.tipsAlpha := Transparency.ForTray;
|
|
Settings.tipsAlphaValue := Transparency.Tray;
|
|
|
|
try
|
|
Call('initSettings', [UI.RecordToVar(Settings)]);
|
|
except
|
|
on e: ESciterCallException do
|
|
MsgDlg('Error in InitSettings: ' + e.Message, False, mtError);
|
|
end;
|
|
end;
|
|
|
|
procedure TTips.Add(Ev: Thevent; Bitmap: TRnQBitmap = nil; BdCnt: TICQContact = nil; Seconds: Integer = -1);
|
|
var
|
|
TipData: TTipData;
|
|
Body: String;
|
|
BodyLen, Days2Bd, I: Integer;
|
|
Cnt: TICQContact;
|
|
Bin: TBytes;
|
|
Status, B: Byte;
|
|
StatusArr: TStatusArray;
|
|
// ExtSticker: TStringDynArray;
|
|
ImageStream: TMemoryStream;
|
|
begin
|
|
if (TipsMaxCnt = 0) or Locked then
|
|
Exit;
|
|
|
|
if Assigned(Ev) then
|
|
TipData.mode := 1
|
|
else if Assigned(Bitmap) then
|
|
TipData.mode := 2
|
|
else if Assigned(BdCnt) then
|
|
TipData.mode := 3
|
|
else
|
|
Exit;
|
|
|
|
Cnt := nil;
|
|
if Assigned(Ev) and Assigned(Ev.OtherPeer) then
|
|
Cnt := Ev.OtherPeer
|
|
else if Assigned(Ev) and Assigned(Ev.Who) then
|
|
Cnt := Ev.Who
|
|
else if Assigned(BdCnt) then
|
|
Cnt := BdCnt
|
|
else
|
|
TipData.who := '';
|
|
|
|
if Assigned(Cnt) then
|
|
begin
|
|
TipData.uid := Cnt.UID;
|
|
TipData.who := Cnt.Displayed;
|
|
end;
|
|
|
|
if Assigned(Ev) and Assigned(Ev.OtherPeer) and
|
|
Assigned(Ev.Who) and not Ev.Who.Equals(Ev.OtherPeer) then
|
|
TipData.who := TipData.who + ' (' + Ev.Who.Displayed + ')';
|
|
|
|
Days2Bd := -1;
|
|
if Assigned(Ev) then
|
|
TipData.pic := Event2ImgName(Ev.Kind)
|
|
else if Assigned(BdCnt) then
|
|
begin
|
|
Days2Bd := BdCnt.Days2Bd;
|
|
case Days2Bd of
|
|
0: TipData.pic := PIC_BIRTH;
|
|
1: TipData.pic := PIC_BIRTH1;
|
|
2: TipData.pic := PIC_BIRTH2;
|
|
else
|
|
TipData.pic := PIC_BIRTH;
|
|
end;
|
|
end else
|
|
TipData.pic := '';
|
|
|
|
if Assigned(Ev) then
|
|
TipData.what := GetTranslation(tipevent2str[Ev.Kind])
|
|
else if Assigned(BdCnt) then
|
|
if Days2Bd in [0 .. 2] then
|
|
TipData.what := GetTranslation(tipBirth2str[days2BD])
|
|
else
|
|
TipData.what := GetTranslation('Days until birthday') + ': ' + IntToStr(Days2Bd);
|
|
|
|
TipData.spic := '';
|
|
TipData.xpic := '';
|
|
if Assigned(Ev) then
|
|
if Ev.Kind in [EK_INCOMING, EK_STATUSCHANGE] then
|
|
begin
|
|
Bin := Ev.GetBodyBin;
|
|
if Length(Bin) >= 4 then
|
|
begin
|
|
Status := Str2Int(Bin);
|
|
if Assigned(Cnt) then
|
|
begin
|
|
StatusArr := Account.AccProto.Statuses;
|
|
if Status <= High(StatusArr) then
|
|
begin
|
|
B := BinToXStatus(Bin);
|
|
if not (Status = Byte(SC_ONLINE)) or (B = 0) then
|
|
TipData.spic := Status2ImgName(Status, (Length(Bin) > 4) and Boolean(Bin[5]));
|
|
if (B >= Low(XStatusArray)) and (B <= High(XStatusArray)) then
|
|
TipData.xpic := XStatusArray[B].Status;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
BodyLen := 0;
|
|
TipData.avatar := '';
|
|
if Assigned(Ev) then
|
|
begin
|
|
TipsEvents.Add(Ev.Clone);
|
|
TipData.event := Ev.GUID;
|
|
|
|
Body := Ev.GetBodyText;
|
|
if Ev.Kind in [EK_msg, EK_contacts, EK_authReq] then
|
|
BodyLen := Length(Body);
|
|
|
|
SetLength(TipData.images, 0);
|
|
// if Ev.Flags and IF_sticker > 0 then
|
|
// begin
|
|
// ExtSticker := SplitString(Body, ':');
|
|
// if Length(ExtSticker) >= 4 then
|
|
// begin
|
|
// SetLength(TipData.images, Length(TipData.images) + 1);
|
|
// TipData.images[High(TipData.images)] := GetSticker(ExtSticker[1], ExtSticker[3]);
|
|
// Body := '';
|
|
// end;
|
|
// end;
|
|
|
|
if not (Body = '') then
|
|
TipData.body := Body
|
|
else if (Ev.Kind in [EK_incoming, EK_outgoing]) and Assigned(Cnt) and CheckAvatar(Cnt) then
|
|
TipData.avatar := 'avatar:' + Cnt.UID;
|
|
|
|
if Ev.Kind = EK_msg then
|
|
Bin := Ev.GetBodyBin
|
|
else
|
|
Bin := nil;
|
|
|
|
if Assigned(Bin) then
|
|
GetMsgImages(Bin, TipData.images);
|
|
|
|
SetLength(TipData.hashes, Length(TipData.images));
|
|
for I := 0 to High(TipData.images) do
|
|
TipData.hashes[I] := IntToStr(CalcMurmur2(TipData.images[I]));
|
|
end;
|
|
|
|
if TipData.mode = 1 then
|
|
begin
|
|
if (Assigned(Ev) and not (BE_TIP in supportedBehactions[Ev.Kind])) or
|
|
// user reading this message in chat window
|
|
((Ev.Kind in [EK_msg]) and UI.Chat.IsVisible and Ev.Who.Equals(UI.Chat.ThisChat.who)) then
|
|
Exit;
|
|
|
|
TipData.time := Ev.When;
|
|
TipData.counter := seconds;
|
|
|
|
with behaviour[Ev.Kind] do
|
|
begin
|
|
TipData.counter := TipTime;
|
|
if TipTimes then
|
|
TipData.counter := TipData.counter * BodyLen + TipTimePlus;
|
|
if TipData.counter <= 0 then
|
|
TipData.counter := 20;
|
|
end;
|
|
end else if TipData.mode = 2 then
|
|
begin
|
|
ImageStream := TMemoryStream.Create;
|
|
if Assigned(Bitmap.fBmp) then
|
|
Bitmap.fBmp.SaveToStream(ImageStream);
|
|
if ImageStream.Size > 0 then
|
|
begin
|
|
SetLength(TipData.image, ImageStream.Size);
|
|
ImageStream.Position := 0;
|
|
ImageStream.Read(TipData.image[0], ImageStream.Size);
|
|
TipData.hash := CalcMurmur2(TipData.image);
|
|
end;
|
|
ImageStream.Free;
|
|
end
|
|
else
|
|
begin
|
|
TipData.time := Now;
|
|
TipData.counter := 0;
|
|
end;
|
|
|
|
Call('addTip', [UI.RecordToVar(TipData)]);
|
|
end;
|
|
|
|
procedure TTips.Remove(Ev: Thevent);
|
|
var
|
|
Event: Thevent;
|
|
begin
|
|
for Event in TipsEvents do
|
|
if Event.GUID = Ev.GUID then
|
|
begin
|
|
Call('removeTipByGUID', [Event.GUID]);
|
|
TipsEvents.Remove(Event);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TTips.Remove(Cnt: TICQContact);
|
|
begin
|
|
if Assigned(Cnt) then
|
|
Call('removeTipByUID', [Cnt.UID]);
|
|
end;
|
|
|
|
procedure TTips.RemoveAll;
|
|
begin
|
|
TipsEvents.Clear;
|
|
Call('removeAll');
|
|
end;
|
|
|
|
procedure TTips.Reposition;
|
|
begin
|
|
Call('repositionTips');
|
|
end;
|
|
|
|
class procedure TTipsMethods.RegisterMethods(var ReturnValue: TSciterValue);
|
|
begin
|
|
AddMethod('ClearTip', ClearTip);
|
|
end;
|
|
|
|
class procedure TTipsMethods.ClearTip(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
|
var
|
|
Cnt: TICQContact;
|
|
Action, GUID: String;
|
|
Ev: Thevent;
|
|
I: Integer;
|
|
begin
|
|
Action := SciterVarToString(argv);
|
|
Inc(argv);
|
|
GUID := SciterVarToString(argv);
|
|
|
|
if GUID = '' then
|
|
Exit;
|
|
|
|
Ev := nil;
|
|
for I := 0 to TipsEvents.Count - 1 do
|
|
if TipsEvents.Items[I].GUID = GUID then
|
|
begin
|
|
Ev := TipsEvents.Items[I];
|
|
Break;
|
|
end;
|
|
|
|
if not Assigned(Ev) then
|
|
Exit;
|
|
|
|
if Action = 'realize' then
|
|
begin
|
|
if Assigned(Ev.OtherPeer) then
|
|
Cnt := Ev.OtherPeer
|
|
else
|
|
Cnt := Ev.Who;
|
|
UI.Chat.Open;
|
|
UI.Chat.MoveToEvent(Cnt, Ev);
|
|
if not UI.Chat.HasEvent(Cnt, Ev) then
|
|
UI.Chat.AddEvent(Cnt, Ev.Clone);
|
|
end;
|
|
|
|
if (Action = 'realize') or (Action = 'remove') then
|
|
eventQ.RemoveEvent(Ev.Who);
|
|
|
|
TipsEvents.Remove(Ev);
|
|
end;
|
|
|
|
initialization
|
|
TipsEvents := TObjectList |
|
|
|
finalization
|
|
TipsEvents.Free;
|
|
|
|
end.
|