unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Image1: TImage;
    FontDialog1: TFontDialog;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { Private 宣言 }
     EditInput : TplTransMemo;
     EditFont  : TFont;
     PtInput   : TPoint;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//
//  (1) テスト用の画像をImage1に表示
//      Image1のCavnasに描画する(Assiginだと追加描画不可)
//  (2) テストでFontを変更したいので，EditFontというオブジェクトを生成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  APict: TPicture;
begin
  //入力用コントロールをImage1内とするためParent用のPanelをFormに配置
  //その上にImage1を配置
  Image1.Align := alClient;

  //そのImage1にテスト用の画像を表示
  APict := TPicture.Create;
  try
    APict.LoadFromFile('nmlogo.bmp');
    Image1.Canvas.StretchDraw(Image1.BoundsRect, APict.Graphic);
  finally
    FreeAndNil(APict);
  end;

  //EditFontの初期値
  EditFont      := TFont.Create;
  EditFont.Size := 20;
end;

//=============================================================================
//  オブジェクトは使い終わったら破棄
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(EditInput);
  FreeAndNil(EditFont);
end;

//=============================================================================
//  文字に使用するFontを指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FontDialog1.Font.Assign(EditFont);
  if FontDialog1.Execute then begin
    if EditFont = nil then EditFont := TFont.Create;
    EditFont.Assign(FontDialog1.Font);
  end;
end;

//=============================================================================
//  Form1とImage1のOnClick共有イベント処理
//
//  実用的にするには，入力した文字列の描画位置や折り返し描画等の工夫が必要
//  文字列入力の際も，入力文字の長さや高さに応じて，入力コントロール(TMemo)の
//  サイズ変更等の工夫が必要と思われる
//=============================================================================
procedure TForm1.FormClick(Sender: TObject);
begin
  //Image1をクリックしたら新規の文字列入力
  if (Sender is TImage) or (Sender is TForm) then begin
    //生成済みのコントロールがあれば破棄
    if EditInput <> nil then begin
      if EditInput.Text <> '' then begin
        Image1.Canvas.Brush.Style := bsClear;
        Image1.Canvas.Font.Assign(EditInput.Font);
        Image1.Canvas.TextOut(PtInput.x, PtInput.y, EditInput.Text);
      end;
      FreeAndNil(EditInput);
    end;

    if (Sender is TImage) then begin
      //透明なメモ作成．1行入力専用
      //右端で折返すが折返し部分はImageに描画しない
      EditInput := TplTransMemo.Create(Self);

      EditInput.WantReturns := False;
      EditInput.BorderStyle := bsNone;
      EditInput.Parent      := Panel1;

      //それは現在のマウス位置から
      GetCursorPos(PtInput);

      PtInput          := Image1.ScreenToClient(PtInput);
      EditInput.Left   := PtInput.x;
      EditInput.Top    := PtInput.y;
      EditInput.Font   := EditFont;
      EditInput.Width  := 100;
      EditInput.Height := 100;

      EditInput.Show;
      EditInput.SetFocus;
    end;
  end;
end;

end.

unit plTransMemo;

interface

uses
 Messages, Controls, StdCtrls, classes;

const TMWM_SpecialInvalidate = WM_USER+1111;

type
  TplTransMemo = class(TMemo)
  private
    procedure SpecialInvalidate(var Message:TMessage); message TMWM_SpecialInvalidate;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
    procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  public
    constructor Create(AOwner: TComponent); override;
  end;

procedure Register;

implementation

uses Windows, Graphics;

{ TplTransMemo }

//-----------------------------------------------------------------------------
//  生成時の処理
//  コンポーネントスタイルの設定
//-----------------------------------------------------------------------------
constructor TplTransMemo.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse,
                   csDesignInteractive,
                   csClickEvents,
                   csSetCaption,
                   csOpaque,
                   csDoubleClicks,
                   csReplicatable,
                   csNoStdEvents];
end;

