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/groupsLib.pas

481 lines
11 KiB
Plaintext

{
Copyright (C) 2002-2004 Massimo Melina (www.rejetto.com)
This file is part of &RQ.
&RQ is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
&RQ is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with &RQ; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
{$I RnQConfig.inc}
unit groupsLib;
interface
uses
Windows, Classes, Generics.Collections,
roasterlib, RDGlobal, ICQCommon, Nodes;
{$I PubRTTI.inc}
type
TGroup = record
IsLocal: Boolean;
ID: Integer;
Order: Integer;
Name: String;
Node: array [TDivisor] of TNode;
Expanded: array [TDivisor] of Boolean;
function ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
end;
TGroupItem = record
id: Integer;
caption, img: String;
end;
type
TGroups = class
public
GList: TDictionary;
procedure ClearNodes;
procedure Clear;
procedure MakeAllLocal;
// procedure FillNodes;
procedure FromString(s: RawByteString);
function ToString: RawByteString; reintroduce;
// function IdxOf(id: Integer): Integer;
function AddEmpty: Integer;
function AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
function Get(id: Integer): TGroup;
function Exists(ID: Integer): Boolean; overload;
function Exists(const Name: String): Boolean; overload;
function Count: Integer;
function GetCount(Divisor: TDivisor): Integer;
function RenameLocal(ID: Integer; const NewName: String): TPair;
procedure Rename(ID: Integer; const NewName: String);
function Remove(ID: Integer): Boolean; overload;
function Remove(const Name: String): Boolean; overload;
function Name2ID(const Name: string): Integer;
function ID2Name(ID: Integer): String;
function FreeID: Integer;
// Change values from outside
procedure SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
procedure SetOrder(ID, order: Integer);
procedure SetNode(ID: Integer; d: TDivisor; Node: TNode);
procedure SetLocal(ID: Integer; IsLocal: Boolean);
// Helpers
function GetGroups(AddOut: Boolean): TArray;
procedure AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
procedure SetNodesExpanded(d: TDivisor);
constructor Create;
destructor Destroy; override;
private
procedure SaveGroup(Group: TGroup);
end; // TGroups
implementation
uses
utilLib, globalLib, SysUtils,
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF UNICODE}
RDUtils, RnQLangs, RnQPics, ICQSession, SciterApi;
var
g: TPair;
constructor TGroups.Create;
begin
inherited;
GList := TDictionary.Create;
end;
destructor TGroups.Destroy;
begin
GList.Clear;
FreeAndNil(GList);
inherited;
end;
function TGroups.Get(ID: Integer): TGroup;
begin
Result := Default(TGroup);
for g in GList do
if g.Value.ID = ID then
begin
Result := g.Value;
Exit;
end;
end;
const
StringSeparator = ';';
procedure TGroups.FromString(s: RawByteString);
var
k, Line: RawByteString;
p: TGroup;
d: TDivisor;
begin
Clear;
while s > '' do
begin
Line := chopLine(s);
k := Trim(chop(AnsiString('='), Line));
Line := Trim(Line);
if IsOnlyDigits(k) then
try
p := Default(TGroup);
p.ID := StrToInt(k);
p.Name := Trim(UnUTF(Line));
p.Order := 0;
for d := Low(d) to High(d) do
begin
p.Node[d] := nil;
p.Expanded[d] := True;
end;
except end
else if k = 'order' then
try
p.Order := StrToInt(Line)
except end
else if k = 'collapsed' then
while Line > '' do
try
p.Expanded[Str2Divisor(chop(StringSeparator, Line))] := False;
except end
else if k = 'ssi' then
try
p.IsLocal := Line = '0';
if not (p.Name = '') then
GList.AddOrSetValue(p.Name, p);
except end;
end;
end; // FromString
function TGroups.ToString: RawByteString;
var
d: TDivisor;
begin
Result := '';
for g in GList do
begin
Result := Result + Format(AnsiString('%d=%s' + CRLF + 'order=%d' + CRLF + 'collapsed='), [g.Value.ID, UTF(g.Value.name), g.Value.order]);
for d := Low(d) to High(d) do
if not g.Value.Expanded[d] then
Result := Result + Divisor2Str[d] + StringSeparator;
Result := Result + Format(AnsiString(CRLF + 'ssi=%d'), [IfThen(g.Value.IsLocal, 0, 1)]);
Result := Result + CRLF;
end;
end; // ToString
procedure TGroups.ClearNodes;
var
d: TDivisor;
p: TGroup;
begin
for g in GList do
for d := Low(TDivisor) to High(TDivisor) do
begin
g.Value.Node[d].Free;
// p := GList.Items[g.Value.Name];
// FreeAndNil(p.Node[d]);
// GList.Items[g.Value.Name] := p;
// if Assigned(g.Value.Children[d]) then
// begin
// for Node in g.Value.Children[d].Values do
// Node.Free;
// g.Value.Children[d].Clear;
// end;
end;
end;
procedure TGroups.Clear;
begin
ClearNodes;
GList.Clear;
end;
procedure TGroups.MakeAllLocal;
var
p: TGroup;
begin
for g in GList do
begin
p := g.Value;
p.IsLocal := True;
SaveGroup(p);
end;
end;
//procedure TGroups.FillNodes;
//var
// p: TGroup;
//begin
// for g in groups.GList do
// begin
// p := g.Value;
// FillChar(p.Node, SizeOf(p.Node), 0);
// groups.GList.Items[p.Name] := p;
// end;
//end;
procedure TGroups.SetNodesExpanded(d: TDivisor);
begin
for g in groups.GList do
if Assigned(g.Value.Node[d]) then
g.Value.Node[d].SetExpanded(THelpers.IfThen(collapseGroups, g.Value.Expanded[d] and not (d = d_offline) and not (d = d_contacts), g.Value.Expanded[d]))
end;
procedure TGroups.SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
var
p: TGroup;
begin
p := Get(ID);
if p.Name = '' then
Exit;
p.Expanded[d] := val;
SaveGroup(p);
end;
procedure TGroups.SetOrder(ID, order: Integer);
var
p: TGroup;
begin
p := Get(ID);
if p.Name = '' then
Exit;
p.Order := order;
SaveGroup(p);
end;
procedure TGroups.SetNode(ID: Integer; d: TDivisor; Node: TNode);
var
p: TGroup;
begin
p := Get(ID);
if p.Name = '' then
Exit;
p.Node[d] := Node;
SaveGroup(p);
end;
procedure TGroups.SetLocal(ID: Integer; IsLocal: Boolean);
var
p: TGroup;
begin
p := Get(ID);
if p.Name = '' then
Exit;
p.IsLocal := IsLocal;
SaveGroup(p);
end;
procedure TGroups.SaveGroup(Group: TGroup);
begin
if not (Group.Name = '') then
GList.AddOrSetValue(Group.Name, Group);
end;
{
function TGroups.idxOf(id: integer): integer;
begin
for result := 0 to count - 1 do
if a[result].id = id then
exit;
result := -1;
end; // idxOf
}
function TGroups.FreeID: Integer;
begin
Result := 1000;
for g in GList do
if g.Value.ID >= Result then
Result := g.Value.ID + 1;
end; // FreeID
function TGroups.AddEmpty: Integer;
begin
Result := AddWithValues;
end;
function TGroups.AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
var
d: TDivisor;
gr: TGroup;
begin
if ID = 0 then
gr.ID := FreeID
else
gr.ID := ID;
gr.IsLocal := True;
gr.Name := Name;
gr.Order := 0;
for d := Low(d) to High(d) do
begin
gr.Node[d] := nil;
gr.Expanded[d] := True;
end;
GList.AddOrSetValue(gr.Name, gr);
Result := gr.ID;
end; // AddWithID
function TGroups.Exists(ID: Integer): Boolean;
begin
Result := False;
for g in GList do
if g.Value.ID = ID then
Result := True;
end;
function TGroups.Exists(const Name: String): Boolean;
begin
Result := GList.ContainsKey(Name);
end;
function TGroups.RenameLocal(ID: Integer; const NewName: String): TPair;
var
p: TGroup;
begin
Result := Default(TPair);
p := Get(ID);
Result.Key := p.Name;
if p.Name = '' then
Exit;
GList.Remove(p.Name);
p.Name := NewName;
GList.AddOrSetValue(NewName, p);
Result.Value := p;
end;
procedure TGroups.Rename(ID: Integer; const NewName: String);
var
Res: TPair;
Group: TGroup;
begin
Res := RenameLocal(ID, NewName);
Group := Get(ID);
if not Group.IsLocal and (Group.ID >= 0) and not (Res.Key = '') then
Res.Value.ServerUpdate(GA_Rename, Res.Key);
end;
function TGroups.Remove(ID: Integer): Boolean;
var
p: TGroup;
begin
p := Get(ID);
Result := not (p.Name = '');
if not Result then
Exit;
GList.Remove(p.Name);
if not p.IsLocal then
if Account.AccProto.IsReady then
Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove
function TGroups.Remove(const Name: String): Boolean;
var
p: TGroup;
begin
Result := GList.TryGetValue(Name, p);;
if not Result then
Exit;
GList.Remove(p.Name);
if not p.IsLocal then
if Account.AccProto.IsReady then
Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove
function TGroups.ID2Name(ID: Integer): String;
begin
Result := Get(ID).Name
end; // ID2Name
function TGroups.Name2ID(const Name: String): Integer;
var
p: TGroup;
begin
if GList.TryGetValue(Name, p) then
Result := p.ID
else
Result := 0;
end; // Name2ID
function TGroups.Count: Integer;
begin
Result := GList.Count;
end;
function TGroups.GetCount(Divisor: TDivisor): Integer;
begin
Result := 0;
for g in GList do
if Assigned(g.Value.Node[Divisor]) then
Inc(Result);
end;
procedure TGroups.AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
begin
for g in GList do
if pAddOut or not g.Value.IsLocal then
ss.AddObject(DupAmpersand(g.Value.Name), TObject(g.Value.ID));
end;
function TGroups.GetGroups(AddOut: Boolean): TArray;
var
i: Integer;
ss: TStringList;
procedure AddMenuItem(const caption: String; const picname: TPicName; tag: Integer = -1);
var
pos: Integer;
begin
SetLength(Result, Length(Result) + 1);
pos := Length(Result) - 1;
Result[pos].caption := caption;
Result[pos].img := picname;
Result[pos].id := tag;
end;
begin
SetLength(Result, 0);
if AddOut then
begin
AddMenuItem(GetTranslation('Out of groups'), PIC_OUT_OF_GROUPS, 2000);
AddMenuItem('-', '');
end;
ss := TStringList.Create;
groups.AddGroupsToList(ss, AddOut);
ss.Sort;
for i := 0 to ss.count - 1 do
AddMenuItem(ss[i], PIC_CLOSE_GROUP, Integer(ss.objects[I]));
ss.Free;
end;
{ TGroup }
function TGroup.ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
begin
Result := Account.AccProto.SendUpdateGroup(Name, ga, old);
end;
end.