画像ファイルのみ対応させるには？ (ID:10688)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

スライスチーズです。
とりあえず
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);

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;

//拡張子から判別する
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.

←解決時は質問者本人がここをチェックしてください。

戻る