//-----------------------------------------------------------------------------
//  CreateParamメソッド処理
//  コンポーネントデザインの設定
//-----------------------------------------------------------------------------
procedure TplTransMemo.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle
                    or      WS_EX_TRANSPARENT
                    and not WS_EX_WINDOWEDGE
                    and not WS_EX_STATICEDGE
                    and not WS_EX_DLGMODALFRAME
                    and not WS_EX_CLIENTEDGE;
end;

//-----------------------------------------------------------------------------
//  CN_CTLCOLOREDITメッセージ処理
//  このメッセージは描画直前のエディットコントロール(TEdit,TMemo等)に送られる
//  このメッセージの処理で背景色やテキストの色を変更できる
//  NULL_BRUSHは空のBrush(透明)
//-----------------------------------------------------------------------------
procedure TplTransMemo.CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);
begin
  //文字列の描画背景色
  SetBkMode(Message.ChildDC, TRANSPARENT);
  //NULL_BRUSHのオブジェクトを取得して戻り値とする
  Message.Result := GetStockObject(NULL_BRUSH);
end;

//-----------------------------------------------------------------------------
//  WM_KEYDOWNメッセージ処理
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMKeyDown(var Message: TWMKeyDown);
begin
  SendMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
  inherited;
  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
end;

//-----------------------------------------------------------------------------
//  WM_SETTEXTメッセージ処理
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMSetText(var Message: TWMSetText);
begin
  inherited;
  if not (csDesigning in ComponentState) then begin
    PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
  end;
end;

//-----------------------------------------------------------------------------
//  WM_HSCROLLメッセージ処理
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
end;

//-----------------------------------------------------------------------------
//  WM_VSCROLLメッセージ処理
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMVScroll(var Message: TWMVScroll);
begin
  SendMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
  inherited;
  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
end;

//-----------------------------------------------------------------------------
//  WM_MOUSEWHEELメッセージ処理
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMMouseWheel(var Message: TWMMouseWheel);
begin
  SendMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
  inherited;
  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);
end;

//-----------------------------------------------------------------------------
//  再描画用のコード
//  コントロールのInvalidate代替え処理コード
//  WM_PAINTで処理すると，キャレット等全ての描画も行われるためにチラツク
//-----------------------------------------------------------------------------
procedure TplTransMemo.SpecialInvalidate(var Message: TMessage);
var
  LRect : TRect;
begin
  if (Parent <> nil) then begin
    Perform(EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLParam(0, 0));

    LRect             := ClientRect;
    LRect.TopLeft     := Parent.ScreenToClient(ClientToScreen(LRect.TopLeft));
    LRect.BottomRight := Parent.ScreenToClient(ClientToScreen(LRect.BottomRight));

    InvalidateRect(Parent.Handle, @LRect, true);
    RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
  end;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  バックグラウンドの描画はしない
//-----------------------------------------------------------------------------
procedure TplTransMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

//-----------------------------------------------------------------------------
//  コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('Samples', [TplTransMemo]);
end;

end.

procedure TForm1.Button2Click(Sender: TObject);
var
  bmpHeight : Integer;
begin
  bmpHeight := Image1.Picture.Bitmap.Height;
  MessageBox(Handle, PChar(IntToStr(bmpHeight)), 'サイズ ( 高さ )', MB_OK);
end;

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, System.UIConsts, FMX.Layouts, FMX.Memo;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { private 宣言 }
    srcBitmap : TBitmap;
    EditInput : TMemo;
    procedure ResizeBitmapOfTImage;
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  srcRect : TRectF;
  dstRect : TRectF;
begin
  EditInput := nil;
  srcBitmap := nil;

  //ストレッチ描画
  Image1.WrapMode := TImageWrapMode.iwStretch;
  //描画用のビットマップを生成
  Image1.Bitmap := TBitmap.Create(Trunc(Image1.Width), Trunc(Image1.Height));

  //ビットマップ画像を読み出してTImageに描画
  srcBitmap := TBitmap.CreateFromFile('nmlogo.bmp');

  srcRect := RectF(0, 0, srcBitmap.Width, srcBitmap.Height);
  dstRect := RectF(0, 0, Image1.Width, Image1.Height);

  //ビットマップをTImageに描画
  //WrapModeをiwStretchにしているのでStretchDrawとなる
  Image1.Bitmap.Canvas.BeginScene();
  Image1.Bitmap.Canvas.DrawBitmap(srcBitmap, srcRect, dstRect, 1.0, False);
  Image1.Bitmap.Canvas.EndScene;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(srcBitmap);
