▼ Mr.XRAYさん
残念ながら、スクロールするとひどくちらつくことがわかりました。
仮想リストビューではココが限界なのでしょうか？
色々お手数をおかけ致しましたが、結果的にこんな事になりました。
http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200708/07080056.txt
最終的に、OnCustomDrawItemのみで処理する事にしました。
問題が発生した時点ではDrawDataがTrueでOnCustomDrawItemイベントなんて
駄目よとXPManは教えてくれてたのですね。
これはいわば「仮想リストビューとコモンコントロールのごった煮状態」と
表現するのが正しいのでしょうか？
もっとも、ファイル名を表示させる為の設定はどうすんの？という基本的な
処がわかってなくて、サンプルを見よう見まねでやって事が原因ですね。
で、以下のようになりました。ちょっとだけ短くなりました。
//**********************************************************************
// Unit1 implementation 宣言節以降
//----------------------------------------------------------------------
//===========================================================//
// メモリーストリームにサムネイル画像を追加する
//===========================================================//
function TForm1.AddImageList(AFileName :String):Boolean;
var
SeekPos: Integer;
AWidth, AHeight: Integer;
Bmp: TBitmap;
begin
Result := False;
// 描画領域の大きさ
AWidth := ListView.LargeImages.Width;
AHeight := ListView.LargeImages.Height;
FSLSeek.Add('-1');
Bmp := TBitmap.Create;
try
Bmp.Width := AWidth;
Bmp.Height :=AHeight;
if ExtractImage(AFileName, Bmp) then //サムネイル画像の取得
begin
//縮小画像とその位置
SeekPos := FMSThum.Size;
FSLSeek.Strings[FSLSeek.Count - 1] := IntToStr(SeekPos);
FMSThum.Seek(0, soFromEnd);
Bmp.SaveToStream(FMSThum);
Result := True;
end;
finally
Bmp.Free;
end;
end;
//============================================================//
// サムネイル対象のファイル検索
//============================================================//
procedure TForm1.GetPathFileThum(AFolder :String);
var
SearchRec: TSearchRec;
ADateTime :TDateTime;
StrFileName :String;
RetCount,Ret :Integer;
StrExt :String;
begin
ListView.Items.Clear;
FSLName.Clear;
FSLSeek.Clear;
FMSThum.Clear;
FMSThum.Size := 0;
if FindFirst(AFolder + '*', faDirectory, SearchRec) = 0 then
begin
repeat
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
StrExt := UpperCase(ExtractFileExt(SearchRec.Name));
//取り急ぎbmpとJegファイルのみで他のアイコン描画なし
if (StrExt = '.BMP') or (StrExt = '.JPG') then
begin
StrFileName := AFolder + SearchRec.Name;
if AddImageList(strFileName) then
begin
FSLName.Add(SearchRec.Name);
ListView.Items.Add;
{ファイル名をキャプションに設定}
ListView.Items.Item[ListView.Items.Count-1].Caption := SearchRec.Name;
end;
end;
end;
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
//============================================================//
// 取得先のフォルダー指定
//============================================================//
procedure TForm1.Button1Click(Sender: TObject);
var
StrPath :String;
begin
StrPath := '';
if SelectDirectory('検索フォルダ指定', '',StrPath) then
begin
StrPath:=IncludeTrailingPathDelimiter(StrPath);
GetPathFileThum(StrPath);
end;
end;
//============================================================//
//
//============================================================//
procedure TForm1.FormCreate(Sender: TObject);
begin
FSLName := TStringList.Create;
FSLSeek := TStringList.Create;
FMSThum := TMemoryStream.Create;
ListView.LargeImages := ImageList;
ListView.SmallImages := ImageList;
ListView.OwnerData := False;
ListView.OwnerDraw := False;
ListView.ViewStyle := vsIcon;
ListView.DoubleBuffered := True;
end;
//============================================================//
//
//============================================================//
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSLName.Free;
FSLSeek.Free;
FMSThum.Free;
ListView.DoubleBuffered := False;
end;
//============================================================//
//
//============================================================//
procedure TForm1.ListViewCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
SeekPos: Integer;
Bmp: TBitmap;
ARect, BRect,CRect: TRect;
begin
with ListView do
begin
Canvas.Brush.Color := GetSysColor(COLOR_WINDOW);
if ((Items.Count - 1) >= Item.Index) and (0 <= Item.Index) then
begin
ARect := Item.DisplayRect(drIcon);
ARect := ListView.Items.Item[Item.Index].DisplayRect(drIcon);
ARect.Left := ARect.Left + Trunc((ARect.Right - ARect.Left - ImageList.Width) / 2);
ARect.Right := ARect.Left + ImageList.Width;
ARect.Top := ARect.Top + Trunc((ARect.Bottom - ARect.Top - ImageList.Height) / 2);
ARect.Bottom := ARect.Top + ImageList.Height;
Canvas.FillRect(ARect);
SeekPos := StrToInt(FSLSeek.Strings[Item.Index]);
// 縮小画像をストリームからロードして表示(アイコン描画は無し)
Bmp := TBitmap.Create;
try
FMSThum.Seek(SeekPos, soFromBeginning);
Bmp.Width := ARect.Right - ARect.Left;
Bmp.Height := ARect.Bottom - ARect.Top;
Bmp.LoadFromStream(FMSThum);
BRect := Classes.Rect(0, 0, Bmp.Width, Bmp.Height);
Canvas.CopyRect(ARect, Bmp.Canvas, BRect);
finally
Bmp.Free;
end;
end;
// 選択状態を示す四角を描画
if cdsSelected in State then
begin
Canvas.Pen.Color := clHighlight;
Canvas.Pen.Width := 5;
Canvas.MoveTo(ARect.Left, ARect.Top);
Canvas.LineTo(ARect.Left, ARect.Bottom-1);
Canvas.LineTo(ARect.Right-1, ARect.Bottom-1);
Canvas.LineTo(ARect.Right-1, ARect.Top);
Canvas.LineTo(ARect.Left, ARect.Top);
end;
end;
end;
|