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

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

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

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

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

TButton1をダブルクリックして、以下ソースコードを記述する。

unit Unit1;

interface

uses
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.ComCtrls, Vcl.ExtCtrls,
  Vcl.Imaging.jpeg, Vcl.Imaging.pngimage;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses UMamBrightContrast;

procedure TForm1.Button1Click(Sender: TObject);
var sbmp,dbmp:TBitmap;
begin
  sbmp:=TBitmap.Create;
  dbmp:=TBitmap.Create;
  try
    sbmp.Assign(Image1.Picture.Graphic);
    //MamBright(変換元TBitmap,変換後TBitmap,強さ[暗く-1.0～+1.0明るく])
    MamBright(sbmp,dbmp,TrackBar1.Position/100);
    //MamContrast(変換元TBitmap,変換後TBitmap,強さ[下げる-1.0～+1.0上げる])
    MamContrast(dbmp,Image2.Picture.Bitmap,TrackBar2.Position/100);
  finally
    sbmp.Free;
    dbmp.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Proportional:=True;
  Image2.Proportional:=True;

  //明るさ調整
  TrackBar1.Min:=-100;
  TrackBar1.Max:=100;
  TrackBar1.Position:=0;
  TrackBar1.Frequency:=10;
  TrackBar1.SelEnd:=1;
  TrackBar1.PositionToolTip:=ptBottom;

  //コントラスト調整
  TrackBar2.Min:=-100;
  TrackBar2.Max:=100;
  TrackBar2.Position:=0;
  TrackBar2.Frequency:=10;
  TrackBar2.SelEnd:=1;
  TrackBar2.PositionToolTip:=ptBottom;
end;

end.

実行する

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

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

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

unit UMamBrightContrast;

interface      //■■■宣言部■■■

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

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


implementation //■■■実装部■■■

Type
  TRGB=record B,G,R:Byte; end;
  TRGBArr=array[0..65535] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..65535] of PRGBArr;

procedure MamContrast(src,dest:VCL.Graphics.TBitmap;Strength:Single=0.0);
var v:byte;
    x,y:Integer;
    r,g,b:Integer;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    fRect:TRect;
    SrcRGB,DestRGB:PRGBArr;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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+1;

  SrcBmp:=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    v:=127;
    for y := 0 to SrcBmp.Height-1 do
    begin
      SrcRGB:=SrcBmp.Scanline[y];
      DestRGB:=DestBmp.Scanline[y];
      for x := 0 to fRect.Width-1 do
      begin
        r:=Round((SrcRGB[x].R-v)*Strength+v);
        g:=Round((SrcRGB[x].G-v)*Strength+v);
        b:=Round((SrcRGB[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;

        DestRGB[x].R:=r;
        DestRGB[x].G:=g;
        DestRGB[x].B:=b;
      end;
    end;
    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

procedure MamBright(src,dest:VCL.Graphics.TBitmap;Strength:Single=0.0);
var x,y:Integer;
    r,g,b:Integer;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    fRect:TRect;
    SrcRGB,DestRGB:PRGBArr;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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:=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    for y := 0 to SrcBmp.Height-1 do
    begin
      SrcRGB:=SrcBmp.Scanline[y];
      DestRGB:=DestBmp.Scanline[y];
      for x := 0 to fRect.Width-1 do
      begin
        r:=Round(SrcRGB[x].R+Strength);
        g:=Round(SrcRGB[x].G+Strength);
        b:=Round(SrcRGB[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;

        DestRGB[x].R:=r;
        DestRGB[x].G:=g;
        DestRGB[x].B:=b;
      end;
    end;
    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

end.