Delphi による画像ファイルの表示とファイル形式変換
Delphiで使用できる画像ファイル形式です。
ビットマップ形式のファイルは、一応標準で組み込まれていますが他の形式に関しては、USESにユニットを追加して使用します。
変換先のファイル形式によっては、画質が低下します。
ＧＤＩ＋によるファイル変換(GDI+ Windows XPから組み込まれています)
| 拡張子の種類 | 名称 | 保存 |
|---|---|---|
| BMP | ビットマップ | 可能 |
| GIF | ギフ 複数フレーム対応 | 可能 |
| JPG,JPEG | ジェイペグ | 可能 |
| PNG | ピング | 可能 |
| TIF,TIFF | ティフ 複数フレーム対応 | 可能 |
| PNG | ピング | 可能 |
| WMF | ウィンドウズメタファイル | 不可 |
| EMF | エンハンスドメタファイル | 不可 |
| EMF+ | エンハンスドメタファイルプラス | 不可 |
| ICO,ICON | アイコン | 不可 |
Windows Imaging Componentによるファイル変換(WIC Windows Vista XPSP3 以降)
| 拡張子の種類 | 名称 | 保存 |
|---|---|---|
| BMP | ビットマップ | 可能 |
| GIF | ギフ 複数フレーム対応 | 可能 |
| JPG,JPEG | ジェイペグ | 可能 |
| PNG | ピング | 可能 |
| TIF,TIFF | ティフ 複数フレーム対応 | 可能 |
| PNG | ピング | 可能 |
| HDP,WDP | HD photo | 可能 |
| ICO,ICON | アイコン | 不可 |
専用unit使用による変換
| ユニット名 | ファイルの種類 |
|---|---|
| JPEG | JPG,JPEG |
| GifImg | GIF |
| PngImage | PNG |
標準 TImageその他 (TIF,TIFF標準で読み込めますがWIC経由となります)
| 拡張子の種類 | 名称 | 保存 |
|---|---|---|
| BMP,DIB | ビットマップ,ディーアイビー | 可能 |
| WMF | ウィンドウズメタファイル | 不可 |
| EMF | エンハンスドメタファイル | 不可 |
| TIF,TIFF | ティフ(WIC経由) | 不可 |
| ICO,ICON | アイコン | 不可 |
FMXによるファイル変換
| 拡張子の種類 | 名称 | 保存 |
|---|---|---|
| BMP | ビットマップ | 可能 |
| JPG,JPEG | ジェイペグ | 可能 |
| TIF,TIFF | ティフ | 可能 |
| GIF | ギフ | 可能 |
| PNG | ピング | 可能 |
| WMP | wmpファイル | (注) |
| ICO,ICON | アイコン | 不可 |
(注) Windows Media photo のフォーマットですが、一般的なアプリケーションで全く採用されていないのて確認が取れません。
参考 Windows Paintによるファイル変換
| 拡張子の種類 | 名称 | 保存 |
|---|---|---|
| BMP,DIB | ビットマップ,ディーアイビー | 可能 |
| JPG,JPEG | ジェイペグ | 可能 |
| GIF | ギフ | 可能 |
| TIF,TIFF | ティフ | 可能 |
| PNG | ピング | 可能 |
| ICO,ICON | アイコン | 不可 |
WIC使用プログラム例
//----------------------------------------------------------------------------------------- // WICを使用して画像ファイル形式を変換して保存するプログラムです。 // 一度TBitmapのビットマップ形式に変換していますが、TBitmapに変換しなくても変換は可能です。 // ビットマップ形式に変換は、単に画像処理が出来るようにするためです。 //----------------------------------------------------------------------------------------- unit WicFileConv; interface uses Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls, system.UITypes; type TForm1 = class(TForm) FileOpenBtn: TButton; OpenPictureDialog1: TOpenPictureDialog; FileSaveBtn: TButton; SavePictureDialog1: TSavePictureDialog; ScrollBox1: TScrollBox; Image1: TImage; Panel1: TPanel; RadioButton1: TRadioButton; RadioButton2: TRadioButton; magnificationEdit: TLabeledEdit; ReDisplay: TButton; procedure FileOpenBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FileSaveBtnClick(Sender: TObject); procedure ReDisplayClick(Sender: TObject); private { Private 宣言 } procedure Imageout(Image: TBitmap); procedure trimming_imageout(Image: TBitmap); public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} const OpenFileFilter = '画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+ '|*.png|*.png' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.bmp|*.bmp' + '|*.tif|*.tif' + '|*.ico|*.ico' + '|*.wdp|*.wdp'; SaveFileFilter = '画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.wdp' + '|*.png|*.png' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.bmp|*.bmp' + '|*.tif|*.tif' + '|*.wdp|*.wdp'; ImageHWC = 440; // 表示枠サイズ var OutputBitmap : TBitmap; // 画像処理表示用ビットマップ //------------------------ // 変倍出力 //------------------------ procedure TForm1.Imageout(Image: TBitmap); var Rect0 : TRect; magnification : Double; Check : Integer; MW, MH : Integer; begin Val(magnificationEdit.Text,magnification,Check); if Check <> 0 then begin application.MessageBox('表示倍率入力に間違いがあります。','注意',0); exit; end; MW := Round(Image.Width * magnification); MH := Round(Image.Height * magnification); Rect0 := Rect(0, 0, MW, MH); Image1.Width := MW; Image1.Height := MH; Image1.Picture.Bitmap.SetSize(MW, MH); Image1.Canvas.StretchDraw(Rect0, Image); // 変倍出力 end; //---------------------------------------------------- // 開いたファイルの画像表示 出力枠に合わせて変倍出力 //---------------------------------------------------- procedure TForm1.trimming_imageout(Image: TBitmap); begin if Image.Width >= Image.Height then begin Image1.Width := ImageHWC - 6; image1.Height := round((ImageHWC - 6) * image.Height / Image.Width); end else begin Image1.Height := ImageHWC - 6; image1.Width := round((ImageHWC - 6) * image.Width / Image.Height); end; Image1.Picture.Bitmap.SetSize(Image1.Width, image1.Height); Image1.Canvas.StretchDraw(Rect(0, 0, Image1.Width, image1.Height), Image); // 出力枠に変倍出力 magnificationEdit.Text := floatTostrF(Image1.Width / Image.Width, ffGeneral, 4, 2); end; //------------------- // 表示方法の選択 //------------------- procedure TForm1.ReDisplayClick(Sender: TObject); begin if RadioButton2.Checked then imageout(OutputBitmap); // 変倍出力 if RadioButton1.Checked then trimming_imageout(OutputBitmap); // 出力枠に合わせて変倍出力 end; //--------------------- // ファイルのオープン //--------------------- procedure TForm1.FileOpenBtnClick(Sender: TObject); var VRect : TRect; // 表示サイズ設定用 WIC : TWICImage; begin VRect := Rect(0, 0, Image1.Width, Image1.Height); Image1.Canvas.Brush.Style := bsSolid; Image1.Canvas.Brush.Color := clBtnface; Image1.Canvas.FillRect(VRect); // Canvas 画像消去 OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定 if OpenPictureDialog1.Execute = true then // ファイルが指定されたら begin WIC := TWICImage.Create; // TWICImageの生成 try WIC.LoadFromFile(OpenPictureDialog1.FileName); // 画像の読み込み // OutputBitmapに原画像一時保存 OutputBitmap.Width := WIC.Width; OutputBitmap.Height := WIC.Height; OutputBitmap.Canvas.Draw(0, 0, WIC); // ビットマップに描画フォーマット変換書き込み finally WIC.Free; // TWICImage 解放 end; end else exit; if RadioButton2.Checked then imageout(OutputBitmap); // 出力枠に変倍出力 if RadioButton1.Checked then trimming_imageout(OutputBitmap); // 出力枠に合わせてに変倍出力 FileSaveBtn.Enabled := True; end; //------------------------------ // 画像のファイルへの保存 //------------------------------ procedure TForm1.FileSaveBtnClick(Sender: TObject); var WIC : TWicImage; WICF : TWicImageFormat; Fname : String; ExeStr : String; FnameTop: String; Findex : integer; function WFormatSet: Boolean; // 拡張子によるファイルフォーマット設定 begin Result := false; ExeStr := LowerCase(ExeStr); if ExeStr = '.jpg' then begin WICF := Wifjpeg; Result := True; end; if ExeStr = '.jpeg' then begin WICF := Wifjpeg; Result := True; end; if ExeStr = '.tif' then begin WICF := Wiftiff; Result := True; end; if ExeStr = '.tiff' then begin WICF := Wiftiff; Result := True; end; if ExeStr = '.png' then begin WICF := Wifpng; Result := True; end; if ExeStr = '.gif' then begin WICF := Wifgif; Result := True; end; if ExeStr = '.bmp' then begin WICF := Wifbmp; Result := True; end; if ExeStr = '.wdp' then begin WICF := WifWMPhoto; Result := True; end; if ExeStr = '.hdp' then begin WICF := WifWMPhoto; Result := True; end; end; begin SavePictureDialog1.Filter := SaveFileFilter; // SavePictureDialog1.DefaultExt := GraphicExtension(TWicImage); if not SavePictureDialog1.Execute then exit; ExeStr := ExtractFileExt(SavePictureDialog1.FileName); if ExeStr = '' then begin // 拡張子がなかったら Findex := SavePictureDialog1.FilterIndex; // FilterIndexによる拡張子の設定 case Findex of 1, 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); // 拡張子の設定 2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); // 拡張子の設定 4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); // 拡張子の設定 5 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); // 拡張子の設定 6 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.tif'); // 拡張子の設定 7 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.wdp'); // 拡張子の設定 end; end else Fname := SavePictureDialog1.FileName; ExeStr := ExtractFileExt(Fname); // 拡張子だけ取り出し if not WFormatSet then begin // 拡張子によるファイルフォーマット設定と確認 application.MessageBox('ファイルの拡張子が間違っています。','注意', 0); exit; end; FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し if Length(FnameTop) = Length(ExeStr) then begin // ファイル名の長さ確認 application.MessageBox('ファイル名がありません。','注意', 0); exit; end; if FileExists(Fname) then // ファイル名によるファイル検索 if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?', mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit; WIC := TWicImage.Create; // TWicImage生成 try WIC.Assign(OutputBitmap); // TWicImageにビットマップデーター割り付け WIC.ImageFormat := WICF; // 保存フォーマットセット WIC.SaveTofile(Fname); // ファイルの書き出し finally WIC.Free; // TWicImage解放 end; end; // 初期設定 procedure TForm1.FormCreate(Sender: TObject); begin Image1.Width := ImageHWC div 2; Image1.Height := ImageHWC div 2; ScrollBox1.Height := ImageHWC; ScrollBox1.Width := ImageHWC; Image1.Top := 0; Image1.Left := 0; OutputBitmap := TBitmap.Create; OutputBitmap.PixelFormat := pf32bit; FileSaveBtn.Enabled := False; end; // 終了処理 procedure TForm1.FormDestroy(Sender: TObject); begin OutputBitmap.Free; end; end.
GDI+ によるファイル変換例
//---------------------------------------------------------------------------- // TBitmapを使用していますが、使用しなくてもファイル変換は可能です。 // 下記を使用すれば変倍描画も可能です。 // Graphics := TGPGraphics.Create(Image1.Canvas.Handle); // Graphics.DrawImage(GPBitmap, MakeRect(0, 0, Image1.Width, image1.Height)); // TBitmapは画像処理を行うことを前提に使用しています。 //---------------------------------------------------------------------------- unit GdIPFileConvMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.UITypes, Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ExtDlgs; type TForm1 = class(TForm) ScrollBox1: TScrollBox; Image1: TImage; OpenPictureDialog1: TOpenPictureDialog; SavePictureDialog1: TSavePictureDialog; FileSaveBtn: TButton; Panel1: TPanel; RadioButton1: TRadioButton; RadioButton2: TRadioButton; magnificationEdit: TLabeledEdit; ReDisplay: TButton; FileOpenBtn: TButton; procedure FormCreate(Sender: TObject); procedure ReDisplayClick(Sender: TObject); procedure FileOpenBtnClick(Sender: TObject); procedure FileSaveBtnClick(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private 宣言 } procedure Imageout(Image: TBitmap); procedure trimming_imageout(Image: TBitmap); public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPAPI, GDIPOBJ, GDIPUTIL; const OpenFileFilter = '画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.emf;*.wmf;*.ico' + '|*.png|*.png' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.bmp|*.bmp' + '|*.tif|*.tif' + '|*.emf|*.emf' + '|*.wmf|*.wmf' + '|*.ico|*.ico'; SaveFileFilter = '画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif' + '|*.png|*.png' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.bmp|*.bmp' + '|*.tif|*.tif'; ImageHWC = 440; // 表示枠サイズ var OutputBitmap : TBitmap; // 画像保存用ビットマップ //------------------------ // 変倍出力 //------------------------ procedure TForm1.Imageout(Image: TBitmap); var Rect0 : TRect; magnification : Double; Check : Integer; MW, MH : Integer; begin Val(magnificationEdit.Text,magnification,Check); if Check <> 0 then begin application.MessageBox('表示倍率入力に間違いがあります。','注意',0); exit; end; MW := Round(Image.Width * magnification); MH := Round(Image.Height * magnification); Rect0 := Rect(0, 0, MW, MH); Image1.Width := MW; Image1.Height := MH; Image1.Picture.Bitmap.SetSize(MW, MH); Image1.Canvas.StretchDraw(Rect0, Image); // 変倍出力 end; //---------------------------------------------------- // 開いたファイルの画像表示 出力枠に合わせて変倍出力 //---------------------------------------------------- procedure TForm1.trimming_imageout(Image: TBitmap); begin if Image.Width >= Image.Height then begin Image1.Width := ImageHWC - 6; image1.Height := round((ImageHWC - 6) * image.Height / Image.Width); end else begin Image1.Height := ImageHWC - 6; image1.Width := round((ImageHWC - 6) * image.Width / Image.Height); end; Image1.Picture.Bitmap.SetSize(Image1.Width, image1.Height); Image1.Canvas.StretchDraw(Rect(0, 0, Image1.Width, image1.Height), Image); // 出力枠に変倍出力 magnificationEdit.Text := floatTostrF(Image1.Width / Image.Width, ffGeneral, 4, 2); end; //-------------------- // 表示方法の選択 //-------------------- procedure TForm1.ReDisplayClick(Sender: TObject); begin if RadioButton2.Checked then imageout(OutputBitmap); // 変倍出力 if RadioButton1.Checked then trimming_imageout(OutputBitmap); // 出力枠に合わせて変倍出力 end; //-------------------------------------------------------------- // ファイルを開いてGDI+のbitmapに読み込みます // GDI+の書き込みハンドルをTbitmapのハンドルに設定 // GDI+のbitmapをTbitmapに書き込みます // 選択された変倍方法でTbitmapをTimageに書き込み表示します。 // Tbitmap OutputBitmapは元画像データー保存用に使用していますが // OutputBitmapを省略すことは可能です。 //-------------------------------------------------------------- procedure TForm1.FileOpenBtnClick(Sender: TObject); var Graphics : TGPGraphics; GPBitmap : TGPBitmap; VRect : TRect; // 表示サイズ設定用 begin FileSaveBtn.Enabled := False; VRect := Rect(0, 0, Image1.Width, Image1.Height); Image1.Canvas.Brush.Style := bsSolid; Image1.Canvas.Brush.Color := clBtnface; Image1.Canvas.FillRect(VRect); // Canvas 画像消去 OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定 if OpenPictureDialog1.Execute then // ファイルが指定されたら begin GPBitmap := TGPBitmap.Create(OpenPictureDialog1.FileName); // ファイルとの関連付け OutputBitmap.Height := GPBitmap.GetHeight; OutputBitmap.Width := GPBitmap.GetWidth; Graphics := TGPGraphics.Create(OutputBitmap.Canvas.Handle); try Graphics.DrawImage(GPBitmap, 0, 0, OutputBitmap.Width, OutputBitmap.Height); finally Graphics.Free; GPBitmap.Free; end; end else exit; if RadioButton2.Checked then imageout(OutputBitmap); // 出力枠に変倍出力 if RadioButton1.Checked then trimming_imageout(OutputBitmap); // 出力枠に合わせてに変倍出力 FileSaveBtn.Enabled := True; end; //---------------------------------------------------------------- // ファイルの名前と種類を選択して保存します。 // TbitmapのデーターをGDI+に渡すためにTMemoryStreamを使用します。 //---------------------------------------------------------------- procedure TForm1.FileSaveBtnClick(Sender: TObject); var GPBitmap : TGPBitmap; Astream : TMemoryStream; Fname : String; // 保存用ファイル名 ExeStr : String; FnameTop : String; Convstr : String; Findex : integer; LImgGUID : TGUID; function GdipFormatSet: boolean; begin Result := false; ExeStr := LowerCase(ExeStr); if ExeStr = '.png' then begin Convstr := 'image/png'; Result := true; end; if ExeStr = '.jpg' then begin Convstr := 'image/jpeg'; Result := true; end; if ExeStr = '.jpeg' then begin Convstr := 'image/jpeg'; Result := true; end; if ExeStr = '.gif' then begin Convstr := 'image/gif'; Result := true; end; if ExeStr = '.bmp' then begin Convstr := 'image/bmp'; Result := true; end; if ExeStr = '.tif' then begin Convstr := 'image/tiff'; Result := true; end; if ExeStr = '.tiff' then begin Convstr := 'image/tiff'; Result := true; end; end; begin SavePictureDialog1.Filter := SaveFileFilter; if not SavePictureDialog1.Execute then exit; ExeStr := ExtractFileExt(SavePictureDialog1.FileName); // 拡張子の取り出し if ExeStr = '' then begin // 拡張子がなかったら Findex := SavePictureDialog1.FilterIndex; // FilterIndexによる拡張子の設定 case Findex of 2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); // 拡張子の設定 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); 4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); 5 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); 6 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.tif'); end; end else Fname := SavePictureDialog1.FileName; ExeStr := ExtractFileExt(Fname); // 拡張子だけ取り出し if not GdipFormatSet then begin // 拡張子によるファイルフォーマット設定と確認 application.MessageBox('ファイルの拡張子が間違っています。','注意', 0); exit; end; FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し if Length(FnameTop) = Length(ExeStr) then begin // ファイル名の長さ確認 application.MessageBox('ファイル名がありません。','注意', 0); exit; end; if FileExists(Fname) then // ファイル名によるファイル検索 if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?', mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit; // メモリーストリームを作成し OutputBitmap を出力 Astream := TMemoryStream.Create; OutputBitmap.SaveToStream(Astream); // メモリーストリームから，TGPBitmapのオブジェクトに読み込み指定 GPBitmap := TGPBitmap.Create(TStreamAdapter.Create(AStream, soReference)); try // ファイル形式指定して書き込み if GetEncoderClsid(Convstr, LImgGUID) >= 0 then GPBitmap.Save(Fname, LImgGUID); finally // メモリー解放 GPBitmap.Free; Astream.Free; end; end; // 初期設定 procedure TForm1.FormCreate(Sender: TObject); begin Image1.Width := ImageHWC div 2; Image1.Height := ImageHWC div 2; ScrollBox1.Height := ImageHWC; ScrollBox1.Width := ImageHWC; Image1.Top := 0; Image1.Left := 0; OutputBitmap := TBitmap.Create; OutputBitmap.PixelFormat := pf32bit; FileSaveBtn.Enabled := False; end; // 終了処理 procedure TForm1.FormDestroy(Sender: TObject); begin OutputBitmap.Free; end; end.
Timage, ユニットJPEG,GifImg,PngImage によるファイル変換
//---------------------------------------------------- // Tiffファイルの読み込みはWIC経由になります。 // Tiff形式ファイルの出力はプロクラムされていません。 //---------------------------------------------------- unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls, System.UITypes; type TForm1 = class(TForm) ScrollBox1: TScrollBox; Image1: TImage; FileSaveBtn: TButton; FileOpenBtn: TButton; Panel1: TPanel; RadioButton1: TRadioButton; RadioButton2: TRadioButton; magnificationEdit: TLabeledEdit; ReDisplay: TButton; OpenPictureDialog1: TOpenPictureDialog; SavePictureDialog1: TSavePictureDialog; procedure FormCreate(Sender: TObject); procedure ReDisplayClick(Sender: TObject); procedure FileOpenBtnClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FileSaveBtnClick(Sender: TObject); private { Private 宣言 } procedure Imageout(Image: TBitmap); procedure AutoSize_imageout(Image: TBitmap); public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} uses Jpeg, GifImg, PNGImage; const OpenFileFilter = 'bmp|*.bmp' + '|wmf|*.wmf' + '|emf|*.emf' + '|ico|*.ico' + '|tif|*.tif;*tiff' + '|png|*.png' + '|jpg|*.jpg;*.jpeg' + '|gif|*.gif'; SaveFileFilter = 'bmp|*.bmp' + '|png|*.png' + '|jpg|*.jpg' + '|gif|*.gif'; ImageHWC = 440; // 表示枠サイズ var InputImage : TImage; // 画像入力用 OutBitmap : Tbitmap; // 画像用ビットマップ Findex : integer; // ファイルインデックス //------------------------ // 変倍出力 //------------------------ procedure TForm1.Imageout(Image: TBitmap); var Rect0 : TRect; magnification : Double; Check : Integer; MW, MH : Integer; begin Val(magnificationEdit.Text,magnification,Check); if Check <> 0 then begin application.MessageBox('表示倍率入力に間違いがあります。','注意',0); exit; end; MW := Round(Image.Width * magnification); MH := Round(Image.Height * magnification); Rect0 := Rect(0, 0, MW, MH); Image1.Width := MW; Image1.Height := MH; Image1.Picture.Bitmap.SetSize(MW, MH); Image1.Canvas.StretchDraw(Rect0, Image); // 変倍出力 end; //---------------------------------------------------- // 開いたファイルの画像表示 出力枠に合わせて変倍出力 //---------------------------------------------------- procedure TForm1.AutoSize_imageout(Image: TBitmap); begin if Image.Width >= Image.Height then begin Image1.Width := ImageHWC - 6; image1.Height := round((ImageHWC - 6) * image.Height / Image.Width); end else begin Image1.Height := ImageHWC - 6; image1.Width := round((ImageHWC - 6) * image.Width / Image.Height); end; Image1.Picture.Bitmap.SetSize(Image1.Width, image1.Height); Image1.Canvas.StretchDraw(Rect(0, 0, Image1.Width, image1.Height), Image); // 出力枠に変倍出力 magnificationEdit.Text := floatTostrF(Image1.Width / Image.Width, ffGeneral, 4, 2); end; //------------------- // 表示方法の選択 //------------------- procedure TForm1.ReDisplayClick(Sender: TObject); begin if RadioButton2.Checked then imageout(OutBitmap); // 変倍出力 if RadioButton1.Checked then AutoSize_imageout(OutBitmap); // 出力枠に合わせて変倍出力 end; //---------------------------------------------------------------------------- // 画像ファイルの読み込み // Tiff形式のファイルはWIC経由となります。 // メタ形式のファイル wmf と emf は 表示のみです。 // メタ形式のファイル以外ビットマップ形式に変換後表示しています。 // 画像ファイルをTImage に読み込んでから TBitmapに変換しています。 // TBitmapはビットマップファイルしか読み込めないのでTImageを経由させています。 //---------------------------------------------------------------------------- procedure TForm1.FileOpenBtnClick(Sender: TObject); var VRect : TRect; IPng : TPNGImage; IJpeg : TJPEGImage; IGif : TGIFImage; exstr : string; begin VRect := Rect(0, 0, Image1.Width, Image1.Height); // 表示画像の消去 case Findex of 1,4,5, 6,7,8 : begin Image1.Canvas.Brush.Style := bsSolid; Image1.Canvas.Brush.Color := clBtnface; Image1.Canvas.FillRect(VRect); // Canvas 画像消去 end; 2,3: begin Image1.Picture.Assign(nil); // Pictureの解除 画面消去 end; end; OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定 OpenPictureDialog1.FileName := ''; if OpenPictureDialog1.Execute = true then // ファイルが指定されたら begin FileSaveBtn.Enabled := False; // Findex := OpenPictureDialog1.FilterIndex; exstr := ExtractFileExt(OpenPictureDialog1.FileName); // 拡張子の取り出し exstr := LowerCase(exstr); // 小文字変換 Findex := 0; if (exstr = '.bmp') or (exstr = '.ico') or (exstr = '.tif') then Findex := 1; if (exstr = '.wmf') or (exstr = '.emf') then Findex := 2; if (exstr = '.png') then Findex := 6; if (exstr = '.jpg') or (exstr = '.jpeg') then Findex := 7; if (exstr = '.gif') then Findex := 8; Image1.AutoSize := False; Image1.Width := ImageHWC div 2; Image1.Height := ImageHWC div 2; case Findex of 1,4,5: begin InputImage.Picture.LoadFromFile(OpenPictureDialog1.FileName); // BITMAP画像の読み込み end; 2,3: begin Image1.AutoSize := True; Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); // メタ画像表示のみ exit; end; 6: begin IPng := TPNGImage.Create; IPng.LoadFromFile(OpenPictureDialog1.FileName); // PNG画像の読み込み InputImage.Picture.Assign(IPng); IPng.Free; end; 7: begin IJpeg := TJPEGImage.Create; IJpeg.LoadFromFile(OpenPictureDialog1.FileName); // JPEG画像の読み込み InputImage.Picture.Assign(IJpeg); IJpeg.Free; end; 8: begin IGif := TGIFImage.Create; IGif.LoadFromFile(OpenPictureDialog1.FileName); // GIF画像の読み込み InputImage.Picture.Assign(IGif); IGif.Free; end else exit; // 指定外の拡張子なら終了 end; end else exit; // ファイルの指定が無ければ終了 OutBitmap.Assign(nil); // ビットマップの解除 OutBitmap.Assign(InputImage.Picture.Graphic); // ビットマップに関連付け if RadioButton2.Checked then imageout(OutBitmap); // 出力枠に変倍出力 if RadioButton1.Checked then AutoSize_imageout(OutBitmap); // 出力枠に合わせてに変倍出力 FileSaveBtn.Enabled := True; end; //------------------------------------------------------------------ // メタ形式のファイル wmf と emf は 保存できません。 // Tiff 形式は WIC を使用したプログラムを参照してください。 //------------------------------------------------------------------ procedure TForm1.FileSaveBtnClick(Sender: TObject); var IPng : TPNGImage; IJpeg : TJPEGImage; IGif : TGIFImage; exstr : string; Fname : string; FnameTop : string; Fint : integer; begin SavePictureDialog1.Filter := SaveFileFilter; if not SavePictureDialog1.Execute then exit; exstr := ExtractFileExt(SavePictureDialog1.FileName); // 拡張子の取り出し if exstr = '' then begin // 拡張子がなかったら case SavePictureDialog1.FilterIndex of 1 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); // 拡張子の設定 2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); 4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); end; end else Fname := SavePictureDialog1.FileName; exstr := ExtractFileExt(Fname); // 拡張子の取り出し FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し if Length(FnameTop) = Length(exstr) then begin // ファイル名の長さ確認 application.MessageBox('ファイル名がありません。','注意', 0); exit; end; if FileExists(Fname) then // ファイル名によるファイル検索 if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?', mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit; exstr := LowerCase(exstr); // 小文字変換 Fint := 0; if (exstr = '.bmp') then Fint := 1; if (exstr = '.png') then Fint := 6; if (exstr = '.jpg') or (exstr = '.jpeg') then Fint := 7; if (exstr = '.gif') then Fint := 8; case Fint of 1: begin OutBitmap.SaveToFile(Fname); end; 6: begin IPng := TPNGImage.Create; IPng.Assign(OutBitmap); IPng.SaveToFile(Fname); IPng.Free; end; 7: begin IJpeg := TJPEGImage.Create; IJpeg.Assign(OutBitmap); IJpeg.SaveToFile(Fname); IJpeg.Free; end; 8: begin IGif := TGifImage.Create; IGif.Assign(OutBitmap); IGif.SaveToFile(Fname); IGif.Free; end; end; end; // 初期設定 procedure TForm1.FormCreate(Sender: TObject); begin Image1.Width := ImageHWC div 2; Image1.Height := ImageHWC div 2; ScrollBox1.Height := ImageHWC; ScrollBox1.Width := ImageHWC; Image1.Top := 0; Image1.Left := 0; InputImage := Timage.Create(nil); InputImage.AutoSize := true; OutBitmap := Tbitmap.Create; FileSaveBtn.Enabled := False; Findex := 0; end; // 終了処理 procedure TForm1.FormDestroy(Sender: TObject); begin InputImage.Free; OutBitmap.Free; end; end.
FMXによるファイル変換
//-------------------------------------------------------- // Delphi XE7 でのプログラムです。 // OpenDialog、SaveDialog1でFilterのindexが取得できない為 // ラジオボタンで保存ファイル形式を選択しています。 //-------------------------------------------------------- unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts, FMX.Gestures, FMX.StdCtrls, FMX.ExtCtrls; type TForm1 = class(TForm) ToolbarHolder: TLayout; ToolbarPopup: TPopup; ToolbarPopupAnimation: TFloatAnimation; ToolBar1: TToolBar; ToolbarApplyButton: TButton; ToolbarCloseButton: TButton; ToolbarAddButton: TButton; Button1: TButton; ImageViewer1: TImageViewer; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; Panel1: TPanel; RadioButton1: TRadioButton; RadioButton2: TRadioButton; RadioButton3: TRadioButton; RadioButton4: TRadioButton; RadioButton5: TRadioButton; Button2: TButton; procedure ToolbarCloseButtonClick(Sender: TObject); procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean); procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private FGestureOrigin: TPointF; FGestureInProgress: Boolean; { private 宣言 } procedure ShowToolbar(AShow: Boolean); public { public 宣言 } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); begin if Key = vkEscape then ShowToolbar(not ToolbarPopup.IsOpen); end; procedure TForm1.ToolbarCloseButtonClick(Sender: TObject); begin Application.Terminate; end; procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin ImageViewer1.Bitmap.LoadFromFile(OpenDialog1.FileName); Button2.Enabled := True; end; end; procedure TForm1.Button2Click(Sender: TObject); var Fname : string; begin SaveDialog1.FilterIndex := 1; if RadioButton1.IsChecked then SaveDialog1.Filter := 'ビットマップ|*bmp'; if RadioButton2.IsChecked then SaveDialog1.Filter := 'ジェイペグ|*.jpg;*.jpeg'; if RadioButton3.IsChecked then SaveDialog1.Filter := 'ピング|*.png'; if RadioButton4.IsChecked then SaveDialog1.Filter := 'ティフ|*.tif;*.tiff'; if RadioButton5.IsChecked then SaveDialog1.Filter := 'ギフ|*.gif'; if SaveDialog1.Execute then begin Fname := SaveDialog1.FileName; end else Exit; if RadioButton1.IsChecked then Fname := ChangeFileExt(SaveDialog1.FileName,'.bmp'); // 拡張子の設定 if RadioButton2.IsChecked then Fname := ChangeFileExt(SaveDialog1.FileName,'.jpg'); if RadioButton3.IsChecked then Fname := ChangeFileExt(SaveDialog1.FileName,'.png'); if RadioButton4.IsChecked then Fname := ChangeFileExt(SaveDialog1.FileName,'.tif'); if RadioButton5.IsChecked then Fname := ChangeFileExt(SaveDialog1.FileName,'.gif'); ImageViewer1.Bitmap.SaveToFile(Fname, nil); end; procedure TForm1.FormCreate(Sender: TObject); begin Button2.Enabled := False; end; procedure TForm1.FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean); var DX, DY : Single; begin if EventInfo.GestureID = igiPan then begin if (TInteractiveGestureFlag.gfBegin in EventInfo.Flags) and ((Sender = ToolbarPopup) or (EventInfo.Location.Y > (ClientHeight - 70))) then begin FGestureOrigin := EventInfo.Location; FGestureInProgress := True; end; if FGestureInProgress and (TInteractiveGestureFlag.gfEnd in EventInfo.Flags) then begin FGestureInProgress := False; DX := EventInfo.Location.X - FGestureOrigin.X; DY := EventInfo.Location.Y - FGestureOrigin.Y; if (Abs(DY) > Abs(DX)) then ShowToolbar(DY < 0); end; end; end; procedure TForm1.ShowToolbar(AShow: Boolean); begin ToolbarPopup.Width := ClientWidth; ToolbarPopup.PlacementRectangle.Rect := TRectF.Create(0, ClientHeight-ToolbarPopup.Height, ClientWidth-1, ClientHeight-1); ToolbarPopupAnimation.StartValue := ToolbarPopup.Height; ToolbarPopupAnimation.StopValue := 0; ToolbarPopup.IsOpen := AShow; end; end.
FileConvert.zip