unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  private
    FImageFilePath : String;
    FMosaicRect    : TRect;
    FMosaicSize    : Integer;
    procedure SetImageFilePath(const Value: String);
    procedure SetMosaicRect(const Value: TRect);
    procedure SetMosaicSize(const Value: Integer);
  protected
    procedure Paint; override;
    function Mosaic(bmp: TBitmap; TargetRect: TRect; ASize: Integer):Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    property ImageFilePath : String  read FImageFilePath write SetImageFilePath;
    property MosaicRect    : TRect   read FMosaicRect    write SetMosaicRect;
    property MosaicSize    : Integer read FMosaicSize    write SetMosaicSize;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  protected

  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       := 320;
    Height      := 240;
    Color       := clWhite;

    ParentBackground := False;
    DoubleBuffered   := True;

    //表示する画像ファイル名
    ImageFilePath := 'dogs018.jpg';
  end;
end;

//=============================================================================
//  モザイクを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLeft : Integer;
  LTop  : Integer;
begin
  if not Assigned(MyPanel) then exit;

  LLeft := 40;
  LTop  := 60;
  MyPanel.MosaicSize := 10;
  MyPanel.MosaicRect := Rect(LLeft, LTop, LLeft + 120, LTop + 90);
end;

//=============================================================================
//  モザイクを表示しない
//  本サンプルのTMyPanelでは，モザイク領域を空にすると表示しないようになっている
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(MyPanel) then exit;
  MyPanel.MosaicRect := Rect(0, 0, 0, 0);
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  コンストラクタのCreate処理
//-----------------------------------------------------------------------------
constructor TMyPanel.Create(AOwner: TComponent);
begin
  inherited;
  SetRectEmpty(FMosaicRect);
  FMosaicSize := 8;
end;

//-----------------------------------------------------------------------------
//  ImageFilePathプロパティの設定用メソッド
//  表示する画像を変更したらTMyPanelを再描画
//-----------------------------------------------------------------------------
procedure TMyPanel.SetImageFilePath(const Value: String);
begin
  FImageFilePath := Value;
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  MosaicRectのプロパティ設定用メソッド
//  モザイクにする領域が変更になったら再描画
//-----------------------------------------------------------------------------
procedure TMyPanel.SetMosaicRect(const Value: TRect);
begin
  if EqualRect(FMosaicRect, Value) = False then begin
    FMosaicRect := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  MosaicSizeのプロパティ設定用メソッド
//  モザイクのサイズが変更されたら再描画
//-----------------------------------------------------------------------------
procedure TMyPanel.SetMosaicSize(const Value: Integer);
begin
  if FMosaicSize <> Value then begin
    FMosaicSize := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  モザイク化関数
//  引数で指定するbmp(ビットマップ)の指定領域(TargetRect)をモザイク画像にする
//  モザイクのサイズはASixeで指定する
//  結果は，引数のbmpに格納される
//-----------------------------------------------------------------------------
function TMyPanel.Mosaic(bmp: TBitmap; TargetRect: TRect;
  ASize: Integer): Boolean;
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;

var
  LTargetWidth  : Integer;
  LTargetHeight : Integer;
  LStartYPos    : Integer;
  LEndYPos      : Integer;
  LStartXPos    : Integer;
  LEndXPos      : Integer;
  LPosY         : Integer;
  LPosX         : Integer;
  LLoopY        : Integer;
  LLoopX        : Integer;
  LRValue       : integer;
  LGValue       : integer;
  LBValue       : integer;
  LpQuadArray   : PRGBQArray;
  Ldx           : Integer;
  Ldy           : Integer;
begin
  Result := False;
  if ASize < 2 then exit;

  bmp.Canvas.Lock;
  bmp.PixelFormat := pf32bit;
  LTargetWidth    := TargetRect.Right  - TargetRect.Left;
  LTargetHeight   := TargetRect.Bottom - TargetRect.Top;

  for LPosY := 0 to (LTargetHeight div ASize)  do begin
    for LPosX := 0 to (LTargetWidth div ASize) do begin

      LRValue := 0;
      LGValue := 0;
      LBValue := 0;

      LStartYPos := TargetRect.Top  + LPosY * ASize;
      LEndYPos   := TargetRect.Top  + LPosY * ASize + ASize - 1;
      LStartXPos := TargetRect.Left + LPosX * ASize;
      LEndXPos   := TargetRect.Left + LPosX * ASize + ASize - 1;

      //ASize領域内のR,G,B値を加算して...
      Ldy := 0;
      for LLoopY := LStartYPos to LEndYPos do begin
        if LLoopY > (TargetRect.Bottom - 1) then Continue;

        LpQuadArray := bmp.ScanLine[LLoopY];
        Ldx := 0;
        for LLoopX := LStartXPos to LEndXPos do begin
          if LLoopX > (TargetRect.Right - 1) then Continue;
          LRValue := LRValue + LpQuadArray[LLoopX].rgbRed;
          LGValue := LGValue + LpQuadArray[LLoopX].rgbGreen;
          LBValue := LBValue + LpQuadArray[LLoopX].rgbBlue;
          Ldx := Ldx + 1;
        end;
        Ldy := Ldy + 1;
      end;
      if (Ldx = 0) or (Ldy = 0) then Continue;

      //面積で平均化した値にする
      LRValue := LRValue div (Ldx * Ldy);
      LGValue := LGValue div (Ldx * Ldy);
      LBValue := LBValue div (Ldx * Ldy);

      //ASizeの領域内を全て平均化した色にする
      for LLoopY := LStartYPos to LEndYPos do begin
        if LLoopY > (TargetRect.Bottom - 1) then Continue;

        LpQuadArray := bmp.ScanLine[LLoopY];
        for LLoopX := LStartXPos to LEndXPos do begin
          if LLoopX > (TargetRect.Right - 1) then Continue;
          LpQuadArray[LLoopX].rgbRed   := LRValue;
          LpQuadArray[LLoopX].rgbGreen := LGValue;
          LpQuadArray[LLoopX].rgbBlue  := LBValue;
        end;
      end;
    end;
  end;

  bmp.Canvas.Unlock;
  Result := True;
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LGPGraphic : TGPGraphics;
  LGPImage   : TGPImage;
  LBitmap    : TBitmap;
begin
  inherited;

  //画像ファイルを指定してTGPImageのオブジェクトを生成
  LGPImage := TGPImage.Create(FImageFilePath);

  //表示用のビットマップを生成
  LBitmap := TBitmap.Create;
  try
    //そのビットマップのサイズを表示領域にあわせる
    LBitmap.SetSize(ClientWidth, ClientHeight);

    //TGPGraphicsのオブジェクトを生成．表示用のビットマップCanvasを描画先とする
    LGPGraphic := TGPGraphics.Create(LBitmap.Canvas.Handle);
    //表示用のビットマップのCanvasに描画
    //TCanvasのStretchDrawに相当する
    LGPGraphic.DrawImage(
                LGPImage,
                MakeRect(0, 0, ClientWidth, ClientHeight),
                0,
                0,
                LGPImage.GetWidth,
                LGPImage.GetHeight,
                UnitPixel);

   //モザイク処理
   if not IsRectEmpty(FMosaicRect) then begin
     Mosaic(LBitmap, FMosaicRect, FMosaicSize);
   end;
   //ビットマップをこのコントロールのCanvasに描画
   Canvas.Draw(0, 0, LBitmap);
  finally
    LBitmap.Free;
  end;

  //Createしたオブジェクトは解放処理する
  LGPImage.Free;
  LGPGraphic.Free;
end;

end.