ListViewの行に条件による文字への色付け
解決いつもお世話になります。
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.
ApplicationEventsのOnMessageで頑張ればいけるかも
ざっとしか見てないんで外してるかもですが。
ListView1AdvancedCustomDrawItemの中で危険値という値があるか検査してますが、この検査対象が別の場所で保存されたTListItemの値であって、今現在描画しようとしているListItemでは無いのが問題なのではないかと思います。
意図する動作がいまいちつかめないのですが、危険値と入っている行のみを赤で表示したいのであれば、検査する対象は変数ListViewに格納されている値では無く、イベントの引数であるItemに対して処理すれば良いかと思います。
初心者 様
ApplicationEventsのOnMessageってどこにあるのでしょうか？
探してみましたけども、見当たりませんでした。
au 様
他のイベントでと試してみましたが、やはり縦スクロールすると変更した文字色がデフォルトに戻ってしまいます。スクロールはどのイベントで検知できるのでしょうか？
まず、紛らわしい名前は付けるもんじゃありません。
それがバグを産みます。
ListView : TListItem;
そして、auさんが言ってる事を試しましょうね。
意味が分からなければ意味がわからないと書けば良いことです。
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
begin
if (Item <> nil) and
(Item.SubItems.Strings[1] = '危険値') then
Sender.Canvas.Font.Color := clRed;
end;
他にも突っ込みどころはありますが、これで問題は解決しませんか？
monaa 様
ご返信ありがとうございます。
上手くいきました。スクロールしても変更した文字色がデフォルトに戻らなくなりました。ありがとうございました。
下記の記述でau 様の解説も理解出来ました。『Item』の記述でピン！と来ました。上手く言えませんが、イベント内のprocedureの記述をよく見ないといけませんね。
コーディングの命名はこれから気をつけます。インターネットで見つけたサンプルを貼りつけたままで清書しておりませんでした。大変申し訳ありませんでした。(m_m) 本当にお恥ずかしく、情けないことでした。
>if (Item <> nil) and
> (Item.SubItems.Strings[1] = '危険値') then
| ツイート |  |