unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    RadioGroup1: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像拡大時の補間モード';

  //TInterpolationModeの値は上から-1, 0, 1, 2, ...となっている
  with RadioGroup1.Items do begin
    Add('InterpolationModeInvalid');
    Add('InterpolationModeDefault');
    Add('InterpolationModeLowQuality');
    Add('InterpolationModeHighQuality');
    Add('InterpolationModeBilinear');
    Add('InterpolationModeBicubic');
    Add('InterpolationModeNearestNeighbor');
    Add('InterpolationModeHighQualityBilinear');
    Add('InterpolationModeHighQualityBicubic');
  end;
  RadioGroup1.ItemIndex := 0;
end;

//=============================================================================
//  RadioGroup1のOnClickイベント
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  画像を拡大・縮小する時の補間アルゴリズムの比較テスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath   : string;
  LBitmap     : TBitmap;
  LSrcRect    : TRect;
  LGDIGraphic : TGPGraphics;
  LGDIBitmap  : TGPBitmap;
  LPolaMode   : TInterpolationMode;
begin
  //表示する画像のファイル名
  LFilePath := '501.bmp';

  //まずVCLのTCanvasのCopyRectによる描画の場合
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(LFilePath);
    //元の画像のこの部分を拡大表示する
    LSrcRect := Rect(20, 30, 20 + 35, 30 + 30);

    //画像の一部をImage1に描画
    Image1.Canvas.CopyRect(Rect(0, 0, Image1.Width, Image1.Height),
                           LBitmap.Canvas,
                           LSrcRect);
  finally
    FreeAndNil(LBitmap);
  end;


  //以下GDI+ の補間モードを指定しての描画
  //RadioGruupのItemに応じて補間モードを選択
  LPolaMode := -1;
  case RadioGroup1.ItemIndex of
    0: LPolaMode := InterpolationModeInvalid;
    1: LPolaMode := InterpolationModeDefault;
    2: LPolaMode := InterpolationModeLowQuality;
    3: LPolaMode := InterpolationModeHighQuality;
    4: LPolaMode := InterpolationModeBilinear;
    5: LPolaMode := InterpolationModeBicubic;
    6: LPolaMode := InterpolationModeNearestNeighbor;
    7: LPolaMode := InterpolationModeHighQualityBilinear;
    8: LPolaMode := InterpolationModeHighQualityBicubic;
   end;

  //Image2の画像を消去
  Image2.Picture.Assign(nil);
  LGDIGraphic := TGPGraphics.Create(Image2.Canvas.Handle);

  LGDIBitmap := TGPBitmap.Create(LFilePath);

  //補間モード設定
  LGDIGraphic.SetInterpolationMode(LPolaMode);
  //GDIBitmapをImage2に描画
  //TCanvasのStretchDrawまたはCopyRectに相当する
  LGDIGraphic.DrawImage(
                LGDIBitmap,
                MakeRect(0, 0, Image2.Width, Image2.Height),
                LSrcRect.Left,
                LSrcRect.Top,
                LSrcRect.Right  - LSrcRect.Left,
                LSrcRect.Bottom - LSrcRect.Top,
                UnitPixel);

  LGDIBitmap.Free;
  LGDIGraphic.Free;
end;

end.

//=============================================================================
//  TCheckBoxのOnClickイベント処理
//  画像描画時の終端ピクセルの描画モードとピクセルのオフセットモードを設定
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if not Assigned(FGPBitmap) then exit;
  if FGPBitmap.GetWidth <= 0 then exit;

  Image1.Picture.Assign(nil);
  GDIDrawImageToTImage;
end;

//-----------------------------------------------------------------------------
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TForm1.GDIDrawImageToTImage;
var
  LGPGraphic : TGPGraphics;
  LBackImage : string;
  LGPImage   : TGPImage;
  LGPTBrush  : TGPTextureBrush;
