リスト項目の独自描画が何故か時間が掛かる

解決

Delphi大好き 2011-01-07 21:54:09 No: 39805

開発環境は、Vista、XP、 Delphi3Pro＆3.1Proです。

予定帳兼日記帳を作りました。
リストボックスに日付を描画しするのですが、
独自描画して文字列を一文字分右にずらして表示して、
テキストがある日付にはその左端に丸を描画します。

実質完成しているのですが、困っている事があります。

ウルトラモバイルノートの富士通Loox U/b50（Vista ATOM160）と、
ミニノートのビクターMP-XP7310(XP SP3 centrino PentiumM1.0Ghz)
で最初は開発し、リストの表示も瞬時に描画されます。

しかし、
パナソニックレッツノート CF-W8（Vista centrino2 core2Duo1.40ghz）
に移して使うと、
リストの描画が４秒近くと遅く、非常に使いづらいです。
下のコードがそのリスト描画部です。

これを改めて書き直し、効率化しましたが、
半分の２秒になっただけで、依然として遅いです。

色々いじって見たところ、丸を表示するループに時間が掛かっているようです。

何故ロースペックのPCでは高速に表示されるのに、
ハイスペックのPCでは遅くなるのでしょうか？
理由が全く判りません。

レッツノートでメインに使う為に作ったのに、肝心のPCでは全く使い物にならず・・・。困ってます。

どなたかお知恵のある方、どうかお知恵を拝借くださると助かりますｍ（＿＿）ｍ。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  i,i1:integer;
begin
  ListBox1.Canvas.Brush.Color := clwindow;
  ListBox1.Canvas.FillRect(rect);
  ListBox1.Canvas.Font.Color := clwindowtext;
  ListBox1.Canvas.TextOut(rect.Left + 12, rect.Top, ListBox1.Items[index]);

  if odSelected in State then begin
    filelistbox1.Update;
    ListBox1.Canvas.Brush.Color := clyellow;
    ListBox1.Canvas.Font.Color := clwindowtext;
    ListBox1.Canvas.FillRect(rect);
    ListBox1.Canvas.TextOut(rect.Left + 12, rect.Top, ListBox1.Items[index]);
  end;

  i := 0;
  filelistbox1.Update;
  while filelistbox1.Items.Count >  i do begin
    i1 := ListBox1.Items.IndexOf( changefileext(filelistbox1.Items[i], ''));
    if index = i1 then begin
      ListBox1.Canvas.Brush.Color := clred;
      ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 2, rect.Left + 10, rect.Top + 10);
    end;
    i := i + 1;
  end;

  i := 0;
  filelistbox3.Update;
  while filelistbox3.Items.Count >  i do begin
    i1 := ListBox1.Items.IndexOf( changefileext(filelistbox3.Items[i], ''));
    if index = i1 then begin
      ListBox1.Canvas.Brush.Color := clblue;
      ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 10, rect.Left + 10, rect.Top + 20);
    end;
    i := i + 1;
  end;
end;

au 2011-01-07 22:51:47 No: 39806

Delphi3は持ってないので、どんな関数が使えるか知らないですが
ファイルがあるかどうかのチェックを FileExists 関数なり FileAge 関数なりを使ってチェックするようにすればループは必要なくなるんでましにならんでしょうか？

take 2011-01-07 23:35:05 No: 39807

ループやFileListBoxを使わないようにすればいけるかな
s1,s3の式は適当なので仕様に合わせてください。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  i,i1:integer;
  s1,s3 : string;
begin
  ListBox1.Canvas.Brush.Color := clwindow;
  ListBox1.Canvas.FillRect(rect);
  ListBox1.Canvas.Font.Color := clwindowtext;
  ListBox1.Canvas.TextOut(rect.Left + 12, rect.Top, ListBox1.Items[index]);

  if odSelected in State then begin
    ListBox1.Canvas.Brush.Color := clyellow;
    ListBox1.Canvas.Font.Color := clwindowtext;
    ListBox1.Canvas.FillRect(rect);
    ListBox1.Canvas.TextOut(rect.Left + 12, rect.Top, ListBox1.Items[index]);
  end;

  s1 := ListBox1.Items[Index] + '.txt';  // fileelistbox1のフォルダや拡張子を
  s3 := ListBox1.Items[Index] + '.dat';  // fileelistbox3のフォルダや拡張子を

  if FileExists(s1) then begin
    ListBox1.Canvas.Brush.Color := clred;
    ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 2, rect.Left + 10, rect.Top + 10);
  end;

  if FileExists(s3) then begin
    ListBox1.Canvas.Brush.Color := clblue;
    ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 10, rect.Left + 10, rect.Top + 20);
  end;
end;

tor 2011-01-08 01:52:37 No: 39808

基本的に、描画処理は描画にだけ専念して、他の余計な処理はしないのがセオリーです。
（リストの項目を選択したりすると、DrawItemは何度も何度も繰り返し呼び出される場合があります）
描画処理の中で他のリストボックスをUpdateしたり、項目を検索したりするのが重いと思われるので、
ファイルの有無を判定したりするのはどこか他でやっておいて、DrawItemではその結果を使って描画するだけにした方が良いのではないでしょうか。

