Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2013年07月18日] [更新 2013年07月22日] GDI+ 関係サンプル
GDI+ 関係サンプル 
G170_画像の解像度の取得と設定
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
G170_GDIPlus_DPI_Resolution.zip [3,042 KB] 2013年07月22日版 (EXE 同梱)



  • 2013年07月22日
  • 画像のプロパティタグの分数形式プロパティの配列を,動的配列を使用する方式に変更




画像の解像度の取得と設定


GDI+ を使用して,画像の解像度を取得,あるいは設定変更するサンプルです.ここで言う「解像度」とは,DPI (1 インチ当たりのドット数) を意味します.
CRT や TFT 等の表示デバイスあるいはプリンタ等の印刷デバイスでは,色の三原色等の各要素の点 (ドット) の集合を「画素 (ピクセル)」と言っています.1 ドットが 1 ピクセル (画素) のデバイスもありますが,一般に,出力装置によってピクセルを構成するドット数は異なります.したがって,正確には 1 インチ当たりのピクセル数,あるいは画素数ですが,ドットはピクセルと同じ意味で使用されることがあります.

本ページのサンプルでは,解像度を変更した画像を,元の画像に上書きするのではなく,別の名前で保存しています.これはサンプルプログラムとしての都合です.元の画像の解像度を変更してしまうと,別のサンプルでまたテスト用の画像を用意するのが面倒だからです.元と同じ画像形式で,ファイル名も同じにして保存すれば上書き保存になります.

変更後の解像度は,全て 300 dpi に固定してテストしています.
サンプルプログラムでは画像を表示していますが,画像を表示する必要がなければ,その部分のコードは必要ありません.

GDI+ に限らず,画像のインスタンスが操作中の場合,その画像ファイルに対する変更操作はできません.そこで,本ページのサンプルでは,保存の前に,元の画像のインスタンスを解放したり,メモリストリーム等に保存したりしています.必要に応じて方法を考えてください.
ほとんど同じ様な処理になりますが,[G160_表示中の画像ファイルの操作], [G170_JPEG 画像保存時の品質設定] にも,表示中の画像のファイル操作例があります.

本ページのサンプルでは,表示サイズ,ピクセル数を指定して画像を描画しています.表示サイズを指定しないで表示する場合は,解像度の違いによって表示サイズが異なります.
例えば次の図は,ワードに画像を貼り付けた場合です.上は 300 dpi で,下は 96 dpi の場合です.

なお,GIF (ジフ) 画像には解像度の概念はありません.GetHorizontalResolution 等で得られる値は GIF 画像の解像度ではありません.何の値かは未調査です.


図1
解像度の違いによる表示の違い
  • 上は 300 dpi の画像
  • 下は 96 dpi の画像




01_画像の解像度の取得


画像の解像度を,TGPImage または TGPBitmap の次のメソッドで取得するサンプルです.
  • GetHorizontalResolution
  • GetVerticalResolution
解像度の取得のコードは,この後のサンプルでも使用しています.


図2
設計時画面
図3
実行結果例
  • 添付の画像の場合
  • 水平方向,垂直方向共に 96 dpi

画像を描画する際に,表示サイズを指定しないで,次のようなコードで描画すれば,解像度の違いを表示画像で確認できます.ただし,TImage 等の表示コントロールに描画する場合は,そのサイズの設定に注意が必要です.

  //確認のためにこのForm1のCanvasに描画
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  //LGPGraphic.DrawImage(LGPBitmap, 8, 85, LImageWidth, LImageHeight);
  LGPGraphic.DrawImage(LGPBitmap, 8, 85);


図4
解像度の違いを画像で確認
  • 上の画像は 96 dpi
  • この画像は 300 dpi に変更した画像

リスト1
画像の解像度の取得
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath : string;
    FInitialDir    : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像の解像度';

  FImageFilePath := '';
  FInitialDir    := '';
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPImage     : TGPImage;
  LXResolution : Single;
  LYResolution : Single;
begin
  if FInitialDir = '' then FInitialDir := ExpandFileName('../');

  OpenDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.jpeg;*.bmp;*.gif';
  OpenDialog1.InitialDir := FInitialDir;

  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := '';
    LabeledEdit2.Text := '';

    FInitialDir    := ExtractFileDir(OpenDialog1.FileName);
    FImageFilePath := OpenDialog1.FileName;

    //画像ファイルからTGPImageのインスタンスを生成
    LGPImage := TGPBitmap.Create(FImageFilePath);

    //解像度を取得
    LXResolution := LGPImage.GetHorizontalResolution;
    LYResolution := LGPImage.GetVerticalResolution;

    //取得した解像度を表示
    LabeledEdit1.Text := IntToStr(Trunc(LXResolution));
    LabeledEdit2.Text := IntToStr(Trunc(LYResolution));

    LGPImage.Free;
    //画像を描画
    //解像度の取得だけであれば,画像を表示する必要はない
    Invalidate;
  end;
