明るさ,コントラスト補正を写真画像に適用させる(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プロパティから、明るさ、コントラスト補正を適用したい画像をロードしておく。
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.