リストボックスの各項目には、Items.Objects[i] という形で任意のデータを保存しておくことができます。
これを使って判定結果を保存するという方法があります。

// 適当なタイミング（ファイルリストを更新した時など）で判定を行なう
for i := 0 to ListBox1.Count - 1 do
begin
  // 各ファイルの有無を判定
  if ListBox.Items[i]がfilelistbox1にある then judge := 1
  else if ListBox.Items[i]がfilelistbox3にある then judge := 3
  else judge := 0;
  // その結果を保存
  ListBox1.Items.Objects[i] := TObject(judge);
end;
ListBox1.Invalidate; // ListBoxの表示を更新する

// DrawItemの処理
...
  // 判定結果を取り出す
  judge := Integer(ListBox1.Items.Objects[Index]);
  // その内容に応じて描画
  if judge = 1 then 赤丸を描画
  else if judge = 3 then 青丸を描画;
...

monaa 2011-01-08 01:58:17 No: 39809

機種依存性の描画速度問題は以前
ハードウェアグラフィックアクセラレータのバグを経験したことがあります。
とりあえず、ハードウェアグラフィックアクセラレータを無効にしてみてください。
ただ、そうするとOS全体に影響を及ぼします。
私の経験だと、グラフィックアクセラレータがBitBltを横取りするときに
24,32bitビットマップ以外で極端に遅くなる現象を突き止めたことがあります。
ですので、描画するとき24,32bitビットマップを明示することで改善しました。

もちろん必ずこれが原因とは言い切れませんが、
とりあえず一案として確認してみることをおすすめします。

Delphi大好き 2011-01-08 07:32:42 No: 39810

皆さんありがとうございます、早速試してみました。

takeさんの方法から試したのですが、それで一発で解決しました。
大変感謝しています。

以前と比べて非常に高速です。
他のPCと遜色ない速度で動いています。
非常に勉強になりました。

安直に動作を考えずに組んじゃうと、後々大変になるのですね。

torさんのおっしゃる通り、以前のコードでは凄い回数繰り返してました。
カウントして計ったのですが、起動から読み込み完了までの間、1200回前後ループしてました・・・。
電気の無駄遣いもいいとこですね＾＾；

monaaさんのご意見もとても参考になりました。
同じバージョンのWindowsなら何でも一緒、とばかり思い込んでたので、
今回の件は大変参考になりました。

ハードウェアグラフィックアクセラレータの無効の仕方がわからなかったので、
ディスプレイアダプタを無効にしてみましたが、リストの読み込みは遅いままでした。
そして今日は何故かいつも以上に動作が重く、リスト表示完了まで２０秒以上・・・。
前日との動作速度の差は一体・・・？

ソフトウェアとＯＳも生ものみたいな物なのですね。
今回は大変勉強になりました。

今後のプログラミングにも、
安直に楽して組もうとせず、今回のお知恵を役立てたいと思います。

皆さんありがとうございましたｍ（＿＿）ｍ。

以下完成したコードです。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  s1,s3:string;
begin
  ListBox1.Canvas.Brush.Color := clwindow;
  ListBox1.Canvas.FillRect(rect);
  ListBox1.Canvas.Font.Color := clwindowtext;
  ListBox1.Canvas.TextOut(rect.Left + 12, rect.Top, ListBox1.Items[index]);

  case swi3 of
      1:begin
          s1 := ListBox1.Items[Index]+ '.y1';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.iy11';  // fileelistbox3のフォルダや拡張子を
        end;
      2:begin
          s1 := ListBox1.Items[Index]+ '.y2';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.iy21';  // fileelistbox3のフォルダや拡張子を
        end;
      3:begin
          s1 := ListBox1.Items[Index]+ '.y3';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.iy31';  // fileelistbox3のフォルダや拡張子を
        end;
      4:begin
          s1 := ListBox1.Items[Index]+ '.n1';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.in11';  // fileelistbox3のフォルダや拡張子を
        end;
      5:begin
          s1 := ListBox1.Items[Index]+ '.n2';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.in21';  // fileelistbox3のフォルダや拡張子を
        end;
      6:begin
          s1 := ListBox1.Items[Index]+ '.n3';  // fileelistbox1のフォルダや拡張子を
          s3 := ListBox1.Items[Index]+ '.in31';  // fileelistbox3のフォルダや拡張子を
        end;
    end;

  if FileExists(s1) then begin
    ListBox1.Canvas.Brush.Color := clred;
    ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 2, rect.Left + 10, rect.Top + 10);
  end;

  if FileExists(s3) then begin
    ListBox1.Canvas.Brush.Color := clblue;
    ListBox1.Canvas.Ellipse(rect.Left + 2, rect.Top + 10, rect.Left + 10, rect.Top + 20);
  end;
end;