viewer.pas

类似QQ的源码程序

begin
    // Draw this month in the calandar
    for r := 1 to gridCal.RowCount - 1 do begin
        for c := 0 to gridCal.ColCount - 1 do
            gridCal.Cells[c,r] := '';
    end;
    
    r := 1;
    _m := MonthOf(d);
    _y := YearOf(d);
    pnlCalHeader.Caption := FormatDateTime('mmmm, yyyy', d);
    days := DaysInMonth(d);
    for i := 1 to days do begin
        cur := EncodeDate(_y, _m, i);
        // DayOfTheWeek, 1 = Monday, 7 = Sunday
        c := DayOfTheWeek(cur);
        if (c = 7) then begin
            inc(r);
            c := 0;
        end;
        gridCal.Cells[c, r] := IntToStr(i);
    end;
    MsgList.WideLines.Clear();
end;

{---------------------------------------}
procedure TfrmView.gridCalSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
var
    d: Word;
    td: TDateTime;
begin
    d := SafeInt(gridCal.Cells[ACol, ARow]);

    CanSelect := (d in _days);
    if (CanSelect) then begin
        td := EncodeDate(_y, _m, d);
        if (td <> _last) then
            SelectDay(td);
    end;
end;

{---------------------------------------}
procedure TfrmView.gridCalDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
    d: Word;
    txt: string;
    pw, ph, tw, th: integer;
begin
    txt := gridCal.Cells[ACol, ARow];
    d := SafeInt(txt);

    // Draw the cell..
    gridCal.Canvas.Brush.Style := bsSolid;
    if (gdFixed in State) then begin
        gridCal.Canvas.Brush.Color := clBtnFace;
        gridCal.Canvas.Font.Color := clBtnText;
    end
    else if (gdSelected in State) then begin
        gridCal.Canvas.Brush.Color := clHighlight;
        gridCal.Canvas.Font.Color := clHighlightText;
    end
    else begin
        gridCal.Canvas.Brush.Color := clWindow;
    end;

    // Draw the cell's BG
    gridCal.Canvas.FillRect(Rect);

    // If this day is bold, make it so..
    if (d in _days) then begin
        gridCal.Canvas.Font.Color := clWindowText;
        gridCal.Canvas.Font.Style := [fsBold];
    end
    else begin
        gridCal.Canvas.Font.Color := clGrayText;
        gridCal.Canvas.Font.Style := [];
    end;

    // center the text
    tw := gridCal.Canvas.TextWidth(txt);
    th := gridCal.Canvas.TextHeight(txt);
    pw := ((Rect.Right - Rect.Left) - tw) div 2;
    ph := ((Rect.Bottom - Rect.Top) - th) div 2;
    gridCal.Canvas.TextOut(Rect.Left + pw, Rect.Top + ph, txt);
end;

{---------------------------------------}
procedure TfrmView.btnNextMonthClick(Sender: TObject);
var
    i: integer;
    new: TDateTime;
    d: Word;
begin
    if (Sender = btnPrevMonth) then
        i := -1
    else
        i := +1;

    d := DayOf(_last);
    IncAMonth(_y, _m, d, i);
    new := EncodeDate(_y, _m, d);
    DrawCal(new);
    SelectMonth(new);
    _query();
end;

{---------------------------------------}
procedure TfrmView.cboJidChange(Sender: TObject);
begin
    //
end;

{---------------------------------------}
procedure TfrmView.FormDestroy(Sender: TObject);
begin
    if (_convs <> nil) then
        FreeAndNil(_convs);
end;

{---------------------------------------}
procedure TfrmView.lstConvData(Sender: TObject; Item: TListItem);
var
    idx: integer;
    c: TConversation;
    dtstr: Widestring;
begin
    //
    if ((_convs = nil) or (_start_idx = -1) or (_end_idx = -1)) then exit;

    idx := Item.Index + _start_idx;
    if (idx >= _convs.Count) then exit;

    c := TConversation(_convs[idx]);

    dtstr := TimeToStr(c.dt);
    Item.Caption := dtstr;
    Item.SubItems.Add(IntToStr(c.Count));
    Item.SubItems.Add(c.jid);
end;

{---------------------------------------}
procedure TfrmView._processSelectedConvs();
var
    i,r: integer;
    c: TConversation;
    tmp: TSQLiteTable;
    cmd, sql: string;
begin
    // Show this conversation
    MsgList.WideLines.Clear();
    if (lstConv.SelCount = 0) then exit;

    for i := 0 to lstConv.Items.Count - 1 do begin
        if (lstConv.Items[i].Selected) then begin
            c := TConversation(_convs[_start_idx + i]);
            cmd := 'SELECT * FROM jlogs WHERE jid="%s" AND thread="%s" AND date=%d ORDER BY time;';
            sql := Format(cmd, [c.jid, c.thread, Trunc(double(c.dt))]);
            tmp := db.GetTable(sql);
            for r := 0 to tmp.RowCount - 1 do begin
                DisplayMsg(tmp);
                tmp.Next();
            end;
        end;
    end;
end;

{---------------------------------------}
procedure TfrmView.lstConvSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
    _processSelectedConvs();
end;

{---------------------------------------}
procedure TfrmView.btnSearchClick(Sender: TObject);
var
    idx: integer;
    j: Widestring;
