名前
題名
▼ Syakeさん > ▼ 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;
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link