unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  private
    procedure SetDrawWidth(const Value: Integer);
  protected
    FImageFilePath  : string;
    FFileStream     : TMemoryStream;
    FGPGraphic      : TGPGraphics;
    FOriginGPBitmap : TGPBitmap;
    FGPBitmap       : TGPBitmap;
    FDrawWidth      : Integer;
    FDrawHeight     : Integer;
    procedure Paint; override;
    procedure DrawImage(ACanvas: TCanvas);
  public
    procedure LoadImageFromFile(AFileName: string);
    procedure SaveImageToFile(AFileName: string);
    destructor Destroy; override;
    property DrawWidth  : Integer read FDrawWidth write SetDrawWidth;
    property DrawHeight : Integer read FDrawHeight;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  イメージのリサイズ';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;

  OpenPictureDialog1.InitialDir := ExpandFileName('..\');
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

//=============================================================================
//  画像の読み込みボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName : String;
begin
  if OpenPictureDialog1.Execute then begin
    LFileName := OpenPictureDialog1.FileName;
    OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

    MyPanel.LoadImageFromFile(LFileName);
    SpinEdit1.Value := MyPanel.DrawWidth;
    SpinEdit2.Value := MyPanel.DrawHeight;
  end;
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFileName : String;
begin
  LSaveFileName := ExpandFileName('..\Save.bmp');
  MyPanel.SaveImageToFile(LSaveFileName);
end;

//=============================================================================
//  SpinEdit1のChangeイベント処理
//  画像の横サイズを設定する
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  MyPanel.DrawWidth := SpinEdit1.Value;
  SpinEdit2.Value := MyPanel.DrawHeight;
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  TMyPanelクラス破棄時の処理
//-----------------------------------------------------------------------------
destructor TMyPanel.Destroy;
begin
  if Assigned(FFileStream) then FreeAndNil(FFileStream);
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FOriginGPBitmap) then FreeAndNil(FOriginGPBitmap);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのLoadImageFromFileメソッド
//
//  画像表示中に画像ファイルがなくても操作可能なようにメモリストリームに読み込む
//  そのメモリストリームからTGPBitmapを生成する
//
//  EMF,WMFはこのコードでは正常に読み込めない
//-----------------------------------------------------------------------------
procedure TMyPanel.LoadImageFromFile(AFileName: string);
begin
  if Assigned(FOriginGPBitmap) then FreeAndNil(FOriginGPBitmap);
  if Assigned(FFileStream) then FreeAndNil(FFileStream);

  FFileStream := TMemoryStream.Create;

  FFileStream.LoadFromFile(AFileName);
  //メモリストリームから読み出してTGPBitmapを生成
  //TGPBitmapを使用
  //TGPImageだと正常に読み込めないメタファイルがある
  FOriginGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FFileStream, soReference));

  FDrawWidth  := FOriginGPBitmap.GetWidth;
  FDrawHeight := FOriginGPBitmap.GetHeight;

  Invalidate;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのSaveImageToFileメソッド
//  保存のためのTBitmapを生成して保存
//-----------------------------------------------------------------------------
procedure TMyPanel.SaveImageToFile(AFileName: string);
var
  LImgGUID : TGUID;
begin
  if not Assigned(FGPBitmap) then exit;

  //指定MIMEタイプのGUIDを求め，ビットマップ画像として保存
  if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
    FGPBitmap.Save(AFileName, LImgGUID);
  end;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのDrawWidthプロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.SetDrawWidth(const Value: Integer);
begin
  FDrawWidth := Value;
  if FDrawWidth < 10 then exit;

  Invalidate;
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
begin
  inherited;
  DrawImage(Canvas);
end;

//-----------------------------------------------------------------------------
//  描画ルーチン
//
//  ACanvas : 描画先のTCanvasオブジェクト
//-----------------------------------------------------------------------------
procedure TMyPanel.DrawImage(ACanvas: TCanvas);
var
  LRatio : Double;
  LGPPen : TGPPen;