begin
    // perform the search for keywords
    idx := cboJid.ItemIndex;
    if (idx = 0) then begin
        j := '';
    end
    else begin
        j := cboJid.Text;
    end;

    if (j <> _jid) then begin
        _jid := j;
        if ((j <> '') and (cboJid.Items.IndexOf(j) = -1)) then begin
            cboJid.Items.Add(j);
            if (cboJid.Items.Count > 20) then
                cboJid.Items.Delete(1);
        end;
    end;

    _keywords.Delimiter := ' ';
    _keywords.DelimitedText := txtWords.Text;
    _query();
end;

{---------------------------------------}
procedure TfrmView.lstConvDataStateChange(Sender: TObject; StartIndex,
  EndIndex: Integer; OldState, NewState: TItemStates);
begin
    _processSelectedConvs();
end;

{---------------------------------------}
procedure TfrmView._query();
var
    minday, dd, i: integer;
    f, sql: string;
    w: boolean;
    tmp: TSQLiteTable;
    td: TDatetime;
    conv: TConversation;
begin
    // requery based on current settings
    w := false;
    f := '';
    dd := 0;

    sql := 'SELECT DISTINCT date FROM jlogs ';

    // if we are filtering a jid, do so..
    if (_jid <> '') then begin
        if (w) then f := f + ' AND ' else f := f + ' WHERE ';
        f := f + Format('jid="%s"', [_jid]);
        w := true;
    end;

    // if we have keywords, make it so..
    if (_keywords.Count > 0) then begin
        for i := 0 to _keywords.Count - 1 do begin
            if (w) then f := f + ' AND ' else f := f + ' WHERE ';
            f := f + Format('body like "%%%s%%"', [_keywords[i]]);
            w := true;
        end;
    end;
    
    // if we have a date filter, do so..
    if (_date_filter <> 2) then begin
        if (w) then f := f + ' AND ' else f := f + ' WHERE ';
        f := f + Format('date > %d and date < %d ', [_i1, _i2]);
    end;

    sql := sql + f;
    lblSQL.Caption := sql;
    tmp := db.GetTable(sql);
    _days := [];
    minday := 0;
    for i := 0 to tmp.RowCount - 1 do begin
        // make all of these days bold
        dd := StrToInt(tmp.Fields[0]);
        _days := _days + [DayOf(dd)];
        if (minday = 0) then minday := dd;
        tmp.Next();
    end;

    if (_convs <> nil) then begin
        FreeAndNil(_convs);
        lstConv.Items.Count := 0;
    end;
    tmp.Free();

    // get all the conversations
    // columns are
    // min_date, min_time, count, thread, jid
    sql := 'SELECT Min(date) as min_date, Min(time) as min_time, Count(body) as msg_count, thread, jid FROM jlogs';
    sql := sql + f;
    sql := sql + ' GROUP BY jid, date, thread ORDER BY min_date, min_time;';

    lblSQL.Caption := sql;
    tmp := db.GetTable(sql);

    _convs := TObjectList.Create();
    _convs.OwnsObjects := true;

    // 0 = min_date, 1 = min_time, 2 = msg_count, 3 = thread, 4 = jid]
    for i := 0 to tmp.RowCount - 1 do begin
        conv := TConversation.Create();
        if (_jid <> '') then
            conv.jid := _jid
        else
            conv.jid := tmp.Fields[4];
        conv.count := SafeInt(tmp.Fields[2]);
        conv.dt := SafeInt(tmp.Fields[0]) + StrToFloat(tmp.Fields[1]);
        conv.thread := tmp.Fields[3];
        _convs.Add(conv);
        tmp.Next();
    end;
    tmp.Free();

    _start_idx := -1;
    _end_idx := -1;
    _last := 0;

    DrawCal(_i1);
    MsgList.Widelines.Clear();

    // select the first day thats in this set
    if ((_date_filter = 0) and (dd > 0)) then begin
        td := minday;
        SelectDay(td);
    end
    else
        SelectAll();
end;

{---------------------------------------}
procedure TfrmView.cboDateFilterChange(Sender: TObject);
begin
    // select a date range..
    _date_filter := cboDateFilter.ItemIndex;
    _query();
end;

{---------------------------------------}
procedure TfrmView.btnDetailsClick(Sender: TObject);
begin
    if pnlSQL.Visible then begin
        pnlSQL.Visible := false;
        btnDetails.Caption := 'Show SQL';
    end
    else begin
        pnlSQL.Visible := true;
        btnDetails.Caption := 'Hide SQL';
    end;
end;

{---------------------------------------}
procedure TfrmView.cboJidSelect(Sender: TObject);
begin
    // Select this JID
    btnSearchClick(Sender);
end;

{---------------------------------------}
procedure TfrmView.lstConvDblClick(Sender: TObject);
var
    l: integer;
    c: TConversation;
begin
    // filter on this jid
    l := lstConv.ItemIndex;
    if ((l < 0) or (lstConv.Items.Count = 0)) then exit;

    c := TConversation(_convs[_start_idx + l]);
    if (c.jid <> _jid) then begin
        cboJid.Text := c.jid;
        btnSearchClick(Self);
    end;
end;

end.