ListViewの行に条件による文字への色付け (ID:43382)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

いつもお世話になります。
  ListViewの行に条件による文字への色付けのプログラムを組んでいます。
  色付けには成功したのですが、ListViewの縦スクロールバーをマウスで動かすと、色付けした色がデフォルト色に戻ってしまいましす。これを防ぐ方法はありますでしょうか？
  環境はWindowsXP、Delphi2007 for Win32です。ソースは下記のとおりです。
  ベテランの皆様でお時間を許して頂ける方がもしいらっしゃいましたら、どうかアドバイスをお願い致します。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
  private
    { Private declarations }
    SelectFolder : string;

public
    { Public declarations }
  end;

var
  Form1    : TForm1;
  Rec      : TSearchRec;
  ListView : TListItem;

implementation

{$R *.dfm}
//---------------------------------------------------------------------------
function EnumFileFromDir(Dir: string):string;
begin
  //フォルダ名の最後に \ がついていなければつける
  Dir :=IncludeTrailingPathDelimiter(Dir);

if FindFirst(Dir + '*.*', faAnyFile, Rec) = 0 then
   begin
    try
     repeat
      if Rec.Attr and faDirectory <> 0 then
       begin
        if (Rec.Name='.') or (Rec.Name='..') then
         begin
          Continue;
          //フォルダなら再度この関数を呼び出し
          Result := EnumFileFromDir(Dir + Rec.Name);
         end
       end
        else  //ファイルなら追加
         begin
          ListView := Form1.ListView1.Items.Add;
          ListView.Caption := Rec.Name;
          ListView.SubItems.Add(IntToStr(Rec.Size));
          if rec.Size >= 2000000 then
            ListView.SubItems.Add('危険値')
           else
            ListView.SubItems.Add('正常値');
          Application.ProcessMessages;
         end
     until (FindNext(Rec) <> 0) or (Result <> '');
    finally
     FindClose(Rec);
    end
   end;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
 RootFolder   : string;
begin
 if SelectDirectory('フォルダの指定', RootFolder,SelectFolder) then
  begin
   IncludeTrailingPathDelimiter(SelectFolder);
   Form1.Edit1.Text := SelectFolder;
  end;
 SelectFolder := Form1.Edit1.Text;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
begin
// FreeAndNil(ListView1);
// FreeAndNil(SelectFolder);
// FreeAndNil(Rec);
 Application.Terminate;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
var
 Time         : Cardinal;
begin
 EnumFileFromDir(SelectFolder);
 Time := GetTickCount;
 MessageBox(Handle,
            PChar('処理時間: '+IntToStr(GetTickCount -Time)+ #10#13+
                  '見つかったファイル数: '+IntToStr(ListView1.Items.Count)),
                  '確認', MB_OK);
end;
//---------------------------------------------------------------------------
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
begin
 if ListView.SubItems.Strings[1] = '危険値' then
  Sender.Canvas.Font.Color := clRed;
end;
//---------------------------------------------------------------------------
end.

←解決時は質問者本人がここをチェックしてください。

戻る