トップへ(mam-mam.net/)

明るさ,コントラスト補正を写真画像に適用させる(FMX) ～Delphiソースコード集

明るさ,コントラスト補正を写真画像に適用させる(FMX) ～Delphiソースコード集

(参考)バイキュービック法（bicubic）で拡大縮小する(VCL)
(参考)バイキュービック法（bicubic）で拡大縮小する(FMX)
(参考)バイラテラルフィルタ（bilateral filter）で美肌に加工(VCL)
(参考)バイラテラルフィルタ（bilateral filter）で美肌に加工(FMX)
(参考)ガンマ(gamma)補正を画像に適用する(VCL)
(参考)ガンマ(gamma)補正を画像に適用する(FMX)
(参考)ソーベルフィルタ（Sobel filter）で境界（エッジ）検出(VCL)

明るさ、コントラスト補正を使用する為のファイルの準備

本ページの下部のソースコードをコピーして「UFMXMamBrightContrast.pas」ファイルを作成し、 プロジェクトフォルダ内に入れる。

プロジェクトの作成とソースコードの記述

プロジェクトを新規作成（FMXアプリケーション）し、フォーム(Form1)にTImageを2個、TTrackBarを2個、TButtonを1個配置する。
Image1のPictureプロパティから、明るさ、コントラスト補正を適用したい画像をロードしておく。
TButton1をダブルクリックして、以下ソースコードを記述する。
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses UFMXMamBrightContrast;

procedure TForm1.Button1Click(Sender: TObject);
var bmp:FMX.Graphics.TBitmap;
begin
  bmp:=FMX.Graphics.TBitmap.Create;
  try
    //Image1の明るさを調整してbmpに
    MamBright(Image1.Bitmap, bmp, TrackBar1.Value);
    //bmpのコントラストを調整してImage2に
    MamContrast(bmp, Image2.Bitmap, TrackBar2.Value);
  finally
    bmp.Free
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //明るさ調整
  TrackBar1.Min:=-1;
  TrackBar1.Max:=1;
  TrackBar1.Value:=0;

  //コントラスト調整
  TrackBar2.Min:=-1;
  TrackBar2.Max:=1;
  TrackBar2.Value:=0;

end;

end.

実行する

実行ボタンを押して実行します。（デバッグ実行でもOK）

Button1をクリックすると、Image1画像に明るさ、コントラスト補正が適用された画像をImage2に表示します。

「UFMXMamBrightContrast.pas」ファイルのソースコード

unit UFMXMamBrightContrast;

interface

uses System.Types,System.UITypes, System.Math,
     System.Generics.Collections, System.Generics.Defaults,
     FMX.Graphics, FMX.Types;

//使い方 MamContrast(変換元TBitmap,変換後TBitmap,強さ[-1.0～+1.0])
procedure MamContrast(src,dest:FMX.Graphics.TBitmap;Strength:Single=0.0);
//使い方 MamContrast(変換元TBitmap,変換後TBitmap,強さ[-1.0～+1.0])
procedure MamBright(src,dest:FMX.Graphics.TBitmap;Strength:Single=0.0);


implementation

Type
  //TSRGBA=record B,G,R,A:Single; end;

  TRGBA=record B,G,R,A:Byte; end;
  TRGBAArr=array[0..64535 div 2] of TRGBA;
  PRGBAArr=^TRGBAArr;
  TRGBAArrArr=array[0..64535 div 2] of PRGBAArr;

procedure MamContrast(src,dest:FMX.Graphics.TBitmap;Strength:Single=0.0);
var v:byte;
    x,y:Integer;
    r,g,b:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:PRGBAArr;
begin
  if not assigned(src) then exit;
  if (src.Width=0) or (src.Height=0) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  if Strength> 1 then Strength:= 1;
  if Strength<-1 then Strength:=-1;
  Strength:=Strength+1;

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp:=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      v:=127;

      for y := 0 to SrcBmp.Height-1 do
      begin
        SrcRGBA:=SrcData.GetScanline(y);
        DestRGBA:=DestData.GetScanline(y);
        for x := 0 to fRect.Width-1 do
        begin
          r:=Round((SrcRGBA[x].R-v)*Strength+v);
          g:=Round((SrcRGBA[x].G-v)*Strength+v);
          b:=Round((SrcRGBA[x].B-v)*Strength+v);
          if r>255 then r:=255;
          if g>255 then g:=255;
          if b>255 then b:=255;
          if r<0 then r:=0;
          if g<0 then g:=0;
          if b<0 then b:=0;

          DestRGBA[x].R:=r;
          DestRGBA[x].G:=g;
          DestRGBA[x].B:=b;
          DestRGBA[x].A:=255;
        end;
      end;

    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;

end;


procedure MamBright(src,dest:FMX.Graphics.TBitmap;Strength:Single=0.0);
var x,y:Integer;
    r,g,b:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:PRGBAArr;
begin
  if not assigned(src) then exit;
  if (src.Width=0) or (src.Height=0) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;
  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  if Strength> 1 then Strength:= 1;
  if Strength<-1 then Strength:=-1;
  Strength:=Strength*127;

  SrcBmp:=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,True);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      for y := 0 to fRect.Height-1 do
      begin
        SrcRGBA:=SrcData.GetScanline(y);
        DestRGBA:=DestData.GetScanline(y);
        for x := 0 to fRect.Width-1 do
        begin
          r:=Round(SrcRGBA[x].R+Strength);
          g:=Round(SrcRGBA[x].G+Strength);
          b:=Round(SrcRGBA[x].B+Strength);
          if r>255 then r:=255;
          if g>255 then g:=255;
          if b>255 then b:=255;
          if r<0 then r:=0;
          if g<0 then g:=0;
          if b<0 then b:=0;

          DestRGBA[x].R:=r;
          DestRGBA[x].G:=g;
          DestRGBA[x].B:=b;
          DestRGBA[x].A:=255;
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData)
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,True);
    dest.canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;

end;

end.