RealICQClient/Log/CodingFrom.pas

unit CodingFrom;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtDlgs;

type
  TCodingLoggerForm = class(TForm)
    lv1: TListView;
    btn1: TButton;
    dlg1: TSaveTextFileDialog;
    procedure btn1Click(Sender: TObject);
    procedure lv1AdvancedCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
  private
    { Private declarations }
  public
    procedure InsertLog(AMessage, ACode, ALoginName, AStrLevel: string);
  end;

var
  CodingLoggerForm: TCodingLoggerForm;

implementation

{$R *.dfm}

{ TCodingLoggerForm }

procedure TCodingLoggerForm.btn1Click(Sender: TObject);
var
  logFile: TFileStream;
  I: Integer;
  str: string;
  strStream: TStringStream;
begin
  if dlg1.Execute then
  begin
    logFile := TFileStream.Create(dlg1.FileName, fmCreate);
    strStream := TStringStream.Create('');
    try
      for I := 0 to lv1.Items.Count - 1 do
      begin
        str := Format('等级：%s；来源：%s；登录名：%s；内容：%s' + #13#10, [lv1.Items[i].SubItems[2], lv1.Items[i].SubItems[0], lv1.Items[i].SubItems[1], lv1.Items[i].Caption]);
        strStream.WriteString(str);
      end;
      strStream.Position := 0;
      logFile.CopyFrom(strStream, strStream.Size);
    finally
      FreeAndNil(logFile);
      FreeAndNil(strStream);
    end;
  end;
end;

procedure TCodingLoggerForm.InsertLog(AMessage, ACode, ALoginName, AStrLevel: string);
var
  tmpStrs: TStringList;
begin
  with lv1.Items.Insert(0) do
  begin
    Caption := AMessage;
    SubItems.Add(ACode);
    SubItems.Add(ALoginName);
    SubItems.Add(AStrLevel);
  end;
end;

procedure TCodingLoggerForm.lv1AdvancedCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
begin
  if (Item.SubItems.Count < 3) then
    Exit;
  if (SameText(Item.SubItems[2], 'error')) then
  begin
    Sender.Canvas.Brush.Color := $0000FF;
    Sender.Canvas.Font.Color := clWhite;
  end
end;

end.