ノーマライズ(ヒストグラムの引き伸ばし)のサンプルコード

//Bass Unit
unit EffectBass;

interface
uses
 Windows,SysUtils, Classes, Graphics;

type
 //24bitアクセス用ポインタ
 pRGBarray  = ^TRGBarray;
 TRGBarray  = array[0..0] of TRGBTriple; //None リテラル

type
 //24bitアクセス用ダブルポインタ
 PPBits = ^TPBits;
 TPBits = array[0..0] of pRGBarray; //None リテラル

//汎用プロシージャ
procedure Set24bit(Src,Dest :TBitmap);
function  Set255(Value : integer) : BYTE;

implementation


/////////
procedure Set24bit(Src,Dest :Tbitmap);
begin
  Src.PixelFormat :=pf24bit;
  Dest.PixelFormat:=pf24bit;
  Dest.Width:=Src.Width;
  Dest.Height:=Src.Height;
end;

/////////
function Set255(Value:Integer):Byte;
begin
 if Value>=255 then
  Result:=255
 else if Value<=0 then
 Result:=0
 else Result:=Value;
end;
end.

//-----------------------------------------------------------------------------
//■関数     EffectHistogramNormalize
//■用途     ノーマライズ(ヒストグラムの引き伸ばし)
//■引数     hBMP             ...転送元のビットマップのハンドル
//■戻り値
//            新しいビットマップのハンドル
//-----------------------------------------------------------------------------
function  EffectHistogramNormalize(hBMP:HBitmap):HBitmap;
var
  Row,Col        : Integer;
  DestRow,SrcRow : pRGBArray;
  SrcBitmap,DestBitmap:TBitmap  ;
  aMin,aMax : TRGBTriple;
  R_ratio,G_ratio,B_ratio :Single;
begin

//------------------------------------------------------------------------------
//
//                           ――線形濃度変換――
//
//  原画像のヒストグラムにおける濃度の最小値をmin、最大値をmaxとしたとき、
//  次の式により変換する。
//
//                 (新しい濃度値)=255/max-min*(現画像の濃度値)
//------------------------------------------------------------------------------

  SrcBitmap := TBitmap.Create;
  DestBitmap:= TBitmap.Create;
  SrcBitmap.handle := hBMP;
  Set24bit(SrcBitmap,DestBitmap);

  FillChar(aMin,Sizeof(TRGBTriple),255);
  FillChar(aMax,Sizeof(TRGBTriple),0);

  try


    for Row := 0 to SrcBitmap.Height - 1 do
    begin
      SrcRow  := SrcBitmap.Scanline[Row];
      for Col := 0 to SrcBitmap.Width - 1 do
      begin
          //  最小値の入れ替え
          if (SrcRow[Col].rgbtRed   < aMin.rgbtRed)   then aMin.rgbtRed     :=SrcRow[Col].rgbtRed;
          if (SrcRow[Col].rgbtGreen < aMin.rgbtGreen) then aMin.rgbtGreen   :=SrcRow[Col].rgbtGreen;
          if (SrcRow[Col].rgbtBlue  < aMin.rgbtBlue)  then aMin.rgbtBlue    :=SrcRow[Col].rgbtBlue;

          // 最大値の入れ替え
          if (SrcRow[Col].rgbtRed   > aMax.rgbtRed)   then  aMax.rgbtRed     :=SrcRow[Col].rgbtRed;
          if (SrcRow[Col].rgbtGreen > aMax.rgbtGreen) then  aMax.rgbtGreen   :=SrcRow[Col].rgbtGreen;
          if (SrcRow[Col].rgbtBlue  > aMax.rgbtBlue)  then  aMax.rgbtBlue    :=SrcRow[Col].rgbtBlue;
      end;
    end;

    R_ratio :=  255 / (aMax.rgbtRed   - aMin.rgbtRed);
    G_ratio :=  255 / (aMax.rgbtGreen - aMin.rgbtGreen);
    B_ratio :=  255 / (aMax.rgbtBlue  - aMin.rgbtBlue);

    for Row := 0 to SrcBitmap.Height - 1 do
    begin
      SrcRow  := SrcBitmap.Scanline[Row];
      DestRow := DestBitmap.Scanline[Row];
      for Col := 0 to SrcBitmap.Width - 1 do
      begin
         // maxはMath.pasにあるのでuses節にMathを追加する
         DestRow[Col].rgbtRed   := Set255( Round(R_ratio * max( (SrcRow[Col].rgbtRed   - aMin.rgbtRed  ),0)) );
         DestRow[Col].rgbtGreen := Set255( Round(G_ratio * max( (SrcRow[Col].rgbtGreen - aMin.rgbtGreen),0)) );
         DestRow[Col].rgbtBlue  := Set255( Round(B_ratio * max( (SrcRow[Col].rgbtBlue  - aMin.rgbtBlue ),0)) );
      end;   
    end;
        
  Result :=DestBitmap.ReleaseHandle;

  except
     Result :=SrcBitmap.ReleaseHandle;
  end;
  
  SrcBitmap.Free ;
  DestBitmap.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Image1.Picture.Bitmap.Handle :=
      EffectHistogramNormalize(Image1.Picture.Bitmap.ReleaseHandle);
end;