Image Histogram & Correction by testest

Post date: Nov 16, 2010 11:08:27 PM

This delphi unit, written by testest, can be used to alter an image in such a way to make a picture which is too bright or too dark look better.

Author: testest

Compiled: Delphi 2007

Screenshot: Create perfect contrast in your Passport Photo.

An example project, also written by testest, detailing how to use the unit is attached at the bottom of the page.

unit ImageHistogram;
//Author: testest
interface
uses
  Windows, Graphics;
type
  THistogramArray = array[0..255] of Cardinal;
  THistogramChannel = (hclGray, hclRed, hclGreen, hclBlue);
  THistogram = class
  private
    FChannels: array[THistogramChannel] of THistogramArray;
    FPixels: Cardinal;
    function GetChannel(Index: THistogramChannel): THistogramArray;
  public
    constructor Create(Bmp: TBitmap); overload;
    procedure Init(Bmp: TBitmap);
    property Channel[Index: THistogramChannel]: THistogramArray read GetChannel; default;
    property Pixels: Cardinal read FPixels;
  end;
procedure AdjustBitmap(Bmp: TBitmap; Channel: THistogramChannel = hclGray;
                        Tolerance: Cardinal = 0); overload;
procedure AdjustBitmap(Bmp: TBitmap; Hist: THistogram; Channel: THistogramChannel = hclGray;
                        Tolerance: Cardinal = 0); overload;
procedure AdjustBitmap(Bmp: TBitmap; Low, High: Byte; Channel: THistogramChannel = hclGray); overload;
implementation
type
  TRGBTriple = array[0..2] of Byte;
constructor THistogram.Create(Bmp: TBitmap);
begin
  Create;
  Init(Bmp);
end;
function THistogram.GetChannel(Index: THistogramChannel): THistogramArray;
begin
  Result := FChannels[Index];
end;
procedure THistogram.Init(Bmp: TBitmap);
var
  RGB: ^TRGBTriple;
  X, Y: Integer;
  C: THistogramChannel;
begin
  FPixels := Bmp.Width * Bmp.Height;
  FillChar(FChannels, SizeOf(FChannels), #0);
  if Bmp.PixelFormat <> pf24bit then
    Bmp.PixelFormat := pf24bit;
  for Y := 0 to Bmp.Height - 1 do
  begin
    RGB := Bmp.ScanLine[Y];
    for X := 0 to Bmp.Width - 1 do
    begin
      for C := hclRed to hclBlue do
        Inc(FChannels[C][RGB[3 - Byte(C)]]);
      Inc(FChannels[hclGray][(RGB[0] + RGB[1] + RGB[2]) div 3]);
      Inc(RGB);
    end;
  end;
end;
procedure AdjustBitmap(Bmp: TBitmap; Channel: THistogramChannel = hclGray;
                        Tolerance: Cardinal = 0);
var
  Hist: THistogram;
begin
  Hist := THistogram.Create;
  try
    Hist.Init(Bmp);
    AdjustBitmap(Bmp, Hist, Channel, Tolerance);
  finally
    Hist.Free;
  end;
end;
procedure AdjustBitmap(Bmp: TBitmap; Hist: THistogram; Channel: THistogramChannel = hclGray;
                        Tolerance: Cardinal = 0);
var
  L, H, X: Byte;
begin
  L := 0;
  for X := 0 to 255 do
    if Hist[hclGray][X] > Tolerance then Break
    else Inc(L);
  H := 255;
  for X := 255 downto 0 do
    if Hist[hclGray][X] > Tolerance then Break
    else Dec(H);
  AdjustBitmap(Bmp, L, H, Channel);
end;
procedure AdjustBitmap(Bmp: TBitmap; Low, High: Byte; Channel: THistogramChannel = hclGray);
var
  RGB: ^TRGBTriple;
  X, Y, W, H, M: Integer;
  Z: Byte;
begin
  if Low = High then
    Exit
  else if Low > High then
  begin
    Z := Low;
    Low := High;
    High := Z;
  end;
  if (Low = 0) and (High = 255) then
    Exit;
  if Bmp.PixelFormat <> pf24bit then
    Bmp.PixelFormat := pf24bit;
  Dec(High, Low);
  W := Bmp.Width - 1;
  H := Bmp.Height - 1;
  if Channel = hclGray then
  begin
    for Y := 0 to H do
    begin
      RGB := Bmp.ScanLine[Y];
      for X := 0 to W do
      begin
        for Z := 0 to 2 do
        begin
          M := (RGB[Z] - Low) * 255 div High;
          if M < 0 then RGB[Z] := 0
          else if M > 255 then RGB[Z] := 255
          else RGB[Z] := M;
        end;
        Inc(RGB);
      end;
    end;
  end
  else
  begin
    Z := 3 - Byte(Channel);
    for Y := 0 to H do
    begin
      RGB := Bmp.ScanLine[Y];
      for X := 0 to W do
      begin
        M := (RGB[Z] - Low) * 255 div High;
        if M < 0 then RGB[Z] := 0
        else if M > 255 then RGB[Z] := 255
        else RGB[Z] := M;
        Inc(RGB);
      end;
    end;
  end;
end;
end.

Usage:

AdjustBitmap(SomeBitmap);

Only Delphi source code is included in the archive.