画像ファイルのみ対応させるには？

解決

ハム 2004-08-30 08:57:15 No: 10684

私は、Formに画像ファイルをドロップすると壁紙を変更するプログラムをつくっています。下記のソースコードに対応ファイルをBMPとJPEGだけにしてそれ以外のファイルがドロップされた場合、「対応していません。」と言うメッセージを表示させるコードを追加したいのですが、どのように対応ファイル制限のコードを書けばいいのでしょうか？
下記がプログラムのソースコードになります。
procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;
procedure TForm1.WMDropFiles(var msg: TWMDropFiles);

var
  FileName: array[0..255] of Char;
  total, i: Integer;
  hObj : IUnknown;
  ADesktop : IActiveDesktop;
  str : String;
  wstr : PWideChar;

begin

total := DragQueryFile(msg.Drop,$FFFFFFFF , nil, 0);

for i := 0 to total-1 do begin
DragQueryFile(msg.Drop, i, FileName, SizeOf(FileName));

hObj := CreateComObject(StringToGUID('{75048700-EF1F-11D0-9888-006097DEACF9}'));
ADesktop := hObj as IActiveDesktop;

    wstr := AllocMem(MAX_PATH);
    StringToWideChar((FileName), wstr, MAX_PATH);
    ADesktop.SetWallpaper(wstr, 0);
    ADesktop.ApplyChanges(AD_APPLY_ALL);
    FreeMem(wstr);

end;

DragFinish(msg.Drop);
end;
end.
長文失礼しました。

スライスチーズ 2004-08-30 09:05:40 No: 10685

拡張子で判断する方法もありますが、質問者のレベルからすると
こちらを望んでるのかな？
function checkImageFormat(path:string):integer;
//  -1: 不明
//   0: bmp
//   1: jpg
//   2: gif
//   3: 拡張メタファイル emf
var F:File;
    Buf: array[0..50] of Char;
    i,j,Attrs:integer;
    ext:string;
begin
  result:=-1;
  ext:=AnsiLowerCase(ExtractFileExt(path));
  if FileExists(path)=True then
  begin
    Attrs := FileGetAttr(path);
    if Attrs and faReadOnly <> 0 then
      SetFileAttributes(PChar(path),Attrs - faReadOnly);

    try
    AssignFile(F,path);
    Reset(F,1);
    BlockRead(F, Buf, 50, i);
    if (Word(Buf[0])=$FF) and
       (Word(Buf[1])=$D8) and
       (Word(Buf[2])=$FF) then
       result:=1;
    if (Word(Buf[0])=$42) and
       (Word(Buf[1])=$4D) then
       result:=0;
    if (Word(Buf[0])=$47) and
       (Word(Buf[1])=$49) and
       (Word(Buf[2])=$46) then
       result:=2;
    if (Word(Buf[40])=$20) and
       (Word(Buf[41])=$45) and
       (Word(Buf[42])=$4D) and
       (Word(Buf[43])=$46) then
       result:=3;

    finally
    if Attrs and faReadOnly <> 0 then
      SetFileAttributes(PChar(path),Attrs);
    CloseFile(F);
    end;
  end;
end;

スライスチーズ 2004-08-30 09:08:26 No: 10686

いつも使ってる関数だとさらに拡張子判断も行わせているため
ext:string;が入ってます（不要）
ファイル属性を無理やり変更しちゃってます。
気になる場合は除外しちゃってください

ハム 2004-08-30 09:31:29 No: 10687

スライスチーズさん、ご返信ありがとうございます。
申し訳ありませんが、スライスチーズさんが書いてくださった
ソースコードは、私のレベルでは、理解することが出来ません(汗
申し訳ないのですが、拡張子から判断する方法にして頂けないでしょうか？
あと、ご迷惑でなければソースコードのどのあたりに記述すればいいのかもよろしくお願いします。

サラダ 2004-08-30 10:27:56 No: 10688

スライスチーズです。
とりあえず
Edit1,Button1,Button2を貼り付けて
各種イベントを追加したことを前提に

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    function GetFileType(path: string):integer;
    function checkImageFormat(path: string): integer;
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}
//拡張子から判別
function TForm1.GetFileType(path:string):integer;
var ext:String; //拡張子を入れるためのもの
begin
result:=-1;
ext:=ExtractFileExt(path); //ファイル名から拡張子を得る(vcl)
ext:=AnsiLowerCase(ext);   //小文字に変換(vcl)
if ext='.bmp' then
  result:=0;
if (ext='.jpg') or (ext='.jpeg') then
  result:=1;
end;

//ファイル構造から判別
function TForm1.checkImageFormat(path:string):integer;
//  -1: 不明
//   0: bmp
//   1: jpg
//   2: gif
//   3: 拡張メタファイル emf
var F:File;
    Buf: array[0..50] of Char;
    i,Attrs:integer;
begin
  result:=-1;
  if FileExists(path)=True then
  begin
    Attrs := FileGetAttr(path);
    if Attrs and faReadOnly <> 0 then
      SetFileAttributes(PChar(path),Attrs - faReadOnly);

    finally
    if Attrs and faReadOnly <> 0 then
      SetFileAttributes(PChar(path),Attrs);
    CloseFile(F);
    end;
  end;
end;

//拡張子から判別する
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
i:=GetFileType(Edit1.Text);
case i of
0:Caption:='ビットマップファイル';
1:Caption:='JPEGファイル';
else Caption:='それ以外';
end;
end;

//ファイル構造から判別する
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
i:=checkImageFormat(Edit1.Text);
case i of
0:Caption:='ビットマップファイル';
1:Caption:='JPEGファイル';
else Caption:='それ以外';
end;
end;

end.

ハム 2004-08-31 09:21:01 No: 10689

サラダ(スライスチーズ）さんありがとうございました。
解決しました。