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

442 lines
12 KiB
Plaintext

{
This file is part of R&Q.
Under same license
}
unit visibilityDlg;
{$I RnQConfig.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
RnQProtocol,
StdCtrls, Menus, RnQButtons, VirtualTrees;
{$I NoRTTI.inc}
type
TvisibilityFrm = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
PMenu1: TPopupMenu;
PMenu2: TPopupMenu;
PMenu3: TPopupMenu;
selectall1: TMenuItem;
Selectall2: TMenuItem;
Selectall3: TMenuItem;
InvisBox: TVirtualDrawTree;
NormalBox: TVirtualDrawTree;
VisibleBox: TVirtualDrawTree;
move2inv: TRnQButton;
move2normal: TRnQButton;
move2vis: TRnQButton;
procedure InvisBoxDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure normalBoxClick(Sender: TObject);
procedure invisibleBoxClick(Sender: TObject);
procedure visibleBoxClick(Sender: TObject);
procedure move2invClick(Sender: TObject);
procedure move2normalClick(Sender: TObject);
procedure move2visClick(Sender: TObject);
procedure selectall1Click(Sender: TObject);
procedure Selectall2Click(Sender: TObject);
procedure Selectall3Click(Sender: TObject);
procedure NormalBoxFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
private
thisProto: TRnQProtocol;
normal: TRnQCList;
procedure setUpBoxes;
procedure inv2normal;
procedure inv2vis;
procedure normal2vis;
procedure normal2inv;
procedure vis2normal;
procedure vis2inv;
procedure selectAll(lb: TBaseVirtualTree);
procedure unselect(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
procedure select(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
public
procedure DestroyHandle; Override;
end;
var
visibilityFrm: TvisibilityFrm;
implementation
{$R *.DFM}
uses
RQUtil, RDGlobal, RQThemes,
RnQSysUtils, RnQPics,
globalLib, mainDlg, utilLib, themesLib,
ICQConsts, ICQv9,
roasterLib;
type
PVisRec = ^TVisRec;
TVisRec = record
s: string;
cnt: TRnQcontact;
end;
function what2display(c: TRnQcontact): string;
begin
result := c.displayed + ' ' + c.uid
end;
procedure fillUp(lb: TBaseVirtualTree; cl: TRnQCList);
var
i: integer;
p: PVisRec;
begin
lb.Clear;
for i := 0 to TList(cl).count - 1 do
begin
lb.BeginUpdate;
p := lb.GetNodeData(lb.AddChild(NIL));
p.cnt := cl.getAt(i);
p.s := what2display(p.cnt);
lb.EndUpdate;
end;
end; // fillUp
procedure TvisibilityFrm.setUpBoxes;
begin
fillUp(VisibleBox, thisProto.readList(LT_VISIBLE));
fillUp(NormalBox, normal);
fillUp(InvisBox, thisProto.readList(LT_INVISIBLE));
end; // setUpBoxes
procedure TvisibilityFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
normal.free;
saveListsDelayed := TRUE;
DestroyHandle;
Action := caFree;
visibilityFrm := nil;
end;
procedure TvisibilityFrm.FormCreate(Sender: TObject);
begin
InvisBox.NodeDataSize := SizeOf(TVisRec);
NormalBox.NodeDataSize := SizeOf(TVisRec);
VisibleBox.NodeDataSize := SizeOf(TVisRec);
end;
function clFromBox(lb: TBaseVirtualTree): TRnQCList;
var
n: PVirtualNode;
begin
result := TRnQCList.create;
n := lb.GetFirst;
while n <> NIL do
begin
if lb.selected[n] then
result.add(TVisRec(PVisRec(lb.GetNodeData(n))^).cnt);
n := lb.GetNext(n);
end;
end; // clFromBox
procedure TvisibilityFrm.InvisBoxDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
var
s: String;
x: integer;
begin
s := TVisRec(PVisRec(Sender.GetNodeData(PaintInfo.Node))^).s;
if vsSelected in PaintInfo.Node.States then
begin
if Sender.Focused then
PaintInfo.Canvas.Font.Color := clHighlightText
else
PaintInfo.Canvas.Font.Color := clWindowText;
end
else
PaintInfo.Canvas.Font.Color := clWindowText;
x := PaintInfo.ContentRect.Left;
// inc(x,
// theme.drawPic(PaintInfo.Canvas, PaintInfo.ContentRect.Left +3, 0,
// TlogItem(PLogItem(LogList.getnodedata(PaintInfo.Node)^)^).Img).cx+6;
SetBkMode(PaintInfo.Canvas.Handle, TRANSPARENT);
PaintInfo.Canvas.textout(PaintInfo.ContentRect.Left + x, 2, s);
end;
// inv2vis
procedure TvisibilityFrm.inv2normal;
var
cl: TRnQCList;
begin
cl := clFromBox(InvisBox);
normal.add(cl);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
// thisProto.readInvisible.remove(cl)
thisProto.readList(LT_INVISIBLE).remove(cl)
else
{$ENDIF UseNotSSI}
// thisICQ.removeFromInvisible(cl)
thisProto.RemFromList(LT_INVISIBLE, cl);;
cl.free;
end; // inv2normal
procedure TvisibilityFrm.inv2vis;
var
cl: TRnQCList;
begin
cl := clFromBox(InvisBox);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
begin
// thisICQ.readVisible.add(cl);
thisProto.readList(LT_VISIBLE).add(cl);
// thisICQ.readInvisible.remove(cl);
thisProto.readList(LT_INVISIBLE).remove(cl);
end
else
{$ENDIF UseNotSSI}
begin
thisProto.AddToList(LT_VISIBLE, cl);
thisProto.RemFromList(LT_INVISIBLE, cl);
end;
cl.free;
end;
procedure TvisibilityFrm.normal2vis;
var
cl: TRnQCList;
begin
cl := clFromBox(NormalBox);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
// thisICQ.readVisible.add(cl)
thisProto.readList(LT_VISIBLE).add(cl)
else
{$ENDIF UseNotSSI}
thisProto.AddToList(LT_VISIBLE, cl);
normal.remove(cl);
cl.free;
end; // normal2vis
procedure TvisibilityFrm.normal2inv;
var
cl: TRnQCList;
begin
cl := clFromBox(NormalBox);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
// thisICQ.readInvisible.add(cl)
thisProto.readList(LT_INVISIBLE).add(cl)
else
{$ENDIF UseNotSSI}
thisProto.AddToList(LT_INVISIBLE, cl);
normal.remove(cl);
cl.free;
end; // normal2inv
procedure TvisibilityFrm.vis2normal;
var
cl: TRnQCList;
begin
cl := clFromBox(VisibleBox);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
// thisICQ.readVisible.remove(cl)
thisProto.readList(LT_VISIBLE).remove(cl)
else
{$ENDIF UseNotSSI}
thisProto.RemFromList(LT_VISIBLE, cl);
// vis.remove(cl);
normal.add(cl);
cl.free;
end; // vis2normal
procedure TvisibilityFrm.vis2inv;
var
cl: TRnQCList;
begin
cl := clFromBox(VisibleBox);
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) and not TicqSession(thisProto.ProtoElem).useSSI then
begin
// thisICQ.readVisible.remove(cl);
thisProto.readList(LT_VISIBLE).remove(cl);
// thisICQ.readInvisible.add(cl);
thisProto.readList(LT_INVISIBLE).add(cl);
end
else
{$ENDIF UseNotSSI}
begin
thisProto.RemFromList(LT_VISIBLE, cl);
thisProto.AddToList(LT_INVISIBLE, cl);
end;
cl.free;
end; // vis2inv
procedure TvisibilityFrm.FormShow(Sender: TObject);
begin
theme.pic2ico(RQteFormIcon, PIC_VISIBILITY, icon);
applyTaskButton(self);
// thisProto := ActiveProto;
thisProto := Account.AccProto;
{ move2inv.Enabled := not useSSI;
move2normal.Enabled := not useSSI;
move2vis.Enabled := not useSSI; }
normal := thisProto.readList(LT_ROSTER).clone.remove(thisProto.readList(LT_INVISIBLE)).remove(thisProto.readList(LT_VISIBLE));
setUpBoxes;
end; // formshow
procedure TvisibilityFrm.unselect(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
begin
Sender.selected[Node] := False;
end;
procedure TvisibilityFrm.select(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
begin
Sender.selected[Node] := TRUE;
end;
procedure TvisibilityFrm.normalBoxClick(Sender: TObject);
begin
VisibleBox.IterateSubtree(NIL, unselect, NIL);
InvisBox.IterateSubtree(NIL, unselect, NIL);
end;
procedure TvisibilityFrm.NormalBoxFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
TVisRec(PVisRec(Sender.GetNodeData(Node))^).s := '';
end;
procedure TvisibilityFrm.invisibleBoxClick(Sender: TObject);
begin
VisibleBox.IterateSubtree(NIL, unselect, NIL);
NormalBox.IterateSubtree(NIL, unselect, NIL);
end;
procedure TvisibilityFrm.visibleBoxClick(Sender: TObject);
begin
InvisBox.IterateSubtree(NIL, unselect, NIL);
NormalBox.IterateSubtree(NIL, unselect, NIL);
end;
procedure TvisibilityFrm.move2invClick(Sender: TObject);
begin
if
{$IFDEF UseNotSSI}
(not(thisProto.ProtoElem is TicqSession) or TicqSession(thisProto.ProtoElem).useSSI) and
// icq.useSSI and
{$ENDIF UseNotSSI}
not thisProto.isOnline then
begin
OnlFeature(thisProto, False);
Exit;
end;
if NormalBox.SelectedCount > 0 then
normal2inv;
if VisibleBox.SelectedCount > 0 then
vis2inv;
if InvisBox.SelectedCount = 0 then
setUpBoxes;
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) then
TicqSession(thisProto.ProtoElem).updateVisibility;
// ICQ.updateVisibility;
{$ENDIF UseNotSSI}
saveListsDelayed := TRUE;
RnQmain.roster.repaint;
end;
procedure TvisibilityFrm.move2normalClick(Sender: TObject);
begin
if
{$IFDEF UseNotSSI}
// icq.useSSI and
(not(thisProto.ProtoElem is TicqSession) or TicqSession(thisProto.ProtoElem).useSSI) and
{$ENDIF UseNotSSI}
not thisProto.isOnline then
begin
OnlFeature(thisProto, False);
Exit;
end;
if InvisBox.SelectedCount > 0 then
inv2normal;
if VisibleBox.SelectedCount > 0 then
vis2normal;
if NormalBox.SelectedCount = 0 then
setUpBoxes;
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) then
TicqSession(thisProto.ProtoElem).updateVisibility;
// ICQ.updateVisibility;
{$ENDIF UseNotSSI}
saveListsDelayed := TRUE;
RnQmain.roster.repaint;
end;
procedure TvisibilityFrm.move2visClick(Sender: TObject);
begin
if
{$IFDEF UseNotSSI}
// icq.useSSI and
(not(thisProto.ProtoElem is TicqSession) or TicqSession(thisProto.ProtoElem).useSSI) and
{$ENDIF UseNotSSI}
not thisProto.isOnline then
begin
OnlFeature(thisProto, False);
Exit;
end;
if NormalBox.SelectedCount > 0 then
normal2vis;
if InvisBox.SelectedCount > 0 then
inv2vis;
if VisibleBox.SelectedCount = 0 then
setUpBoxes;
{$IFDEF UseNotSSI}
if (thisProto.ProtoElem is TicqSession) then
TicqSession(thisProto.ProtoElem).updateVisibility;
// ICQ.updateVisibility;
{$ENDIF UseNotSSI}
saveListsDelayed := TRUE;
RnQmain.roster.repaint;
end;
procedure TvisibilityFrm.selectAll(lb: TBaseVirtualTree);
// var
// i:integer;
begin
if lb <> NormalBox then
NormalBox.IterateSubtree(NIL, unselect, NIL);
if lb <> VisibleBox then
VisibleBox.IterateSubtree(NIL, unselect, NIL);
if lb <> InvisBox then
InvisBox.IterateSubtree(NIL, unselect, NIL);
lb.IterateSubtree(NIL, select, NIL);
end; // selectAll
procedure TvisibilityFrm.selectall1Click(Sender: TObject);
begin
selectAll(InvisBox)
end;
procedure TvisibilityFrm.Selectall2Click(Sender: TObject);
begin
selectAll(NormalBox)
end;
procedure TvisibilityFrm.Selectall3Click(Sender: TObject);
begin
selectAll(VisibleBox)
end;
procedure TvisibilityFrm.DestroyHandle;
begin
inherited
end;
end.