ドラッグ&ドロップでファイル名とフルパスを取得してデータベースに格納するには?

解決


UZIYAMADA  2006-05-13 07:17:46  No: 21511

ユーザーのファイルの追加・削除操作によってListBox上にファイル名を表示し、
表示された画像ファイルをコンバートするプログラムを作ろうとしています。

それでListBox上にフルパスでファイル名を表示すると長くなるので、ファイル名部分だけ表示させたいなと思いまして、
しかし、画像をコンバートするにはフルパスは必要だから、そうなるとファイル名とフルパスとを結びつけて管理するデータベースを自作しないとダメだなと思って取り組んだのですが何やら上手くいきません。

問題の部分はドラッグ&ドロップでフルパスを取得した際に、ファイル名とフルパスをデータベースに格納する部分です。
最初はItems.AddObjects(ExtractFileName(Path), TObject(Path))で簡単に実現できそうだなと思ってやってみたんですがNG。
それで自作Recordを作ってみたり、Stringでキャストしてみたり、手を尽くしてみたのですが全然NGでして現在に至ります。
エラーメッセージは主にアクセス違反や無効なポインタ操作関連です。

特にItems.Add()ならOKでItems.AddObject()が上手く働かないのがよくわからないです。
上手く処理できる方法を教えてください。
ちなみにDelphiは経験一週間程度なので初歩的な勘違いをしてるかもしれません。

ソースは以下です。

////////////////////////////////////////////////////

unit Test;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ShellAPI;

type
  TUnitDB = record
    FileName: TStringList;
  end;

  TForm_Test = class(TForm)
    ListBox_FileName: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMDropFiles(var msg: TWMDropFiles);
    message WM_DROPFILES;
  public
  end;

var
  Form_Test: TForm_Test;

implementation

{$R *.dfm}

procedure TForm_Test.FormCreate(Sender: TObject);
begin
  // ドラッグ&ドロップを受け付ける
  DragAcceptFiles(Handle, True);
end;

// フォームへドラッグ&ドロップされた場合
procedure TForm_Test.WMDropFiles(var msg: TWMDropFiles);
var
  Path: array [0..255] of Char;
  total, i: Integer;
  DB : TUnitDB;
begin
  // いくつのファイルがドロップされたかを得る
  total := DragQueryFile(Msg.Drop, $FFFFFFFF, Path, SizeOf(Path));
  // ファイル名を1つずつ得る
  for i := 0 to total - 1 do begin
    DragQueryFile(msg.Drop, i, Path, SizeOf(Path));
    ListBox_FileName.Items.Add(Path);  // これはOK
    ListBox_FileName.Items.AddObject(Path, TObject(String(Path))); // NG
    DB.FileName.Add(Path);    // これもNG
  end;
  // ハンドルを解放
  DragFinish(msg.Drop);
end;

end.

//////////////////////////////////////////////////////

unit UnitDB;

interface

uses
  Classes, Dialogs, SysUtils;

type
  TUnitDB = class
  public
    FFileName: TStrings;
    FFilePath: TStrings;
    procedure Add(const S: String);
  end;

implementation

procedure TUnitDB.Add(const S: String);
begin
  FFileName.Add(S);
  FFilePath.Add(S);
end;

end.

////////////////////////////////////////////////////////


UZIYAMADA  2006-05-13 07:20:48  No: 21512

