喫茶XRAYトップページ

[スレッド全体
]

[1383] 何か疲れた・・・返信 削除
2007/8/28 (火) 18:49:49 Syake
マスターひさしゅうございます。

お恥ずかしいながら・・・マルチポストならぬマルチグチ。
故あって画像保存と表示のアプリを作成する事になり、サムネイル表示とやらを
ネットのサンプルをありがたく頂戴してやってたわけです。
http://www1.cncm.ne.jp/~ogawate/delphi/samples/thumbnail/07.html
サムネイルデータファイル保存やら、ビュワーまで作って9割方完成と思いきや、
自分で苦労もせずやった罰が当たったのか、ふとXPManを有効にしたとたんに
http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200708/07080056.txt
ってなわけです。
最終的にはDllForm化が必要なので避けて通れないし。
何かねぇ・・・

[1385] Re:何か疲れた・・・返信 削除
2007/8/28 (火) 21:13:45 Mr.XRAY
▼ Syakeさん
> マスターひさしゅうございます。

こちらこそ。

> http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200708/07080056.txt

拝見いたしやした。レスつけました。
おそくらOnDataHintイベントでしょう。

で、サムネイルなんですが、たしかにViewStyleをvsIconにしてできるのですが、
仮想リストビューの使い方、つまり、表示を高速にするのがネックのようです。
表示サイズも可変にしたいし。

私も職場で使うものを開発しましたが、ニュートンのDllを使用してしまいま
した。いつか作り直そうと考えているのですが。これがなかなか(泣)。
6年ぐらい前でしたので知識もあまりなかったので逃げですね(泣笑、涙)。
ただ、私の場合、ワードやエクセルに貼付けて使用する画像を表示して
コピーするだけのものです。

[1387] TListViewのOnDataHintとOnDataイベント返信 削除
2007/8/28 (火) 23:44:52 Mr.XRAY
▼ Syakeさん

更にくどいですが、当喫茶店の大切なお客様ですので、なんとかと思い。

> おそくらOnDataHintイベントでしょう。

OnDataイベントは描画(実際に見えるItem部分)が必要な時に発生します。
これはListViewの全てのItemではありません。
一方、OnCustomDrawItemイベントは全てのItemに対して発生します。

OwnerData := Trueとすると、OnDataHintイベントの引数である
StartIndex,EndIndexの間のItemだけが作成されるようです。
したがって、OnCustomDrawItemイベントを使用すると、Indexのエラーとなる
可能性があります。もちろん、ListViewのクライアント領域に収まる数のItems数
であれば問題ないでしょう。

OnHintイベントを使用すればそれを避けることができます。
このイベントのStartIndex,EndIndex が描画範囲内のItem番号です。

OnDataHintとOnDateイベントを組合わせて使用するのが仮想リストビューの
特徴でもあります。

くどくてゴメンナサイね。
迷路にはまった時の疲れる気持お察し致します。

[1391] Re:TListViewのOnDataHintとOnDataイベント返信 削除
2007/8/29 (水) 10:39:26 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

と、思いきや何故か末尾のみがファイル名だけ表示してサムネル画像だけが表示
されない。
しかも、サムネイルをランダムにクリックしていると、クリックした項目以外の
サムネイルがファイル名を残し忽然と消えしまう。
引き続き他の項目をランダムにクリックし続けると復活!?
何じゃこりゃ!
う〜む、にゃにか記述ミスか、考えが足りないか・・・ (;_;)
再度、見直しです。


[1392] Re2:TListViewのOnDataHintとOnDataイベント返信 削除
2007/8/29 (水) 10:47:41 Syake
おかしくなるはずやん。

> //============================================================//
> //      OnDataHintを用いた描画処理
> //============================================================//
> procedure TForm1.ListViewDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
>   ・・・・・
>   for i := StartIndex to EndIndex - 1 do

→ for i := StartIndex to EndIndex do
自動補完機能のせいにしとこ (^_^;)

いや〜素晴らしいです。
ListViewなるものを始めて使いましたが、お陰様で大変勉強になりました。
さてさて、本プログラムの書き直し作業に入ります。

