RnQ/RnQ/RnQdbDlg.pas

{
  This file is part of R&Q.
  Under same license
}
unit RnQdbDlg;
{$I RnQConfig.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms,
  ExtCtrls, ComCtrls, VirtualTrees, StdCtrls, Controls, Menus, VirtualTrees.HeaderPopup,
  RQMenuItem, RnQButtons, RnQDialogs;

{$I NoRTTI.inc}

type
  TRnQdbFrm = class(TForm)
    panel: TPanel;
    removenilhistoriesChk: TCheckBox;
    barPnl: TPanel;
    resizeBtn: TRnQSpeedButton;
    sbar: TStatusBar;
    dbTree: TVirtualDrawTree;
    purgeBtn: TRnQButton;
    reportBtn: TRnQButton;
    VTHPMenu: TVTHeaderPopupMenu;
    procedure dbTreeHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
    procedure dbTreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbTreeDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
    procedure FormShow(Sender: TObject);
    procedure resizeBtnClick(Sender: TObject);
    procedure reportBtnClick(Sender: TObject);
    procedure purgeBtnClick(Sender: TObject);
    procedure VTHPMenuPopup(Sender: TObject);
  private
    { Private declarations }
    menu: TRnQPopupMenu;
    AddAllToCL, AddToCL: TRQMenuItem;
    panelexpanded: boolean;
    report: string;
    procedure menuPopup(Sender: TObject);
    procedure ViewinfoClick(Sender: TObject);
    procedure addContactActn(Sender: TObject);
    procedure AddALLcontactsToList(Sender: TObject);
    procedure openChat(Sender: TObject);
    procedure deleteC(Sender: TObject);
  public
    procedure updateList;
    // function  currentContact:Tcontact;
    procedure minimizePanel;
    procedure restorePanel;
    { Public declarations }
  end;

var
  RnQdbFrm: TRnQdbFrm;

implementation

{$R *.dfm}

uses
  RnQLangs, RnQStrings, RDUtils,
  RnQSysUtils, RnQPics,
  RQUtil, RDGlobal, RQThemes, RnQMenu, menusUnit,
  Protocols_all,
  globalLib, chatDlg, utilLib, themesLib,
  ICQCommon, ICQSession, ICQContacts,
  Protocol_ICQ, icqConsts, SQLiteDB;

const
  COLUMN_UID = 0;
  COLUMN_DISPL = 1;
  COLUMN_IMP = 2;
  COLUMN_AVTMD5 = 3;
  COLUMN_BIRTHDAY = 4;
  COLUMN_DAYS2BD = 5;
  COLUMN_LASTLOG = 6;

procedure TRnQdbFrm.minimizePanel;
begin
  resizeBtn.ImageName := PIC_DOWN;
  if not panelexpanded then
    exit;
  resizeBtn.width := theme.getPicSize(RQteButton, PIC_DOWN).cx + 4;
  resizeBtn.Repaint;
  panel.visible := FALSE;
  height := height - panel.height;
  panelexpanded := FALSE;
end; // minimizePanel

procedure TRnQdbFrm.restorePanel;
begin
  resizeBtn.ImageName := PIC_UP;
  if panelexpanded then
    exit;
  resizeBtn.width := theme.getPicSize(RQteButton, PIC_UP).cx + 4;
  resizeBtn.Repaint;
  height := height + panel.height;
  barPnl.visible := FALSE;
  panel.visible := TRUE;
  barPnl.visible := TRUE;
  panelexpanded := TRUE;
end; // minimizePanel

procedure TRnQdbFrm.updateList;
var
  // i,j:integer;
  c: TICQContact;
  // cl:TcontactList;
begin
  if not visible then
    exit;
  dbTree.Clear;
  dbTree.BeginUpdate;

  for c in TICQSession.ContactsDB do
    dbTree.AddChild(nil, c);
  dbTree.EndUpdate;
  sbar.simpleText := getTranslation('contacts in db: %d', [TList(TICQSession.ContactsDB).count]);

  dbTree.SortTree(dbTree.Header.SortColumn, dbTree.Header.SortDirection);
end; // updatelist

procedure TRnQdbFrm.purgeBtnClick(Sender: TObject);

  procedure purgeHistories;
  var
    uids: TUIDS;
    uid: TUID;
  begin
    if not removenilhistoriesChk.checked then
      exit;

    uids := SQLDB.GetExistingChats;
    for uid in uids do
    if unexistant(uid) then
    begin
      SQLDB.DeleteChat(uid);
      report := report + getTranslation('history %s deleted', [uid]) + CRLF
    end;
  end; // purgeHistories

  procedure purgeContacts;
  var
    c: TICQContact;
    s: String;
    i: Integer;
    removeIt: boolean;
  begin
    for i := TList(TICQSession.ContactsDB).count - 1 downto 0 do
    begin
      c := TICQSession.ContactsDB.getAt(i);
      removeIt := unexistant(c.uid) and not TCE(c.data^).dontdelete;
      if removeIt then
      begin
        s := c.displayed + ' (UIN ' + c.uid + ')';
        TICQSession.ContactsDB.remove(c);
        report := report + getTranslation('contact %s deleted', [s]) + CRLF;
        { The c object should be freed but, since objects are shared, we would
          { need a garbage collector system. since we are talking about few kbytes
          { i think it is fair to send back this to the next quit ;)
        }
      end;
    end;
  end; // purgeContacts

begin
  report := report + '---' + getTranslation('Start') + ' ' + datetimeToStr(now) + CRLF;
  purgeContacts;
  updateList;
  purgeHistories;
  report := report + '---' + getTranslation('End') + ' ' + datetimeToStr(now) + CRLF;
  reportBtn.visible := True;
end;

procedure TRnQdbFrm.reportBtnClick(Sender: TObject);
begin
  viewTextWindow(getTranslation('Report'), report)
end;

procedure TRnQdbFrm.resizeBtnClick(Sender: TObject);
begin
  if panelexpanded then
    minimizePanel
  else
    restorePanel
end;

procedure TRnQdbFrm.FormShow(Sender: TObject);
begin
  // panelexpanded :=
  minimizePanel;
  theme.pic2ico(RQteFormIcon, PIC_DB, icon);
  applyTaskButton(self);
  updateList;
end;

procedure TRnQdbFrm.dbTreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
  var Result: Integer);
var
  i: Int64;
  c1, c2: TICQContact;
begin
  c1 := TICQContact(Sender.GetNodeData(Node1)^);
  c2 := TICQContact(Sender.GetNodeData(Node2)^);

  case Column of
    COLUMN_UID:
      if TryStrToInt64(c1.uid, i) and TryStrToInt64(c2.uid, i) then
        Result := compareInt(StrToInt64(c1.uid), StrToInt64(c2.uid))
      else
        Result := CompareText(c1.uid, c2.uid);
    COLUMN_DISPL:
      Result := CompareText(c1.displayed, c2.displayed);
    COLUMN_IMP:
      Result := CompareText(c1.lclImportant, c2.lclImportant);
    COLUMN_AVTMD5:
      Result := CompareText(ticqContact(c1).IconID, ticqContact(c2).IconID);
    COLUMN_BIRTHDAY:
      Result := CompareDate(c1.GetBDay, c2.GetBDay);
    COLUMN_DAYS2BD:
      Result := compareInt(c1.Days2BD, c2.Days2BD);
    COLUMN_LASTLOG:
      Result := CompareDate(c1.lastTimeSeenOnline, c2.lastTimeSeenOnline);
  end;
end;

procedure TRnQdbFrm.dbTreeDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
var
  cnv: TCanvas;
  c: TICQContact;
  dd: tdate;
  i: SmallInt;
  // x   : Integer;
begin
  PaintInfo.Canvas.Font.Assign(Application.DefaultFont);
  cnv := PaintInfo.Canvas;
  c := TICQContact(Sender.GetNodeData(PaintInfo.node)^);
  if vsSelected in PaintInfo.node^.States then
    cnv.Font.Color := clHighlightText
  else
    cnv.Font.Color := clWindowText;
  if c.isInRoster then
    cnv.Font.Style := [fsBold]
  else
    cnv.Font.Style := [];
  case PaintInfo.Column of
    COLUMN_UID: // UIN
      cnv.textout(PaintInfo.ContentRect.Left, 2, c.uid);
    COLUMN_DISPL: // Displayed
      cnv.textout(PaintInfo.ContentRect.Left, 2, c.displayed);
    COLUMN_IMP: // Important string
      cnv.textout(PaintInfo.ContentRect.Left, 2, c.lclImportant);
    COLUMN_AVTMD5: // Avatar MD5
      cnv.textout(PaintInfo.ContentRect.Left, 2, str2hexU(ticqContact(c).IconID));
    COLUMN_BIRTHDAY:
      begin
        dd := c.GetBDay;
        if dd > 0 then
          cnv.textout(PaintInfo.ContentRect.Left, 2, DateToStr(dd));
      end;
    COLUMN_DAYS2BD:
      begin
        i := c.Days2BD;
        if (i >= 0) and (i < 1000) then
          cnv.textout(PaintInfo.ContentRect.Left, 2, intToStr(i))
          // else
          // cnv.textout(PaintInfo.ContentRect.Left,2, '');
      end;
    COLUMN_LASTLOG:
      begin
        dd := c.lastTimeSeenOnline;
        if dd > 0 then
          cnv.textout(PaintInfo.ContentRect.Left, 2, datetimeToStr(dd));
      end;
  end;
end;

procedure TRnQdbFrm.dbTreeHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
begin
  if HitInfo.Button = mbLeft then
  begin
    if HitInfo.Column = Sender.SortColumn then
      if Sender.SortDirection = sdAscending then
        Sender.SortDirection := sdDescending
      else
        Sender.SortDirection := sdAscending
    else
      Sender.SortColumn := HitInfo.Column;
  end;
end;

procedure TRnQdbFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  RnQdbFrm := nil;
  Action := caFree;
end;

procedure TRnQdbFrm.ViewinfoClick(Sender: TObject);
var
  cnt: TICQContact;
begin
  with dbTree do
  if focusedNode <> nil then
  begin
    cnt := TICQContact(getnodedata(focusednode)^);
    //if cnt is TICQContact then
    //  viewInfoAbout(TICQContact(cnt));
    if Assigned(cnt) then
      cnt.ViewInfo;
  end;
end;

procedure TRnQdbFrm.VTHPMenuPopup(Sender: TObject);
begin
  applyCommonSettings(TControl(Sender));
end;

procedure TRnQdbFrm.addContactActn(Sender: TObject);
begin
  with dbTree do
    if focusedNode <> nil then
      addToRoster(TICQContact(GetNodeData(focusedNode)^), (Sender as TRQMenuItem).tag)
end;

procedure TRnQdbFrm.menuPopup(Sender: TObject);
var
  curContact: TICQContact;
  i: Integer;
begin
  curContact := nil;
  with dbTree do
    if focusedNode <> nil then
      curContact := TICQContact(GetNodeData(focusedNode)^)
    else
      curContact := nil;
  if curContact = nil then
  begin
    for i := 0 to menu.Items.count - 1 do
      if menu.Items.Items[i] <> AddAllToCL then
        menu.Items.Items[i].Enabled := FALSE;
    // AddToCL.visible:=false;
    exit;
  end
  else
    for i := 0 to menu.Items.count - 1 do
      if menu.Items.Items[i] <> AddAllToCL then
        menu.Items.Items[i].Enabled := TRUE;

  // if (row>=1) and (row <= contactsDB.count) then
  begin
    // grid.row:=row;
    AddToCL.visible := Assigned(curContact) and not curContact.isInRoster;
    if AddToCL.visible then
      addGroupsToMenu(self, AddToCL, addContactActn, TRUE);
  end;
end;

procedure TRnQdbFrm.AddALLcontactsToList(Sender: TObject);
var
  cnt: TICQContact;
begin
  if messageDlg(getTranslation('Are you sure?'), mtConfirmation, [mbYes, mbNo]) = mrNo then
    exit;
  with TICQSession.ContactsDB, TList(TICQSession.ContactsDB) do
    for cnt in TICQSession.ContactsDB do
      addToRoster(cnt);
end;

procedure TRnQdbFrm.openChat(Sender: TObject);
begin
  with dbTree do
    if focusedNode <> nil then
      chatFrm.openOn(TICQContact(GetNodeData(focusedNode)^));
end;

procedure TRnQdbFrm.deleteC(Sender: TObject);
var
  // i: Integer;
  na: TNodeArray;
  n: PVirtualNode;
begin
  na := dbTree.GetSortedSelection(TRUE);
  for n in na do
  begin
    // contactsDB.remove(Tcontact(n.Data));
    TICQSession.ContactsDB.remove(TICQContact(n.GetData^));
  end;
  dbTree.DeleteSelectedNodes

  // grid.
  // for i :=
  // begin result:=Tcontact(grid.objects[0,grid.row]) end;
  // updateList;
end;

procedure TRnQdbFrm.FormCreate(Sender: TObject);
var
  // mi : TRQMenuItem;
  i: Integer;
begin
  dbTree.NodeDataSize := SizeOf(TICQContact);
  menu := TRnQPopupMenu.Create(self);
  dbTree.PopupMenu := menu;
  menu.OnPopup := menuPopup;
  dbTree.OnDblClick := ViewinfoClick;
  AddToMenu(menu.Items, 'View info', PIC_INFO, TRUE, ViewinfoClick);
  AddToCL := AddToMenu(menu.Items, 'Add to contact list',
    // PIC_ADD_CONTACT, false, addContactActn);
    PIC_ADD_CONTACT, FALSE);
  AddAllToCL := AddToMenu(menu.Items, 'Add ALL contacts to the list', PIC_ADD_CONTACT, FALSE, AddALLcontactsToList);
  AddToMenu(menu.Items, 'Open chat', PIC_MSG, FALSE, openChat);
  AddToMenu(menu.Items, 'Delete', PIC_DELETE, FALSE, deleteC);

  panelexpanded := TRUE;
  report := '';
  for i := 0 to dbTree.Header.Columns.count - 1 do
    dbTree.Header.Columns.Items[i].Text := getTranslation(dbTree.Header.Columns.Items[i].Text);
end;

procedure TRnQdbFrm.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to menu.Items.count - 1 do
    menu.Items[0].Free;
  menu.Free;
  dbTree.Clear;
end;

end.