▼ Mr.XRAYさん
> おそくらOnDataHintイベントでしょう。
ありがとうございました。
早速って、一晩たってますがテストプログラムをバージョンアップしてやって
みました。
//**********************************************************************
// Unit1 private 宣言節以降
//----------------------------------------------------------------------
private
{ Private 宣言 }
FSLName :TStringList;
FSLSeek :TStringList;
FMSThum :TMemoryStream;
procedure GetPathFileThum(AFolder :String);
function AddImageList(AFileName :String):Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses FileCtrl, ImageExtract;
//ImageExtract.pas ← http://www1.cncm.ne.jp/~ogawate/delphi/samples/thumbnail/07.html
//===========================================================//
// メモリーストリームにサムネイル画像を追加する
//===========================================================//
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;
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 := True;
ListView.OwnerDraw := True;
ListView.ViewStyle := vsIcon;
end;
//============================================================//
//
//============================================================//
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSLName.Free;
FSLSeek.Free;
FMSThum.Free;
end;
//============================================================//
// 以前の描画処理(XPMan無効は正常)ですが無効に
//============================================================//
procedure TForm1.ListViewCustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
var
SeekPos: Integer;
Bmp: TBitmap;
ARect, BRect: 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.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;
//============================================================//
//
//============================================================//
procedure TForm1.ListViewData(Sender: TObject; Item: TListItem);
begin
//XPMan有効で発生するIndexのエラーを防ぐ為に追加
if ((ListView.Items.Count - 1) >= Item.Index)
and (0 <= Item.Index) then
Item.Caption := FSLName.Strings[Item.index];
end;
//============================================================//
// OnDataHintを用いた描画処理
//============================================================//
procedure TForm1.ListViewDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
var
SeekPos: Integer;
Bmp: TBitmap;
ARect, BRect: TRect;
i :Integer;
begin
with ListView do
begin
if (StartIndex > ListView.Items.Count-1) or (EndIndex > ListView.Items.Count-1) then Exit;
for i := StartIndex to EndIndex - 1 do
begin
ARect := ListView.Items.Item[i].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[i]);
// 縮小画像をストリームからロードして表示(アイコン描画は無し)
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;
end;
end;
end.
//---------------------------------------------------------------
省きまくって最小限(でも長いです)
XPMan有効状態で、OnCustomDrawItemの記述を無効、OnDataHintイベントを有効。
すげぇ〜！見事にちらつき無く表示する事ができました。(^_^)v
と、思いきや何故か末尾のみがファイル名だけ表示してサムネル画像だけが表示
されない。
しかも、サムネイルをランダムにクリックしていると、クリックした項目以外の
サムネイルがファイル名を残し忽然と消えしまう。
引き続き他の項目をランダムにクリックし続けると復活！？
何じゃこりゃ！
う〜む、にゃにか記述ミスか、考えが足りないか・・・ (;_;)
再度、見直しです。
|