end;

//=============================================================================
//  Image1とPanelのOnMouseDownイベント処理
//  claBlack等の定数名の使用にはSystem.UIConstsが必要
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  Background : TFmxObject;
  textRect   : TRectF;
begin
  //TPanel上(このサンプルではTImage以外)
  if (Sender is TPanel) or (Sender is TImage) then begin
    if (EditInput <> nil) then begin
      if (EditInput.Text <> '') then begin
        Image1.Bitmap.Canvas.BeginScene();

        //TImage.Bitmap.Canvasのフォントを設定して描画領域を設定
        Image1.Bitmap.Canvas.Font.Size  := EditInput.Font.Size;
        Image1.Bitmap.Canvas.Fill.Color := EditInput.FontColor;

        textRect.Left   := EditInput.Position.X;
        textRect.Top    := EditInput.Position.Y;
        textRect.Width  := Image1.Bitmap.Canvas.TextWidth(EditInput.Text);
        textRect.Height := Image1.Bitmap.Canvas.TextHeight(EditInput.Text);

        //TImage.Bitmap.Canvasに，TMemoに入力した文字列を描画
        Image1.Bitmap.Canvas.FillText(textRect,
                                      EditInput.Text,
                                      False,
                                      1.0,
                                      [TFillTextFlag.ftRightToLeft],
                                      TTextAlign.taTrailing,
                                      TTextAlign.taLeading);
        Image1.Bitmap.Canvas.EndScene;
        FreeAndNil(EditInput);
      end;
      FreeAndNil(EditInput);
    end;

    //TImage上だったらTMemoを生成して文字列の入力モードにする
    if (Sender is TImage) then begin
      //TImageのサイズと表示するビットマップのサイズを同じにする
      ResizeBitmapOfTImage;

      EditInput        := TMemo.Create(Self);
      EditInput.Parent := Image1;

      //フォントのサイズと色を実行時に設定可能にする
      EditInput.StyledSettings := EditInput.StyledSettings -
                                    [TStyledSetting.ssSize] -
                                    [TStyledSetting.ssFontColor];

      EditInput.Position.X := X;
      EditInput.Position.Y := Y;
      EditInput.Font.Size  := 25.0;
      EditInput.FontColor  := claBlack;
      EditInput.Width      := 200;
      EditInput.Height     := 100;

      EditInput.SetFocus;

      //バックグラウンドのオブジェクトを取得して透明度を指定
      Background := EditInput.FindStyleResource('background');
      if Assigned(Background) then begin
        TControl(Background).Opacity := 0.5;
        TControl(Background).Padding.Rect := RectF(0, 0, 0, 0);
      end;
    end;
  end;
end;

//=============================================================================
//  TImageのビットマップのサイズをTImageと同じサイズにするための処理
//=============================================================================
procedure TForm1.ResizeBitmapOfTImage;
var
  tempBitmap : TBitmap;
  srcRect    : TRectF;
  dstRect    : TRectF;
begin
  tempBitmap := TBitmap.Create;
  try
    //現在表示しているビットマップのサイズを取得
    tempBitmap.Width  := Image1.Bitmap.Width;
    tempBitmap.Height := Image1.Bitmap.Height;

    //tempBitmapに現在表示しているビットマップを取り出す
    srcRect := RectF(0, 0, tempBitmap.Width, tempBitmap.Height);
    tempBitmap.CopyFromBitmap(Image1.Bitmap, srcRect.Round, 0, 0);

    //新しいビットマップはImage1と同じサイズにする
    Image1.Bitmap.Width  := Trunc(Image1.Width);
    Image1.Bitmap.Height := Trunc(Image1.Height);

    Image1.Bitmap.Canvas.BeginScene();
    Image1.Bitmap.Canvas.Clear(0);

    //描画先のサイズとビットマップのサイズを同じにしてTImageに描画
    dstRect := RectF(0, 0, Image1.Width, Image1.Height);
    Image1.Bitmap.Canvas.DrawBitmap(tempBitmap, srcRect, dstRect, 1.0);
    Image1.Bitmap.Canvas.EndScene();
  finally
    FreeAndNil(tempBitmap);
  end;