begin
  if not Assigned(FGPBitmap) then exit;

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTImageのCanvas
  LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);

  //背景のテクスチャを作成して描画
  LBackImage := ExpandFileName('backTexture.gif');
  if FileExists(LBackImage) then begin
    LGPImage  := TGPImage.Create(LBackImage);
    LGPTBrush := TGPTextureBrush.Create(LGPImage);
    try
      LGPGraphic.FillRectangle(LGPTBrush,
                               MakeRect(0, 0, Image1.Width,Image1.Height));
    finally
      FreeAndNil(LGPImage);
      FreeAndNil(LGPTBrush);
    end;
  end;

  //終端ピクセルの描画モードとピクセルのオフセットモードを設定
  if CheckBox1.Checked then begin
    //TGPImageAttributesによる設定が他にもあるかも知れない
    //それらを有効するには生成していない場合に限って生成する方が良い
    if not Assigned(FGPImageAttr) then begin
      FGPImageAttr := TGPImageAttributes.Create;
    end;
    FGPImageAttr.SetWrapMode(WrapModeTileFlipXY);
  end else begin
    if Assigned(FGPImageAttr) then FreeAndNil(FGPImageAttr);
  end;

  if CheckBox2.Checked then begin
    LGPGraphic.SetPixelOffsetMode(PixelOffsetModeHalf);
  end;

  //TGPBitmapをこのTImageのCanvasに描画
  LGPGraphic.DrawImage(
              FGPBitmap,
              MakeRect(0, 0, Image1.Width, Image1.Height),
              0,
              0,
              FGPBitmap.GetWidth,
              FGPBitmap.GetHeight,
              UnitPixel,
              fGPImageAttr);

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

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure ResizeBmpByGR32(SrcBmp: TBitmap; DstBmp: TBitmap;
      DstWidht, DstHeight: Integer; ResizeFlag: Boolean = True); overload;
    procedure ResizeBmpByGR32(SrcBmp: TBitmap; DstBmp: TBitmap; SrcX, SrcY, SrcCX,
      SrcCY: Integer; DstCX, DstCY: Integer; ResizeFlag: Boolean = True); overload;
    procedure DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
  end;

var
  Form1: TForm1;

implementation

uses
  GR32,
  GR32_Resamplers;

{$R *.dfm}

//=============================================================================
//  TBitmap の画像をリサイズ
//  TBitmap 以外の画像も TBitmap に変換すれば同様ににリサイズ可能
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
  LDstBmp : TBitmap;
begin
  LSrcBmp := TBitmap.Create;
  LDstBmp := TBitmap.Create;
  try
    LSrcBmp.AlphaFormat := afDefined;
    LSrcBmp.LoadFromFile('virus detected.bmp');

    // リサイズ前の TBitmap を TImage に描画
    DrawBackGroundImage(Image1.Canvas, 'backTexture_02.bmp');
    Image1.Canvas.Draw(0, 0, LSrcBmp);

    // 256 x 256 にリサイズ
    ResizeBmpByGR32(LSrcBmp, LDstBmp,256, 256);

    // リサイズ後の TBitmap を TImage に描画
    DrawBackGroundImage(Image2.Canvas, 'backTexture_02.bmp');
    Image2.Canvas.Draw(0, 0, LDstBmp);
  finally
    FreeAndNil(LSrcBmp);
    FreeAndNil(LDstBmp);
  end;
end;

//-----------------------------------------------------------------------------
//  Graphics32 を使用した TBitmap 画像のリサイズ
//-----------------------------------------------------------------------------
procedure TForm1.ResizeBmpByGR32(SrcBmp, DstBmp: TBitmap; DstWidht,
  DstHeight: Integer; ResizeFlag: Boolean);
begin
  ResizeBmpByGR32(SrcBmp, DstBmp, 0, 0,
                  SrcBmp.Width, SrcBmp.Height, DstWidht, DstHeight, ResizeFlag);
end;

//-----------------------------------------------------------------------------
//  Graphics32 を使用した TBitmap 画像のリサイズ
//  元の TBitmap の部分的な矩形領域の拡大 / 縮小も可能
//  補間モードは TLinearResampler ( 多分、双一次補間 - バイリニア補間 ) に固定
//
//  uses に GR32, GR32_Resamplers が必要
//-----------------------------------------------------------------------------
procedure TForm1.ResizeBmpByGR32(SrcBmp, DstBmp: TBitmap; SrcX, SrcY, SrcCX,
  SrcCY, DstCX, DstCY: Integer; ResizeFlag: Boolean);
var
  LPixelFmt : TPixelFormat;
  LAlphaFmt : TAlphaFormat;
  LSrcBmp32 : TBitmap32;
  LDstBmp32 : TBitmap32;
  LSrcRect  : TRect;
  LDstRect  : TRect;
