TListViewに棒グラフの線をリアルタイムに表示するには？
解決毎度お世話になっております。かなものと申します。
長めの文章で申し訳無いです。
環境 WindowsXP Pro SP1 / Delphi 6 Personal
またListViewの件で質問なのですが、内容的にはズバリ・・・
http://support.jgaa.com/index.php?cmd=ShowProduct&ID=3
このWarFTPDというソフトのメイン画面にある「ListViewへのグラフ表示」になります。
画面のサンプルはこちらです
http://kanamono2.hp.infoseek.co.jp/warftpd.gif
WarFTPDはFTPサーバーソフトで、サンプル画面は監視画面です。
ダウンロードもしくはアップロードが開始されると、
ログインしているユーザー表の「info」の部分に、
ファイル名とUP/DLの状況がパーセントグラフとして表示されます。
該当するカラムの幅を100%（ここではinfo部分）とし、
たとえば数値が最大200で100という数字が入っていたら50%つまり半分を塗り潰す…というものです。
私がやっている事は、TCP/IPで数値情報を受け取って、
その数値をListViewに表示するというものです。（ViewStyleはvsReportです）
この数値の情報を、上記WarFTPのように簡単な棒グラフみたいな表示したいと考えております。
まず純粋に描画方法を知る事からはじめました。
ですが、上手く動作させる方法がわかりませんでした。
今までやった流れとしては…
----
まず、下記の例のような文をAdvancedCustomDrawSubItemに書いてみました。
（XY座標の指定など・・・）
・
・
Canvas.Pen.Color := $000000FF;
Canvas.Rectangle(rect);
上記内容で赤い線が描画される事は確認出来ました。
まず、文字の上に描画されるようで、数値が見えなくなりました。
これは、数字にかぶらないように縦2ピクセルの横線のように表示させて誤魔化してみました。
とりあえず、文字は見えるようになりました。
ですが、カラムの幅を変える（描画の位置をずらす）と、一度表示した部分がそのまま残ってしまい、
LISTの再描画（ソートなど）を行わない限り、線が正しく表示されない状況になりました。
http://kanamono2.hp.infoseek.co.jp/listview.gif
こんな感じになってしまいます。
しかも、横幅をListView1.Column[0].Width + … 等で図っていた為なのでしょうか、
ListViewをWindow幅を超える長さに設定して、ListView全体の位置を左右にずらした状態で再描画すると
描画される位置がずれます。（位置が固定のまま）
そこでCanvas.Brushに目を付けました。これならカラムの表示位置を変えても
正しく表示出来るかもしれないと思ったからです。
しかし、項目自体を塗りつぶす事は出来たのですが、
これでは該当する項目が「ただ塗り潰されているだけ」になってしまいました。
何かヒントでも見つかれば…と思い、
WarFTPDを下記アドレスのTOOLで、状況を見てみました。
http://www.vector.co.jp/soft/win95/prog/se214785.html
すると、ListViewの所に「SysListView32」という表示になっていました。
（私が作ったLISTプログラムは「TListView」となっていました）
しかし、この「SysListView32」を調べてみると、他のアプリからのハンドルの取り方とかばかりで、
Delphiとの組み合わせの情報を、見つける事が出来ませんでした。
HELPでも、手持ちの参考書でも、全く検索されず、行き詰ってしまいました。
棒グラフが書きこめた時点で、カラムを動かしても表示がズレない方法が分からないのです。
あとは、長さの％計算をするだけでOKなはずなのですが・・・
---
と、ここまでです。
何か打開策などがあれば、是非お知恵をお借りしたいです。
宜しくお願いします。
やりかたはいろいろありますが、私はOnCustomDrawItemで１行分すべてを描画しています。
APIのListView_GetSubItemRect(Messageを飛ばすラッパーですが)で、各項目の描画範囲を取得し、そこに描画します。
クラス名は、RegisterClassExなどで定義したウィンドウクラス名になります。
デフォルトで、EDITやBUTTONなどがあります。
VCLでは、各クラス(TButton, TEditなど)の名前で登録し、それを使用しています。
通常使う分には、あまり気にしなくてもよいかと思います。
ListView2を配置してColumnを4列にしてください。
4列目の数値によりグラフが表示されます。
procedure TForm1.ListView2AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
R:TRect;
E:Extended;
BrushWidth:integer;
begin
if SubItem = 3 then begin
R := Item.DisplayRect(drBounds);
R.Left := R.Left + Listview2.columns[0].Width + Listview2.columns[1].Width +Listview2.columns[2].Width;
R.Right := R.Left + Listview2.columns[3].Width;
if Item.SubItems[1] <> '' then begin
DefaultDraw := False;
//値を取得
E := StrToFloatDef( Item.SubItems[2],-1 );
//塗り潰す幅を計算
BrushWidth := Ceil( (E * 100) * (R.Right - R.Left) / 1000 );
R.Right := R.Left + BrushWidth;
//塗りつぶす
Sender.Canvas.Brush.Color := clRed;
Sender.Canvas.FillRect(R);
end;
end;
end;
ちなみに列４には小数点でも可能です
レス有難うございます。
もう一度、正確な問題点をまとめたいと思います。
（前回の書き込みで書いていない部分もありましたので）
１． カラム幅変更時（左側）に、Canvasで描いた線の残像が残る。
http://kanamono2.hp.infoseek.co.jp/listview.gif
２． カラム幅変更時（右側）に、線が書かれない。
http://kanamono2.hp.infoseek.co.jp/listview2.gif
３． ListView全体の位置がズレた時に、描画すべき場所がズレる。
http://kanamono2.hp.infoseek.co.jp/listview3.gif
> ListView2を配置してColumnを4列にしてください。
> 4列目の数値によりグラフが表示されます。
サンプルを頂いて大変嬉しいのですが、
申し訳無いのですが、実際に私が組んでるソースと
ほぼ同等の内容のようです・・・。
やはり、残像現象が発生しました・・・。
> やりかたはいろいろありますが、私はOnCustomDrawItemで１行分すべてを描画しています。
なるほど、行をまとめて処理をしようという事ですね。
> ListView_GetSubItemRect
> RegisterClassEx
この辺りは、まだ自分の知識不足のようです。
まずは、内容を調べてみたいと思います。
上記の件に関しては、後で調べてやってみたいと思います。
今週末に秋葉原の近くに行くので、
ついでに寄って、新たなDelphi系参考書でも探してみます。
> ListView_GetSubItemRect
現在こちらを調べているのですが、新しくAPIの本を買って見てみてます。
しかし、どこを探しても本に載っていませんでした。
NETで情報を探して見たのですが、日本語での検索結果はわずか数件。
ちょっと困惑気味ではあります。
どうやら現在の私の大幅な知識不足が要因の一つになっていると思われます。
一度、間をおいてもう少し勉強してからにしてみたいと思います。
現在は、まともな英語力の無い頭で、必死で英語のページをにらめっこの状態です。
（英語全く読めないのですが・・・まぁ頑張って見ます）
尚、解決はしていないので、チェックは今は入れないでおきます。
Cの場合、ListView_GetSubItemRectはマクロで定義されているので見つからないのかもしれません。
私の作っているメーラのコードですが、一応サンプルとして載せます。
コメントが少ないのですが申し訳ない。
procedure TMailUtils.ListViewCustomDrawItem(
Sender: TCustomListView;
Item: TListItem;
State: TCustomDrawState;
var DefaultDraw: Boolean);
var
Rect: TRect;
i, j: integer;
s: String;
List: TStringList;
Msg: TIdMessage;
begin
for i := 0 to 4 do // 項目数
begin
ListView_GetSubItemRect(ListView.Handle, Item.Index, i, LVIR_BOUNDS, @Rect); // 項目ごとの領域(TRect)を取得
if Item.Selected then
begin
// 選択
if cdsFocused in State then
begin
ListView.Canvas.Brush.Color := clHighlight;
ListView.Canvas.Font.Color := clHighlightText;
end
else
begin
ListView.Canvas.Brush.Color := clSilver;
ListView.Canvas.Font.Color := clBtnText;
end;
end
else
begin
ListView.Canvas.Brush.Color := clWindow;
ListView.Canvas.Font.Color := clWindowText;
end;
ListView.Canvas.FillRect(Rect);
case i of
1://Subject
begin
s := Item.SubItems[0];
if (ListView.Tag = 1) or (ListView.Tag = -1) then
begin
Msg := GetMessageFromItem(Item, j);
if Assigned(Msg) then
begin
List := TStringList.Create;
try
List.Text := Msg.Headers.Values['References'];
if List.Count > 0 then
for j := 0 to List.Count - 1 do
begin
s := ' ' + s;
end;
finally
Msg.Free;
List.Free;
end;
end;
end;
DrawText(
ListView.Canvas.Handle,
PCHAR(s),
Length(s),
Rect,
DT_SINGLELINE or DT_END_ELLIPSIS);
end;
2://From
DrawText(
ListView.Canvas.Handle,
PCHAR(Item.SubItems[1]),
Length(Item.SubItems[1]),
Rect,
DT_SINGLELINE or DT_END_ELLIPSIS);
3://Date
DrawText(
ListView.Canvas.Handle,
PCHAR(Item.SubItems[2]),
Length(Item.SubItems[2]),
Rect,
DT_SINGLELINE or DT_END_ELLIPSIS);
4://Size
DrawText(
ListView.Canvas.Handle,
PCHAR(Item.SubItems[3]),
Length(Item.SubItems[3]),
Rect,
DT_SINGLELINE or DT_RIGHT or DT_END_ELLIPSIS);
end;
// Frame3D(Sender.Canvas, Rect, clBlue, clNavy, 2);
end;
ListView.Canvas.Brush.Color := clWhite;
DefaultDraw := False;//True;//cdsSelected in State;
//フォントが壊れるバグの対応
with Sender.Canvas do
if Assigned(Font.OnChange) then Font.OnChange(Font);
end;
書き忘れました。
uses節に、
CommCtrl
を追加してください。ここにListView_GetSubItemRectが定義されています。
レスが遅れて申し訳ありませんでした。
仕事が忙しく、なかなかDelphiの勉強に手が付けられない状況ではあります。
> 私の作っているメーラのコードですが、一応サンプルとして載せます。
> コメントが少ないのですが申し訳ない。
サンプルを頂けるのは、我々のようなレベルの低い人間にとって大変有難いことです。（とても良い教材になります）
このサンプルを元に、もう少し調べてみたいと思います。有難うございます。
結果は、後日ご報告したいと思いますが、今回は仕事が忙しくお返事に時間がかかるかもしれません・・・。
かなり時間が掛かってしまいましたが、ようやく時間が出来まして上記検証が行えました。
使用方法を知るために、下記のようなTESTソースを試みました。
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
Rect:TRect;
j: integer;
str: String;
begin
ListView_GetSubItemRect(ListView1.Handle, 0, 4, LVIR_BOUNDS, @Rect);
str := 'Top='+ IntToStr(Rect.Top)+'/'+
'Left='+ IntToStr(Rect.Left)+'/'+
'Right='+ IntToStr(Rect.Right)+'/'+
'Bottom='+ IntToStr(Rect.Bottom);
Form1.Caption := str;
rect.Top := rect.Bottom -2;
//％仮計算TEST
j := (rect.Right - rect.Left) div (200 div 50);
rect.Right := rect.Left + j;
Sender.Canvas.Pen.Color := $00FF0000;
Sender.Canvas.Rectangle(rect);
// フォントの変更イベントを作ってやれば文字が大きくならない
with Sender.Canvas do
if Assigned(Font.OnChange) then Font.OnChange(Font);
end;
結果は、リアルタイム描画に成功となりました。
描画方法に関しては、初期の打開策のものですが、
幅を広げると見事に、％に従った幅になりました。
このソースでは、１行目のみですが上下左右の大きさを
Form1.Caption に表示させております。
この数字がリアルタイムに変わりますね。
描画方法そのものに関しての問題は、追々やっていこうかと思います。
当初の問題が解決致しました。
ありがとう御座いました。
| ツイート |  |