end;

end.

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, System.UIConsts, FMX.Layouts, FMX.Edit;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    Panel1: TPanel;
    StyleBook1: TStyleBook;
    Panel2: TPanel;
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

//=============================================================================
//  フォームの表示開始時の処理
//  claSilver等の定数名にはusesにSystem.UIConstsが必要
//  System.UIConstsを使用しなくともTAlphaColorRec.Silverでも設定可能
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.TextAlign     := TTextAlign.taCenter;
  Edit1.VertTextAlign := TTextAlign.taCenter;
  Edit1.Text          := 'テスト文字列';
  //フォントのサイズと色を実行時に設定可能にする
  Edit1.StyledSettings := Edit1.StyledSettings - [TStyledSetting.ssSize]
                                               - [TStyledSetting.ssFontColor];
  Edit1.Font.Size      := 20;
  Edit1.FontColor      := claGreen;

  TrackBar1.Value := 100;
end;

//=============================================================================
//  TrackBar1のOnChangeイベント処理
//  透明度の設定
//=============================================================================
procedure TForm1.TrackBar1Change(Sender: TObject);
var
  Background : TFmxObject;
begin
  //Panel2の透明度の設定
  Panel2.Opacity := TrackBar1.Value / 100;

  //Edit1コントロールの透明度の設定
  //バックグラウンドのオブジェクトを取得して設定
  Background := Edit1.FindStyleResource('background');
  if Assigned(Background) then begin
    TControl(Background).Opacity := TrackBar1.Value / 100;
  end;
end;

end.

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, System.UIConsts;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses System.IOUtils;

{$R *.fmx}

//-----------------------------------------------------------------------------
//  指定座標の色と同じ色のピクセルを透過するビットマップ画像に変換
//  Bitmap : 変換元のビットマップ画像
//  RefX   : 画像内でのX座標値(左端が0)
//  RefY   : 画像内でのY座標値(上端が0)
//  PAlphaColorArrayは
//    aBitmapData.GetPixel(X, Y);
//    aBitmapData.SetPixel(X, Y, TAlphaColor);
//  よりも高速処理が可能
//  色の値は上位バイトから順に，アルファ値,赤,緑,青(ARGB)となっている
//-----------------------------------------------------------------------------
procedure TranslateColorBitmap(Bitmap: TBitmap; RefX, RefY: Integer);
var
  aRefColor    : TAlphaColor;
  aPixelColor  : TAlphaColor;
  aBitMapData  : TBitmapData;
  X            : Integer;
  Y            : Integer;
  pColorArray  : PAlphaColorArray;
  PixelOffset  : Integer;
  LineStartPos : Integer;
begin
  //ビットマップのデータを取得
  //以後はこのpBitmapDataを操作する
  if Bitmap.Map(TMapAccess.maWrite, aBitMapData) then begin
    //指定座標値の色を取得
    aRefColor := aBitMapData.GetPixel(RefX, RefY) and $00FFFFFF;

    //ビットマップのピクセルデータの配列を取得
    pColorArray := PAlphaColorArray(aBitMapData.Data);
    PixelOffset := aBitMapData.Pitch div SizeOf(TAlphaColor);

    for Y := 0 to Trunc(Bitmap.Height) - 1 do begin
      //Y行目の先頭位置
      LineStartPos := Y * PixelOffset;

      for X := 0 to Trunc(Bitmap.Width) - 1 do begin
        //座標(X, Y)の色を取得
        aPixelColor := pColorArray[LineStartPos + X] and $00FFFFFF;
        if aPixelColor = aRefColor then begin
          pColorArray[LineStartPos + X] := $0;
        end;
      end;
    end;
    Bitmap.Unmap(aBitMapData);
  end;