end;

//=============================================================================
//  Form1のOnPaintイベント
//  このイベント内で描画を行う
//  画像を描画しなくてもいいのであれば,このイベントのコードは不要
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LImageWidth  : Cardinal;
  LImageHeight : Cardinal;
  LGPGraphic   : TGPGraphics;
  LGPBitmap    : TGPBitmap;
begin
  if FImageFilePath = '' then exit;

  //画像ファイルを読み込んでTGPBitmapkのインスタンスを生成
  //画像の幅と高さを取得しておく
  LGPBitmap    := TGPBitmap.Create(FImageFilePath);
  LImageWidth  := LGPBitmap.GetWidth;
  LImageHeight := LGPBitmap.GetHeight;

  //確認のためにこのForm1のCanvasに描画
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPGraphic.DrawImage(LGPBitmap, 8, 85, LImageWidth, LImageHeight);

  FreeAndNil(LGPBitmap);
  FreeAndNil(LGPGraphic);
end;

end.




02_SetResolution メソッドによる解像度の設定


TGPBitmpa の SetResolution メソッドを使用した解像度の設定,解像度の変更サンプルです.
この SetResolution メソッドは,TGPImage にはありません.TGPImage を継承した TGPBitmap にあるメソッドです.

画像ファイルから TGPBitmap のインスタンスを生成しますが,このインスタンスに対して解像度を設定しても有効になりせん.そこで,別の TGPBitmap を作成し,その解像度を変更します.
解像度を変更したら,新しい TGPBitmap を描画先として元の画像を描画します.そして,この新しく作成した TGPBitmap を保存します.

当然ですが,画像の確認が必要なければ,ボタンを 2 つ用意する必要はありません.直ちに解像度を変更して保存するコードを実行することになります.


図5
設計時画面
図6
添付の画像ファイルを読み込む
  • 解像度は,水平方向,垂直方向共に 96 dpi

保存した結果の XXX.jpg を,[プロパティ] ダイアログを表示して確認した図です.
元の画像の解像度は 96 dpi でしたが,300 dpi に変わっているのが確認できます.解像度の確認は,サンプルプログラムを起動して,対象の画像を読み込むことでも確認できます.


図7
解像度の確認
  • 解像度が 300 dpi に変わっている

リスト2
SetResolution メソッドによる解像度の設定
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath : string;
    FInitialDir    : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像の解像度の取得と設定';

  FImageFilePath := '';
  FInitialDir    := '';
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPImage     : TGPImage;
  LXResolution : Single;
  LYResolution : Single;
begin
  if FInitialDir = '' then FInitialDir := ExpandFileName('../');

  OpenDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.jpeg;*.bmp;*.gif';
  OpenDialog1.InitialDir := FInitialDir;

  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := '';
    LabeledEdit2.Text := '';

    FInitialDir    := ExtractFileDir(OpenDialog1.FileName);
    FImageFilePath := OpenDialog1.FileName;

    //画像ファイルからTGPImageのインスタンスを生成
    LGPImage := TGPBitmap.Create(FImageFilePath);

    //解像度を取得
    LXResolution := LGPImage.GetHorizontalResolution;
    LYResolution := LGPImage.GetVerticalResolution;

    //取得した解像度を表示
    LabeledEdit1.Text := IntToStr(Trunc(LXResolution));
    LabeledEdit2.Text := IntToStr(Trunc(LYResolution));

    LGPImage.Free;
    //画像を表示
    //解像度の取得と変更だけであれば,画像を表示する必要はない
    Invalidate;
  end;
end;

//=============================================================================
//  [保存]ボタン
//  解像度を変更して保存する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LImageWidth  : Cardinal;
  LImageHeight : Cardinal;
  LGPGraphic   : TGPGraphics;
  LGPBitmap    : TGPBitmap;
  LGPNewBitmap : TGPBitmap;
  LPixelFormat : Integer;
  LImgGUID     : TGUID;
