名前
題名
▼ Syakeさん > ▼ 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 > > と、思いきや何故か末尾のみがファイル名だけ表示してサムネル画像だけが表示 > されない。 > しかも、サムネイルをランダムにクリックしていると、クリックした項目以外の > サムネイルがファイル名を残し忽然と消えしまう。 > 引き続き他の項目をランダムにクリックし続けると復活！？ > 何じゃこりゃ！ > う〜む、にゃにか記述ミスか、考えが足りないか・・・　(;_;) > 再度、見直しです。
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link