end;

//=============================================================================
//  ディスクからビットマップ画像を読み込んでTImageに描画
//  透過処理なし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FilePath   : String;
  srcBitmap1 : TBitmap;
  srcBitmap2 : TBitmap;
  srcRect    : TRectF;
  dstRect    : TRectF;
begin
  Image1.Bitmap.Assign(nil);

  //ディスクから画像を読み込んでビットマップを生成
  FilePath      := '503.bmp';
  srcBitmap1    := TBitmap.CreateFromFile(FilePath);
  srcBitmap2    := TBitmap.CreateFromFile(FilePath);
  //TImageのビットマップを生成
  Image1.Bitmap := TBitmap.Create(Trunc(Image1.Width), Trunc(Image1.Height));
  try
    Image1.Bitmap.Canvas.BeginScene();

    //最初の画像の描画領域を設定して描画
    srcRect := TRectF.Create(0.0, 0.0, srcBitmap1.Width, srcBitmap1.Height);
    dstRect := TRectF.Create(0, 0, srcBitmap1.Width, srcBitmap1.Height);
    OffsetRect(dstRect, 30, 10);
    Image1.Bitmap.Canvas.DrawBitmap(srcBitmap1, srcRect, dstRect, 1.0);

    //次の画像の描画領域を設定して描画
    OffsetRect(dstRect, 30, 30);
    Image1.Bitmap.Canvas.DrawBitmap(srcBitmap2, srcRect, dstRect, 1.0);

    Image1.Bitmap.Canvas.EndScene();
  finally
    FreeAndNil(srcBitmap1);
    FreeAndNil(srcBitmap2);
  end;
end;

//=============================================================================
//  ディスクからビットマップ画像を読み込んでTImageに描画
//  透過処理あり
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  FilePath   : String;
  srcBitmap1 : TBitmap;
  srcBitmap2 : TBitmap;
  srcRect    : TRectF;
  dstRect    : TRectF;
begin
  Image1.Bitmap.Assign(nil);

  //ディスクから画像を読み込んでビットマップを生成
  FilePath      := '503.bmp';
  srcBitmap1    := TBitmap.CreateFromFile(FilePath);
  srcBitmap2    := TBitmap.CreateFromFile(FilePath);
  //TImageのビットマップを生成
  Image1.Bitmap := TBitmap.Create(Trunc(Image1.Width), Trunc(Image1.Height));
  try
    Image1.Bitmap.Canvas.BeginScene();

    //最初の画像の描画領域を設定して描画
    srcRect := TRectF.Create(0.0, 0.0, srcBitmap1.Width, srcBitmap1.Height);
    dstRect := TRectF.Create(0, 0, srcBitmap1.Width, srcBitmap1.Height);
    OffsetRect(dstRect, 30, 10);

    //画像の左上の色と同じ色を透過処理
    TranslateColorBitmap(srcBitmap1, 0, 0);
    Image1.Bitmap.Canvas.DrawBitmap(srcBitmap1, srcRect, dstRect, 1.0);


    //次の画像の描画領域を設定して描画
    OffsetRect(dstRect, 30, 30);

    //画像の左上の色と同じ色を透過処理
    TranslateColorBitmap(srcBitmap2, 0, 0);
    Image1.Bitmap.Canvas.DrawBitmap(srcBitmap2, srcRect, dstRect, 1.0);

    Image1.Bitmap.Canvas.EndScene();

    //拡張子を変えて，各種画像形式で保存
    //TPathの使用にはusesにSystem.IOUtilsが必要
    FilePath := TPath.ChangeExtension(FilePath, '.jpg');
    srcBitmap2.SaveToFile(FilePath);
    FilePath := TPath.ChangeExtension(FilePath, '.png');
    srcBitmap2.SaveToFile(FilePath);
    FilePath := TPath.ChangeExtension(FilePath, '.gif');
    srcBitmap2.SaveToFile(FilePath);
  finally
    FreeAndNil(srcBitmap1);
    FreeAndNil(srcBitmap2);
  end;
end;

end.