begin
  if FImageFilePath = '' then exit;

  //あらかじめnilを代入しておくとインスタンスの有無の検出が容易
  //ただし[ヒント]が表示されてしまう
  {$HINTS OFF}
  LGPGraphic   := nil;
  LGPBitmap    := nil;
  LGPNewBitmap := nil;
  {$HINTS ON}

  //画像ファイルを読み込んでTGPBitmapkのインスタンスを生成
  //画像の幅と高さを取得しておく
  LGPBitmap    := TGPBitmap.Create(FImageFilePath);
  LImageWidth  := LGPBitmap.GetWidth;
  LImageHeight := LGPBitmap.GetHeight;

  //別のTGPBitmapのインスタンスを生成
  //ピクセルフォーマットの指定(これがないと保存に失敗するようだ)
  LPixelFormat  := LGPBitmap.GetPixelFormat;
  LGPNewBitmap := TGPBitmap.Create(LImageWidth, LImageHeight, LPixelFormat);
  //解像度を変更
  LGPNewBitmap.SetResolution(300.0, 300.0);

  //新しく生成したTGPBitmapを描画先としてTGPGraphicsを生成し
  //元のTGPBitmapの内容を描画する
  if Assigned(LGPGraphic) then LGPGraphic.Free;
  LGPGraphic := TGPGraphics.Create(LGPNewBitmap);
  LGPGraphic.DrawImage(LGPBitmap, 0, 0, LImageWidth, LImageHeight);

  //対象の画像のインスタンスが有効のままだと上書き保存できない
  FreeAndNil(LGPBitmap);
  FreeAndNil(LGPGraphic);

  //JPEG画像として保存
  if GetEncoderClsid('image/jpeg', LImgGUID) >= 0 then begin
    if LGPNewBitmap.Save('XXX.jpg', LImgGUID) <> Ok then begin
      MessageBox(Handle, '保存できませんでした', '情報', MB_ICONINFORMATION);
    end;
  end;

  if Assigned(LGPNewBitmap) then FreeAndNil(LGPNewBitmap);
  if Assigned(LGPBitmap)    then FreeAndNil(LGPBitmap);
  if Assigned(LGPGraphic)   then FreeAndNil(LGPGraphic);
end;

//=============================================================================
//  Form1のOnPaintイベント
//  画像を描画しなくてもいいのであれば,このイベントのコードは不要
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LImageWidth  : Cardinal;
  LImageHeight : Cardinal;
  LGPGraphic   : TGPGraphics;
  LGPBitmap    : TGPBitmap;
begin
  if FImageFilePath = '' then exit;

  //あらかじめnilを代入しておくとインスタンスの有無の検出が容易
  //ただし[ヒント]が表示されてしまう
  {$HINTS OFF}
  LGPGraphic := nil;
  LGPBitmap  := nil;
  {$HINTS ON}

  //画像ファイルを読み込んでTGPBitmapkのインスタンスを生成
  //画像の幅と高さを取得しておく
  LGPBitmap    := TGPBitmap.Create(FImageFilePath);
  LImageWidth  := LGPBitmap.GetWidth;
  LImageHeight := LGPBitmap.GetHeight;

  //確認のためにこのForm1のCanvasに描画
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPGraphic.DrawImage(LGPBitmap, 8, 85, LImageWidth, LImageHeight);

  if Assigned(LGPBitmap)  then FreeAndNil(LGPBitmap);
  if Assigned(LGPGraphic) then FreeAndNil(LGPGraphic);
end;

end.




03_SetResolution メソッドによる解像度の設定  - TImage に描画


同じく SetResolution メソッドで解像度を変更するサンプルですが,読み込んだ画像を TImage に表示する場合の参考です.
設計時の画面も,実行結果も全て,上のサンプルと同じです.


リスト3
SetResolution メソッドによる解像度の設定
画像を TImage に描画する場合
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath : string;
    FInitialDir    : string;
    FImageWidth    : Cardinal;
    FImageHeight   : Cardinal;
    FGPGraphic     : TGPGraphics;
    FGPBitmap      : TGPBitmap;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像の解像度の取得と設定';

  FInitialDir    := '';

  Image1.Left := 8;
  Image1.Top  := 85;

  //あらかじめnilを代入しておくとインスタンスの有無の検出が容易
  //ただし[ヒント]が表示されてしまう
  FGPGraphic   := nil;
  FGPBitmap    := nil;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
  if Assigned(FGPBitmap)  then FreeAndNil(FGPBitmap);
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LXResolution : Single;
  LYResolution : Single;