上のTest部分のソースに間違ったものを送ってしまいました(汗

本物はこっちです…

////////////////////////////////////////////////////////////

unit Test;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, UnitDB;

type
  TForm_Test = class(TForm)
    ListBox_FileName: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMDropFiles(var msg: TWMDropFiles);
    message WM_DROPFILES;
  public
  end;

var
  Form_Test: TForm_Test;

implementation

{$R *.dfm}

procedure TForm_Test.FormCreate(Sender: TObject);
begin
  // ドラッグ&ドロップを受け付ける
  DragAcceptFiles(Handle, True);
end;

// フォームへドラッグ&ドロップされた場合
procedure TForm_Test.WMDropFiles(var msg: TWMDropFiles);
var
  Path: array [0..255] of Char;
  total, i: Integer;
  DB : TUnitDB;
begin
  // いくつのファイルがドロップされたかを得る
  total := DragQueryFile(Msg.Drop, $FFFFFFFF, Path, SizeOf(Path));
  // ファイル名を1つずつ得る
  for i := 0 to total - 1 do begin
    DragQueryFile(msg.Drop, i, Path, SizeOf(Path));
    // ListBox_FileName.Items.Add(Path);  // これはOK
    // ListBox_FileName.Items.AddObject(Path, TObject(String(Path))); // これはNG
    // DB.Add(Path);    // これもNG
  end;
  // ハンドルを解放
  DragFinish(msg.Drop);
end;

end.

//////////////////////////////////////////////////////

unit UnitDB;

interface

uses
  Classes, Dialogs, SysUtils;

type
  TUnitDB = class
  public
    FFileName: TStrings;
    FFilePath: TStrings;
    procedure Add(const S: String);
  end;

implementation

procedure TUnitDB.Add(const S: String);
begin
  FFileName.Add(S);
  FFilePath.Add(S);
end;

end.

////////////////////////////////////////////////////////


英雄ムスカ  2006-05-13 10:26:01  No: 21513

ListBox自身にはフルパス格納
ListBoxのOnDrawItemで、ファイル名のみ描画する。
・・・ってのはどうですか?

もしくは、別途StringListを用意し、TListBoxはファイル名のみ、StringListにはフルパスを格納し、Indexを合わせて使用する。

AddObjectでString型が使えないのは、ぶっちゃけ、String型は勝手にメモリを
確保・破棄してくれるPChar型だからであり、とあるメソッド内出宣言した変数は、
そのメソッド内でしか使えない(スコープ・・・でいいんか?)から、
AddObjectしたメソッド以外の場所でアクセスしようとしても、すでに開放されたあとの
メモリを参照するからエラーになる。
誰か・・・丁寧な説明希望する orz

ちなみに、TUnitDBのFFileNameやFFilePathのインスタンスは、どこで生成しているのやら?
クラスは、Createしないと使えませんよ。

var
  DB : TUnitDB;
begin
  //クリエイト
  DB := TUnitDB.Create;
  
  //終わったら破棄
  DB.Free;
end;

ついでに言うなら、クラス内に宣言したクラス型の変数は、そのクラス内で生成・破棄(Create,Free)するのが吉。
外に任せると、思いがけないことになる可能性があるでしょう。

type
  TUnitDB = class
  public
    FFileName: TStrings;
    FFilePath: TStrings;
  public
    constructor Create;
    destructor Destory; override;
    procedure Add(const S: String);
  end;

constructor TUnitDB.Create;
begin
  inherited Create;
  FFileName := TStringList.Create;
  FFilePath := TStringList.Create;
end;
destructor TUnitDB.Destory;
begin
  FFileName.Free;
  FFilePath.Free;
  inheirted Destory;
end;

タイプミスは大目に見てください。


えーと  2006-05-13 18:49:25  No: 21514

> ListBox自身にはフルパス格納
> ListBoxのOnDrawItemで、ファイル名のみ描画する。

これに一票。これより確実・簡単な方法はない、とあえて断言します。


UZIYAMADA  2006-05-13 20:18:50  No: 21515

>ListBox自身にはフルパス格納
>ListBoxのOnDrawItemで、ファイル名のみ描画する。
>・・・ってのはどうですか?
うあー、こんなイベントがあったとは、プロパティとメソッドばかり見てて気付きませんでした。
この手段で解決できました!ありがとうございました!

>もしくは、別途StringListを用意し、TListBoxはファイル名のみ、StringListにはフルパスを格納し、Indexを合わせて使用する。
ファイル名用とフルパス用のListBoxを2つ作って同期させようかとも考えてました…
同期のコーディングでミスったら、自分のレベルだと解決の難しそうなバグを出しそうだったので途中で止めましたけどね。

>AddObjectでString型が使えないのは、ぶっちゃけ、String型は勝手にメモリを
>確保・破棄してくれるPChar型だからであり、とあるメソッド内出宣言した変数は、
>そのメソッド内でしか使えない(スコープ・・・でいいんか?)から、
>AddObjectしたメソッド以外の場所でアクセスしようとしても、すでに開放されたあとの
>メモリを参照するからエラーになる。
う〜ん、String型は使いどころが難しそうですね。

>ちなみに、TUnitDBのFFileNameやFFilePathのインスタンスは、どこで生成しているのやら?
>クラスは、Createしないと使えませんよ。
CreateとDestoryを書かなくとも何故かエラーが出なかったもので、
コードの修正を繰り返しているうちに消えてしまいました…今度から気をつけます。

ファイル名の表示は以下のソースで解決できました。
英雄ムスカさん、えーとさん、ありがとうございました!

////////////////////////////////////////////////////////////

unit Test;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI;

type
  TForm_Test = class(TForm)
    ListBox_FileName: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox_FileNameDrawItem(Control: TWinControl;
      Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
    procedure WMDropFiles(var msg: TWMDropFiles);
    message WM_DROPFILES;
  public
  end;

var
  Form_Test: TForm_Test;

implementation

{$R *.dfm}

procedure TForm_Test.FormCreate(Sender: TObject);
begin
  // ドラッグ&ドロップを受け付ける
  DragAcceptFiles(Handle, True);
end;

// フォームへドラッグ&ドロップされた場合
procedure TForm_Test.WMDropFiles(var msg: TWMDropFiles);
var
  Path: array [0..255] of Char;
  total, i: Integer;
begin
  // いくつのファイルがドロップされたかを得る
  total := DragQueryFile(Msg.Drop, $FFFFFFFF, Path, SizeOf(Path));
  // ファイル名を1つずつ得る
  for i := 0 to total - 1 do begin
    DragQueryFile(msg.Drop, i, Path, SizeOf(Path));
    ListBox_FileName.Items.Add(Path);
  end;
  // ハンドルを解放
  DragFinish(msg.Drop);
end;

// ファイル名部分のみをListBox上に表示
procedure TForm_Test.ListBox_FileNameDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
   ListBox_FileName.Canvas.TextOut(
     Rect.Left+2, Rect.Top, ExtractFileName (ListBox_FileName.Items[Index]));
end;

end.

///////////////////////////////////////////////////////////////


UZIYAMADA  2006-05-13 20:50:45  No: 21516

あ、解決ボタンチェックし忘れてました…


UZIYAMADA  2006-05-14 01:37:25  No: 21517

TextOutだと選択状態のときの表示が変になっちゃいました。
TextOutだと描画範囲がテキスト長になるから、テキストからはみ出てるRectの範囲まで描画されないからってことでしょうね。
TextRectを使ったほうが良さそうですね。

以下、改定ソース

////////////////////////////////////////////////////////////////////

// ファイル名部分のみをListBox上に表示
procedure TForm_Main.ListBox_FileNameDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  ListBox_FileName.Canvas.TextRect(ListBox_FileName.ItemRect(Index),
    Rect.Left+2, Rect.Top, ExtractFileName(ListBox_FileName.Items[Index]));
end;

//////////////////////////////////////////////////////////////////////


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加