begin
  if (FDrawWidth + FDrawHeight) = 0 then exit;
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //---------------------------------------------------------------------------
  //  TGPBitmapに対する操作
  //  Paintメソッド内部で実行する必然性はない．描画内容は見えないので
  //---------------------------------------------------------------------------

  //縦横比を計算
  LRatio := FOriginGPBitmap.GetHeight / FOriginGPBitmap.GetWidth;
  //描画のサイズを計算
  FDrawHeight := Trunc(LRatio * FDrawWidth);

  //TGPBitmapオブジェクトを生成
  FGPBitmap := TGPBitmap.Create(FDrawWidth, FDrawHeight, PixelFormat32bppARGB);

  //生成したTGPBitmapを描画先にしてTGPGraphicsを生成し
  //元のTGPBitmapの内容を描画
  FGPGraphic := TGPGraphics.Create(FGPBitmap);
  FGPGraphic.DrawImage(FOriginGPBitmap, MakeRect(0, 0, FDrawWidth, FDrawHeight));

  //ペンのオブジェクトを生成
  LGPPen := TGPPen.Create(aclBlue, 5.0);

  //四角形を描画
  //線の描画関係の関数名はDrawXXXX
  FGPGraphic.DrawRectangle(LGPPen, MakeRect(20, 20, 70, 45));

  FGPGraphic.Free;
  //---------------------------------------------------------------------------


  //TGPGraphicsのオブジェクトを生成
  //描画先は引数のTCanvas
  FGPGraphic := TGPGraphics.Create(ACanvas.Handle);

  //TGPBitmapの内容をこのTMyPanelのCanvasに描画
  FGPGraphic.DrawImage(FGPBitmap, 0, 0);　

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

end.

//-----------------------------------------------------------------------------
//  TMyPanelのSaveImageToFileメソッド
//  保存のためのTBitmapを生成して保存
//-----------------------------------------------------------------------------
procedure TMyPanel.SaveImageToFile(AFileName: string);
var
  LImgGUID : TGUID;
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //TGPBitmapオブジェクトを生成
  FGPBitmap := TGPBitmap.Create(FDrawWidth, FDrawHeight, PixelFormat32bppARGB);

  //生成したTGPBitmapを描画先にしてTGPGraphicsを生成し
  //元のTGPBitmapの内容を描画
  FGPGraphic := TGPGraphics.Create(FGPBitmap);
  FGPGraphic.DrawImage(FOriginGPBitmap, MakeRect(0, 0, FDrawWidth, FDrawHeight));

  //指定MIMEタイプのGUIDを求め，ビットマップ画像として保存
  if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
    FGPBitmap.Save(AFileName, LImgGUID);
  end;

  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

//-----------------------------------------------------------------------------
//  TMyPanelのDrawWidthプロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.SetDrawWidth(const Value: Integer);
begin
  FDrawWidth := Value;
  if FDrawWidth < 10 then exit;

  Invalidate;
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
begin
  inherited;
  DrawImage(Canvas);
end;

//-----------------------------------------------------------------------------
//  描画ルーチン
//
//  ACanvas : 描画先のTCanvasオブジェクト
//-----------------------------------------------------------------------------
procedure TMyPanel.DrawImage(ACanvas: TCanvas);
var
  LRatio : Double;
begin
  if (FDrawWidth + FDrawHeight) = 0 then exit;
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //縦横比を計算
  LRatio := FOriginGPBitmap.GetHeight / FOriginGPBitmap.GetWidth;
  //描画のサイズを計算
  FDrawHeight := Trunc(LRatio * FDrawWidth);

  //TGPGraphicsのオブジェクトを生成
  //描画先は引数のTCanvas
  FGPGraphic := TGPGraphics.Create(ACanvas.Handle);

  //TGPBitmapの内容をこのTMyPanelのCanvasに描画
  FGPGraphic.DrawImage(FOriginGPBitmap, 0, 0, FDrawWidth, FDrawHeight);　

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;