begin
  if FInitialDir = '' then FInitialDir := ExpandFileName('../');

  OpenDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.jpeg;*.bmp;*.gif';
  OpenDialog1.InitialDir := FInitialDir;

  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := '';
    LabeledEdit2.Text := '';
    //Image1の画像をクリア
    //クリアしないと別の画像を表示できない
    Image1.Picture.Assign(nil);

    FInitialDir    := ExtractFileDir(OpenDialog1.FileName);
    FImageFilePath := OpenDialog1.FileName;

    //画像ファイルからTGPImageのインスタンスを生成
    if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
    FGPBitmap := TGPBitmap.Create(FImageFilePath);

    //解像度を取得
    LXResolution := FGPBitmap.GetHorizontalResolution;
    LYResolution := FGPBitmap.GetVerticalResolution;

    //取得した解像度を表示
    LabeledEdit1.Text := IntToStr(Trunc(LXResolution));
    LabeledEdit2.Text := IntToStr(Trunc(LYResolution));

    //画像の幅と高さを取得し,Image1のサイズをその大きさにする
    FImageWidth   := FGPBitmap.GetWidth;
    FImageHeight  := FGPBitmap.GetHeight;
    Image1.Width  := FImageWidth;
    Image1.Height := FImageHeight;

    //確認のためにこのImage1のCanvasに描画
    //解像度の取得と変更だけであれば,画像を表示する必要はない
    if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
    FGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
    FGPGraphic.DrawImage(FGPBitmap, 0, 0, FImageWidth, FImageHeight);
  end;
end;

//=============================================================================
//  [保存]ボタン
//  解像度を変更して保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPNewBitmap : TGPBitmap;
  LPixelFormat : Integer;
  LImgGUID     : TGUID;
begin
  if FImageFilePath = '' then exit;

  //別のTGPBitmapのインスタンスを生成
  //ピクセルフォーマットの指定(これがないと保存に失敗するようだ)
  LPixelFormat  := FGPBitmap.GetPixelFormat;
  LGPNewBitmap := TGPBitmap.Create(FImageWidth, FImageHeight, LPixelFormat);
  //解像度を変更
  LGPNewBitmap.SetResolution(300.0, 300.0);

  //新しく生成したTGPBitmapを描画先としてTGPGraphicsを生成し
  //元のTGPBitmapの内容を描画する
  if Assigned(FGPGraphic) then FGPGraphic.Free;
  FGPGraphic := TGPGraphics.Create(LGPNewBitmap);
  FGPGraphic.DrawImage(FGPBitmap, 0, 0, FImageWidth, FImageHeight);

  //対象の画像のインスタンスが有効のままだと上書き保存できない
  FreeAndNil(FGPBitmap);
  FreeAndNil(FGPGraphic);

  //JPEG画像として保存
  if GetEncoderClsid('image/jpeg', LImgGUID) >= 0 then begin
    if LGPNewBitmap.Save('XXX.jpg', LImgGUID) <> Ok then begin
      MessageBox(Handle, '保存できませんでした', '情報', MB_ICONINFORMATION);
    end;
  end;

  FreeAndNil(LGPNewBitmap);
end;

end.




04_.NET 互換 GDI+ ライブラリを使用した解像度の設定


同じく SetResolution メソッドで解像度を変更するサンプルですが,Delphi 2009 GDI+ Library を使用したサンプルです.
このライブラリの TGraphics に FromImage というメソッドがあります.別の TGPBitmap の生成にこのメソッドを使用しています.
設計時の画面も,実行結果も全て,上のサンプルと同じです.


リスト4
.NET 互換 GDI+ ライブラリを使用した解像度の設定
解像度の設定自体は SetResolution メソッドを使用する
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath : string;
    FInitialDir    : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像の解像度の取得と設定';

  FImageFilePath := '';
  FInitialDir    := '';
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGDImage     : IGPImage;
  LXResolution : Single;
  LYResolution : Single;
begin
  if FInitialDir = '' then FInitialDir := ExpandFileName('../');

  OpenDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.jpeg;*.bmp;*.gif';
  OpenDialog1.InitialDir := FInitialDir;

  if OpenDialog1.Execute then begin
    FInitialDir    := ExtractFileDir(OpenDialog1.FileName);
    FImageFilePath := OpenDialog1.FileName;

    //画像ファイルからTGPImageのインスタンスを生成
    LGDImage := TGPBitmap.Create(FImageFilePath);

    //解像度を取得
    LXResolution := LGDImage.GetHorizontalResolution;
    LYResolution := LGDImage.GetVerticalResolution;

    //取得した解像度を表示
    LabeledEdit1.Text := IntToStr(Trunc(LXResolution));
    LabeledEdit2.Text := IntToStr(Trunc(LYResolution));

    //画像を描画
    //解像度の取得と変更だけであれば,画像を表示する必要はない
    Invalidate;
  end;