やはり、もつべきは「X-Ray」さんです。



[1396] Re3:TListViewのOnDataHintとOnDataイベント返信 削除
2007/8/29 (水) 16:27:05 Mr.XRAY
▼ Syakeさん

> >   for i := StartIndex to EndIndex - 1 do
> → for i := StartIndex to EndIndex do


非常に陥りやすい罠ですね。(^_^;)
    for i := 0 to Count-1 do
という感じで使用することが多いですもん。


[1397] Re4:TListViewのOnDataHintとOnDataイベント返信 削除
2007/8/31 (金) 13:39:45 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;


[1398] 画像のサムネイル表示返信 削除
2007/8/31 (金) 19:12:37 Mr.XRAY
▼ Syakeさん

なんか私のレスに惑されることになってしまったようですね。
過去に挫折した経験があるので、機会があればSyakeさんのコードを
拝借し、挑戦してみたいと思っています。

画像に限らず、サムネイルの表示は難しそうです。数個程度なら速度は気に
する必要はなさそうですが、数が多くなると。
やはり速度はほしいですからね。


[1454] Re:画像のサムネイル表示返信 削除
2007/11/15 (木) 19:47:21 Mr.XRAY
▼ Syakeさん

> 過去に挫折した経験があるので、機会があればSyakeさんのコードを
> 拝借し、挑戦してみたいと思っています。


自前でサムネイル表示に挑戦しようと思いやってみました.
nanaさんのDLしたら,あれっ?!

「インデックスが範囲を...」

で,Syakeさんのコードでやってみました.表示されました.
これから時間をみて,少しずついろいろやってみようと思います.

※ nanaさんのとは,以下のものです.
http://www1.cncm.ne.jp/~ogawate/delphi/samples/thumbnail/08.html

動作確認環境 WindowsXP(SP2) + Delphi7 Pro


[1455] Re2:画像のサムネイル表示返信 削除
2007/11/16 (金) 15:57:02 Syake
▼ Mr.XRAYさん
> ※ nanaさんのとは,以下のものです.
> http://www1.cncm.ne.jp/~ogawate/delphi/samples/thumbnail/08.html


私の場合、TStringListの多用はメモリーを多く消費すると言う事を
どこかで見ましたのでそこら辺からとりかかりました。
それと、サムネイルをファイルに保持して高速化を図りました。
って、聴こえは良いですが実のところ画像が追加された場合が面倒な
ので中途半端で終わっちゃってます(^_^;)

[1459] Re3:画像のサムネイル表示返信 削除
2007/11/24 (土) 11:18:54 Mr.XRAY
▼ Syakeさん

> って、聴こえは良いですが実のところ画像が追加された場合が面倒な

サポートしました.
http://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/T_ExplThumbnail.htm#03

のリスト3で,btnRefreshボタンが[最新の情報に更新]用です.
メソッド名は,RefreshThumbnailList です.

このメソッドでは,まず存在しない(削除されている)ファイルを検索し,
次にリストにないファイルを追加しています.
描画自体は追加ファイル分のみですので,時間がかかるのはこの追加分
だけです.もっとも,追加分が多いと... (苦笑)

(検索しながら削除,追加でもいいんですが...)

[1460] Re4:画像のサムネイル表示返信 削除
2007/11/29 (木) 16:49:42 Syake
▼ Mr.XRAYさん

ListView1CustomDrawItem
        FileName := FThumbList.Items[Item.Index].FileName;
        TextRect := Item.DisplayRect(drLabel);
        DrawText(Canvas.Handle,PChar(FileName),-1,TextRect,DT_CENTER);
end;


[1461] Re5:画像のサムネイル表示返信 削除
2007/11/29 (木) 17:01:49 Syake
▼ Mr.XRAYさん
間違えて送信してしまいましたm(__)m

見ぬ間に激進ですね。
さすがでございます。
>サポートしました.
>http://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/T_ExplThumbnail.htm#03

勉強させていただきますです。


[▼次のスレッド]
INCM/CMT
Cyclamen v3.82