begin
  LPixelFmt := SrcBmp.PixelFormat;
  LAlphaFmt := SrcBmp.AlphaFormat;

  // 操作対象の画像の矩形領域
  LSrcRect := Rect(SrcX, SrcY, SrcCX, SrcCY);
  LDstRect := Rect(0,0, DstCX, DstCY);

  LSrcBmp32 := TBitmap32.Create;
  LDstBmp32 := TBitmap32.Create;
  try
    if ResizeFlag then begin
      LSrcBmp32.Resampler := TLinearResampler.Create;
    end;
    // 元の TBitmap を TBitmap32 に変換
    SrcBmp.AlphaFormat := LAlphaFmt;
    LSrcBmp32.Assign(SrcBmp);

    // TBitmap32 を変換後のサイズにして、その Canvas に元のビットマップを描画     L
    LDstBmp32.SetSize(LDstRect.Width, LDstRect.Height);
    LDstBmp32.Draw(LDstRect, LSrcRect, LSrcBmp32);

    // リサイズ後に画像を描画した TBitmap32 を TBitmap に変換
    DstBmp.Assign(LDstBmp32);
    DstBmp.AlphaFormat := LAlphaFmt;

    // ビット深さを元に戻す
    DstBmp.PixelFormat := LPixelFmt;
  finally
    FreeAndNil(LSrcBmp32);
    FreeAndNil(LDstBmp32);
  end;
end;
//----------------------------------------------------------------------------
//  TImage の背景として市松模様のブラシを描画
//  TBitmap の透過状態の確認用
//  この模様が見える部分は透明または半透明の部分ということになる
//----------------------------------------------------------------------------
procedure TForm1.DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
var
  LBmpBack : TBitmap;
begin
  LBmpBack := TBitmap.Create;
  try
    LBmpBack.LoadFromFile(AFilePath);
    ACanvas.Brush.Style  := bsSolid;
    ACanvas.Brush.Bitmap := LBmpBack;
    ACanvas.FillRect(ACanvas.ClipRect);
  finally
    FreeAndNil(LBmpBack);
  end;
end;


end.

    // 別の補間モードにするには TLanczosKernel の部分を変更する
    // LResamplerType : TKernelResampler;

    if ResizeFlag then begin
      LResamplerType        := TKernelResampler.Create(LSrcBmp32);
      LResamplerType.Kernel := TLanczosKernel.Create;
      LResamplerType.Changed;
      LSrcBmp32.Resampler := LResamplerType;
    end;

procedure TForm1.Button1Click(Sender: TObject);
const
  FBackColor : TColor = clWhite;
var
  LBitmap : TBitmap;
  LCanvas : TCanvas;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(32, 32);
    LBitmap.PixelFormat := pf24bit;

    LCanvas := LBitmap.Canvas;

    LCanvas.Brush.Color := FBackColor;
    LCanvas.FillRect(LCanvas.ClipRect);

    LCanvas.Pen.Width := 5;
    LCanvas.Pen.Color := clBlack;

    LCanvas.MoveTo(0, 0);
    LCanvas.LineTo(LBitmap.Width, LBitmap.Height);
    LBitmap.SaveToFile('line.bmp');
  finally
    FreeAndNil(LBitmap);
  end;
end;

Windows, Messages  ---> Winapi.Windows, Winapi.Messages
Windows.TPoint     ---> Winapi.Windows.TPoint;

   等々

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, GR32, GR32_Image, GR32_Backends;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image321: TImage32;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Graphics32 の TImage32 に TBitmap32 を描画する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap32 : TBitmap32;
  LBitmap : TBitmap;
begin
  LBitmap32 := TBitmap32.Create;
  try
    // TImage32.Bitmmap ( TImage の内部ピッマップ相当) のサイズを設定
    Image321.Bitmap.SetSize(Image321.Width, Image321.Height);
    // 背景を指定色で塗り潰す
    // Ex. 緑は clGreen32
    Image321.Bitmap.Clear($FFFFFFFF);


    // TImage32 の背景を市松模様のタイルにする
    LBitmap := TBitmap.Create;
    try
      LBitmap.LoadFromFile('backTexture_02.bmp');

      Image321.Bitmap.Canvas.Brush.Style  := bsSolid;
      Image321.Bitmap.Canvas.Brush.Bitmap := LBitmap;
      Image321.Bitmap.Canvas.FillRect(Image321.Bitmap.Canvas.ClipRect);
    finally
      FreeAndNil(LBitmap);
    end;


    // ビットマップ画像を読み込んで TImage32 ( の TBitmap ) に描画
    LBitmap32.LoadFromFile('virus detected.bmp');

    // dmTransparent にすると半透明は無効 ( RGB 値だけで描画される )
    LBitmap32.DrawMode := dmBlend;
    LBitmap32.DrawTo(Image321.Bitmap);
  finally
    FreeAndNil(LBitmap32);
  end;
end;

end.