end;

//=============================================================================
//  [保存]ボタン
//  解像度を変更して保存する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LImageWidth  : Cardinal;
  LImageHeight : Cardinal;
  LGPGraphic   : IGPGraphics;
  LGPBitmap    : IGPBitmap;
  LPixelFormat : Integer;
  LGPNewBitmap : IGPBitmap;
begin
  if FImageFilePath = '' then exit;

  //画像ファイルを読み込んでIGPBitmapkのインスタンスを生成
  //画像の幅と高さを取得しておく
  LGPBitmap    := TGPBitmap.Create(FImageFilePath);
  LImageWidth  := LGPBitmap.Width;
  LImageHeight := LGPBitmap.Height;

  //別のIGPBitmapのインスタンスを生成
  //ピクセルフォーマットの指定(これがないと保存に失敗するようだ)
  LPixelFormat := LGPBitmap.PixelFormat;
  LGPNewBitmap := TGPBitmap.Create(LImageWidth, LImageHeight, LPixelFormat);
  //解像度を変更
  LGPNewBitmap.SetResolution(300.0, 300.0);

  //新しく生成したTGPBitmapを描画先にしてTGPGraphicsを生成
  //そこに元のTGPBitmapの内容を描画する
  LGPGraphic := TGPGraphics.FromImage(LGPNewBitmap);
  LGPGraphic.DrawImage(LGPBitmap, 0, 0, LImageWidth, LImageHeight);

  //対象の画像のインスタンスが有効のままだと上書き保存できない
  LGPBitmap  := nil;
  LGPGraphic := nil;

  //JPEG画像として保存
  LGPNewBitmap.Save('XXX.jpg', TGPImageFormat.Jpeg);
end;

//=============================================================================
//  Form1のOnPaintイベント
//  画像を描画しなくてもいいのであれば,このイベントのコードは不要
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LImageWidth  : Cardinal;
  LImageHeight : Cardinal;
  LGPGraphic   : IGPGraphics;
  LGPBitmap    : IGPBitmap;
begin
  if FImageFilePath = '' then exit;

  //画像ファイルを読み込んでIGPBitmapkのインスタンスを生成
  //画像の幅と高さを取得しておく
  LGPBitmap   := TGPBitmap.Create(FImageFilePath);
  LImageWidth  := LGPBitmap.Width;
  LImageHeight := LGPBitmap.Height;

  //確認のためにこのForm1のCanvasに描画
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPGraphic.DrawImage(LGPBitmap, 8, 85, LImageWidth, LImageHeight);

  //.NET互換GDI+ライブラリは解放処理不要
end;

end.




05_画像のプロパティタグを使用した解像度の設定


[G160_画像ファイルのプロパティとメタデータ] で使用した画像ファイルのメタデータの中の解像度の取得と設定のサンプルです.
この方法は,画像ファイルに該当するメタデータ,つまりプロパティタグがないと取得はできません.設定は可能です.設定すると,該当するプロパティタグが画像ファイルに追加され,そこに設定した値を記録します.ただし,GIF 画像のように解像度の概念がない画像ファイルに対して設定しても,該当するプロパティタグは作成できません.

設計時の画面も,実行結果も全て,上のサンプルと同じです.


リスト5
画像のプロパティタグを使用した解像度の設定
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath : string;
    FInitialDir    : string;
    FMemStream     : TMemoryStream;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像の解像度の取得と設定';

  FInitialDir    := '';

  Image1.Left := 8;
  Image1.Top  := 85;

  FMemStream := TMemoryStream.Create;
end;

//=============================================================================
//  終了時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FMemStream);
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphic     : TGPGraphics;
  LGPBitmap      : TGPBitmap;
  LImageWidth    : Cardinal;
  LImageHeight   : Cardinal;
  LpPropItem     : PPropertyItem;
  LIdValue       : Cardinal;
  LBufferSize    : Cardinal;
  LRationalValue : array of Cardinal;
  LImgGUID       : TGUID;
