viewer.pas

类似QQ的源码程序

unit Viewer;

{
    Copyright 2004, Peter Millard

    This file is part of Exodus.

    Exodus 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.

    Exodus 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 Exodus; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

interface

uses
    SQLiteTable,
    Contnrs, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls, ComCtrls, ExRichEdit,
    TntStdCtrls, Buttons, TntExtCtrls, Grids, TntGrids, TntComCtrls,
    RichEdit2;

type
  TMonthDay = 1..31;

  TConversation = class
    jid: Widestring;
    thread: Widestring;
    count: integer;
    msgs: TSQLiteTable;
    dt: TDateTime;
  end;

  TfrmView = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    pnlCal: TPanel;
    pnlToday: TTntPanel;
    pnlCalHeader: TTntPanel;
    btnPrevMonth: TSpeedButton;
    btnNextMonth: TSpeedButton;
    gridCal: TTntStringGrid;
    TntLabel1: TTntLabel;
    cboJid: TTntComboBox;
    TntLabel2: TTntLabel;
    txtWords: TTntEdit;
    pnlRight: TPanel;
    MsgList: TExRichEdit;
    Splitter1: TSplitter;
    btnSearch: TTntButton;
    lstConv: TTntListView;
    TntLabel3: TTntLabel;
    cboDateFilter: TTntComboBox;
    pnlSQL: TPanel;
    lblSQL: TTntLabel;
    btnDetails: TTntButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure gridCalSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure gridCalDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure btnNextMonthClick(Sender: TObject);
    procedure cboJidChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lstConvData(Sender: TObject; Item: TListItem);
    procedure lstConvSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure btnSearchClick(Sender: TObject);
    procedure lstConvDataStateChange(Sender: TObject; StartIndex,
      EndIndex: Integer; OldState, NewState: TItemStates);
    procedure cboDateFilterChange(Sender: TObject);
    procedure btnDetailsClick(Sender: TObject);
    procedure cboJidSelect(Sender: TObject);
    procedure lstConvDblClick(Sender: TObject);
  private
    { Private declarations }
    _jid: String;
    _days: set of TMonthDay;
    _last: TDatetime;
    _m: Word;
    _y: Word;
    _i1: integer;
    _i2: integer;
    _keywords: TStringlist;
    _start_idx: integer;
    _end_idx: integer;
    _date_filter: integer;

    // persistent result sets
    _convs: TObjectList;

    procedure DisplayMsg(tmp: TSQLiteTable);
    procedure SelectMonth(d: TDateTime);
    procedure SelectDay(d: TDateTime);
    procedure SelectAll();
    procedure DrawCal(d: TDateTime);
    
    procedure _processSelectedConvs();
    procedure _query();
    procedure _updateConvList();

  public
    { Public declarations }
    db: TSQLiteDatabase;

    procedure ShowJid(jid: Widestring);
    procedure ShowSearch();
  end;

var
  frmView: TfrmView;

implementation

uses
    SQLUtils, SQLPlugin, XMLUtils, DateUtils;

{$R *.dfm}

{---------------------------------------}
{---------------------------------------}
procedure TfrmView.ShowJid(jid: Widestring);
begin
    cboJid.Items.Add(jid);
    cboJid.ItemIndex := 1;
    _jid := UTF8Encode(jid);
    _last := 0;
    SelectMonth(Now());
    _query();
    SelectDay(Now());
end;

{---------------------------------------}
{---------------------------------------}
procedure TfrmView.ShowSearch();
begin
    cboJid.ItemIndex := 0;
    _jid := '';
    _last := 0;
    SelectMonth(Now());
    _query();
    SelectDay(Now());
end;

{---------------------------------------}
{---------------------------------------}
procedure TfrmView._updateConvList();
var
    cnt: integer;
begin
    //
    if (_end_idx > -1) then
        cnt := (_end_idx - _start_idx) + 1
    else
        cnt := 0;
    lstConv.Items.Clear();
    lstConv.Items.Count := cnt;
    lstConv.Invalidate();
    lstConv.Refresh();

    // Select the first thing in the list automatically.
    if (cnt > 0) then
        lstConv.ItemIndex := 0;
end;

{---------------------------------------}
procedure TfrmView.SelectAll();
var
    i: integer;
    conv: TConversation;
begin
    if ((_convs = nil) or (_convs.Count = 0)) then begin
        lstConv.Items.Count := 0;
        lstConv.Invalidate();
        lstConv.Refresh();
        exit;
    end;

    if (_date_filter = 1) then begin
        for i := 0 to _convs.Count - 1 do begin
            conv := TConversation(_convs[i]);
            if ((Trunc(conv.dt) >= _i1) and (Trunc(conv.dt) <= _i2)) then begin
                if (_start_idx = -1) then _start_idx := i;
                _end_idx := i;
            end;
        end;
    end
    else begin
        _start_idx := 0;
        _end_idx := _convs.Count - 1;
    end;

    _updateConvList();
end;

{---------------------------------------}
procedure TfrmView.SelectDay(d: TDateTime);
var
    c1, r, c, i: integer;
    td, d1: TDateTime;
    conv: TConversation;
    sel: TGridRect;
begin
    _date_filter := 0;
    td := Trunc(d);
    if (_last = td) then exit;

    // Clear out existing
    _start_idx := -1;
    _end_idx := -1;
    MsgList.WideLines.Clear();

    // hunt thru _convs to find the range     
    if ((_convs = nil) or (_convs.Count = 0)) then begin
        lstConv.Items.Count := 0;
        lstConv.Invalidate();
        lstConv.Refresh();
        exit;
    end;

    for i := 0 to _convs.Count - 1 do begin
        conv := TConversation(_convs[i]);
        if (Trunc(conv.dt) = td) then begin
            if (_start_idx = -1) then _start_idx := i;
            _end_idx := i;
        end;
    end;

    _updateConvList();
    
    _last := td;

    // find out where the first of this month is..
    d1 := EncodeDate(YearOf(d), MonthOf(d), 1);
    c1 := DayOfWeek(d1) - 1;

    c := DayOfWeek(d) - 1;
    r := NthDayOfWeek(d);

    // if todays day of the week is before the day of the week of the
    // first of the month, then we aren't on the first "row", we're on the
    // "second" row (ie, Jan 1, is a Friday, it's currently Jan 3, which
    // is the following sunday, which is row 2).
    if (c < c1) then r := r + 1;

    sel.top := r;
    sel.bottom := r;
    sel.left := c;
    sel.right := c;
    gridCal.Selection := sel;

end;

{---------------------------------------}
procedure TfrmView.SelectMonth(d: TDateTime);
var
    y, m:  Word;
    d1, d2: TDateTime;
begin
    y := YearOf(d);
    m := MonthOf(d);
    d1 := EncodeDate(y, m, 1);
    d2 := EncodeDate(y, m, DaysInMonth(d1));
    _i1 := Trunc(d1);
    _i2 := Trunc(d2);
end;

{---------------------------------------}
procedure TfrmView.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Action := caFree;
end;

{---------------------------------------}
procedure TfrmView.DisplayMsg(tmp: TSQLiteTable);
var
    d: integer;
    t: double;
    txt: WideString;
    ts: double;
    nick: Widestring;
    c: TColor;
begin
    txt := UTF8Decode(sql2str(tmp.Fields[F1_BODY]));

    d := StrToInt(tmp.Fields[F1_DATE]);
    t := StrToFloat(tmp.Fields[F1_TIME]);
    ts := d + t;

    // Make sure we're inputting text in Unicode format.
    MsgList.InputFormat := ifUnicode;
    MsgList.SelStart := Length(MsgList.WideLines.Text);
    MsgList.SelLength := 0;

    MsgList.SelAttributes.Color := clGray;
    MsgList.WideSelText := '[' + FormatDateTime('h:mm am/pm', ts) + ']';

    nick := UTF8Decode(tmp.Fields[F1_NICK]);
    if (nick = '') then begin
        c := clGreen;
        MsgList.SelAttributes.Color := c;
        MsgList.WideSelText := '' + txt;
    end
    else begin
        if (Uppercase(tmp.Fields[F1_OUT]) = 'TRUE') then
            c := clRed
        else
            c := clBlue;

        MsgList.SelAttributes.Color := c;
        MsgList.WideSelText := '<' + nick + '>';

        MsgList.SelAttributes.Color := clDefault;
        MsgList.WideSelText := ' ' + txt;
    end;

    MsgList.WideSelText := #13#10;
end;

{---------------------------------------}
procedure TfrmView.FormCreate(Sender: TObject);
var
    i, cw: integer;
begin
    _last := 0;
    _start_idx := -1;
    _end_idx := -1;
    _keywords := TStringlist.Create();
    
    gridCal.Cells[0, 0] := 'S';
    gridCal.Cells[1, 0] := 'M';
    gridCal.Cells[2, 0] := 'T';
    gridCal.Cells[3, 0] := 'W';
    gridCal.Cells[4, 0] := 'T';
    gridCal.Cells[5, 0] := 'F';
    gridCal.Cells[6, 0] := 'S';

    _convs := nil;
    cw := Trunc(gridCal.Width / 7.0);
    for i := 0 to 6 do
        gridCal.ColWidths[i] := cw;
    DrawCal(Now());
    pnlToday.Caption := 'Today: ' + DateToStr(Now());
end;

{---------------------------------------}
procedure TfrmView.DrawCal(d: TDateTime);
var
    cur: TDateTime;
    days: Word;
    r, c, i: integer;