begin
  if FInitialDir = '' then FInitialDir := ExpandFileName('../');

  OpenDialog1.Filter     := '画像ファイル|*.jpg';
  OpenDialog1.InitialDir := FInitialDir;

  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := '';
    LabeledEdit2.Text := '';
    Image1.Picture.Assign(nil);

    FInitialDir    := ExtractFileDir(OpenDialog1.FileName);
    FImageFilePath := OpenDialog1.FileName;

    //画像ファイルからTGPImageのインスタンスを生成
    LGPBitmap := TGPBitmap.Create(FImageFilePath);

    //画像の幅と高さを取得し,Image1のサイズをその大きさにする
    LImageWidth   := LGPBitmap.GetWidth;
    LImageHeight  := LGPBitmap.GetHeight;
    Image1.Width  := LImageWidth;
    Image1.Height := LImageHeight;

    //確認のためにこのImage1のCanvasに描画
    LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0, LImageWidth, LImageHeight);


    //横方向の解像度の取得.解像度はRational(有理数・分数)形式で格納されている
    LIdValue    := PropertyTagXResolution;
    LBufferSize := LGPBitmap.GetPropertyItemSize(LIdValue);
    if LBufferSize > 0 then begin
      GetMem(LpPropItem, LBufferSize);

      //分母と分子で配列要素は2つ必要
      SetLength(LRationalValue, 2);
      try
        LGPBitmap.GetPropertyItem(LIdValue, LBufferSize, LpPropItem);
        LRationalValue    := LpPropItem^.value;
        LabeledEdit1.Text := IntToStr(LRationalValue[0]);
      finally
        FreeMem(LpPropItem);
      end;
    end;

    //縦方向の解像度の取得.解像度はRational(有理数・分数)形式で格納されている
    LIdValue    := PropertyTagYResolution;
    LBufferSize := LGPBitmap.GetPropertyItemSize(LIdValue);
    if LBufferSize > 0 then begin
      GetMem(LpPropItem, LBufferSize);

      //分母と分子で配列要素は2つ必要
      SetLength(LRationalValue, 2);
      try
        LGPBitmap.GetPropertyItem(LIdValue, LBufferSize, LpPropItem);
        LRationalValue    := LpPropItem^.value;
        LabeledEdit2.Text := IntToStr(LRationalValue[0]);
      finally
        FreeMem(LpPropItem);
      end;
    end;

    //画像をメモリストリームに保存
    FMemStream.Clear;
    if GetEncoderClsid('image/jpeg', LImgGUID) >= 0 then begin
      LGPBitmap.Save(TStreamAdapter.Create(FMemStream), LImgGUID);
    end;

    LGPGraphic.Free;
    LGPBitmap.Free;
  end;
end;

//=============================================================================
//  [保存]ボタン
//  解像度を変更して保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap      : TGPBitmap;
  LPropItem      : TPropertyItem;
  LRationalValue : array of Cardinal;
  LImgGUID       : TGUID;
begin
  if FMemStream.Size <= 0 then exit;

  //メモリストリームからTGPBitmapのインスタンスを生成
  LGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream));


  //横方向の解像度を設定
  //分母と分子で配列要素は2つ必要
  SetLength(LRationalValue, 2);
  LPropItem.id     := PropertyTagXResolution;
  LPropItem.type_  := PropertyTagTypeRational;
  //動的配列のバイト数
  LPropItem.length := Length(LRationalValue) * SizeOf(LRationalValue);


  LRationalValue[0] := 300;
  LRationalValue[1] := 1;
  LPropItem.value   := @LRationalValue[0];
  LGPBitmap.SetPropertyItem(LPropItem);

  //縦方向の解像度を設定
  //分母と分子で配列要素は2つ必要
  SetLength(LRationalValue, 2);
  LPropItem.id     := PropertyTagYResolution;
  LPropItem.type_  := PropertyTagTypeRational;
  //動的配列のバイト数
  LPropItem.length := Length(LRationalValue) * SizeOf(LRationalValue);

  LRationalValue[0] := 300;
  LRationalValue[1] := 1;
  LPropItem.value   := @LRationalValue[0];
  LGPBitmap.SetPropertyItem(LPropItem);

  //JPEG画像として保存
  //ここでは別の名前で保存しているが,同じ名前にすれば上書き保存となる
  if GetEncoderClsid('image/jpeg', LImgGUID) >= 0 then begin
    LGPBitmap.Save('XXX.jpg', LImgGUID);
  end;

  LGPBitmap.Free;
end;

end.