(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
(*
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2017 by Xequte Software.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.

www.ImageEn.com
*)

(*
File version 1007
Doc revision 1001
*)

unit histogrambox;

{$R-}
{$Q-}

{$I ie.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ImageEnProc, hyiedefs, iexBitmaps;

type

{!!
<FS>THistogramKind

<FM>Declaration<FC>
}
  THistogramKind = set of (hkRed, hkGreen, hkBlue, hkGray, hkHue);
{!!}

{!!
<FS>THistogramLabels

<FM>Declaration<FC>
}
  THistogramLabels = set of (hlVertical, hlHorizontal);
{!!}

{!!
<FS>THistogramStyle

<FM>Declaration<FC>
}
  THistogramStyle = (hsBars, hsLines, hsFilledLines);
{!!}


{!!
<FS>THistogramMouseInteract

<FM>Declaration<FC>
THistogramMouseInteract = (mhNone, mhSelectValue, mhSelectRange);

<FM>Description<FN>
What action does the mouse perform:
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>mhNone</C> <C>Mouse has no effect</C> </R>
<R> <C>mhSelectValue</C> <C>Clicking/moving the mouse selects a single value on the histogram</C> </R>
<R> <C>mhSelectRange</C> <C>Clicking/moving the mouse selects a range of values on the histogram</C> </R>
</TABLE>
!!}
THistogramMouseInteract = (mhNone, mhSelectValue, mhSelectRange);


{!!
<FS>THistogramBox

<FM>Description<FN>
THistogramBox can be attached to a <A TImageEnProc> component from which it gets information to compute and display the color channels histogram.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\Histogram\Histogram.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Setup
with HistogramBox1 do
begin
  Background     := clBtnFace;                   // Change background color
  Font.Color     := clDarkGray;                  // Set font and chart color to dark gray
  MouseInteract  := mhSelectValue;               // Allow selection of a single value
  HistogramKind  := [ hkRed, hkGreen, hkBlue ];  // Histogram to show RGB levels
  HistogramStyle := hsFilledLines;               // Show a filled line graph instead of bars
end;

// Display histogram of colors in current image
HistogramBox1.UpdateFromBitmap( ImageEnView1.IEBitmap );

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.AttachedImageEnProc></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.Background></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.Bitmap></C> </R>
<R> <C_IMG_METHOD> <C><A THistogramBox.Clear></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.CompBar></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.GrayColor></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.HistogramKind></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.HistogramStyle></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.HistogramAbsXPos></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.Labels></C> </R>
<R> <C_IMG_PUBLISHED> <C><A THistogramBox.MouseInteract></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.MinSelected></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.MaxSelected></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.Scale></C> </R>
<R> <C_IMG_PROPERTY> <C><A THistogramBox.SelectionColor></C> </R>
<R> <C_IMG_METHOD> <C><A THistogramBox.UpdateFromBitmap></C> </R>
<R> <C_IMG_METHOD> <C><A THistogramBox.UpdateFromHistogram></C> </R>
</TABLE>

<FM>Events<FN>
<TABLE2>
<R> <C_IMG_EVENT> <C><A THistogramBox.OnSelectionChanged></C> </R>
<R> <C_IMG_EVENT> <C><A THistogramBox.OnSelectionChanging></C> </R>
</TABLE>
!!}
  {$ifdef IEHASPLATFORMATTRIBUTE}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$endif}
  THistogramBox = class(TCustomControl)
  private
    { Private declarations }
    fBackground: TColor;
    fAIEP: TImageEnProc;  // attached TImageEnProc
    fHistKind: THistogramKind;
    fLabels: THistogramLabels;
    fCompBar: boolean;
    fHistogramStyle: THistogramStyle;
    fHistogramAbsXPos: integer;
    fGrayColor: TColor;
    fMouseMinX : Integer;
    fMouseMaxX : Integer;
    fMouseMinDown : Boolean;
    fMouseMaxDown : Boolean;
    fMouseInteract: THistogramMouseInteract;
    fSelectionColor : TColor;
    fOnSelectionChanged: TNotifyEvent;
    fOnSelectionChanging: TNotifyEvent;
    fScale: THistogramScale;
    procedure SetBackground(bk: TColor);
    procedure SetLabels(v: THistogramLabels);
    procedure SetCompBar(v: boolean);
    procedure SetHistogramStyle(v: THistogramStyle);
    procedure SetHistogramKind(v: THistogramKind);
    procedure SetAIEP(v: TImageEnProc);
    function GetHistogramKind: THistogramKind;
    function GetLabels: THistogramLabels;
    procedure SetMouseInteract(v: THistogramMouseInteract);
    procedure SetSelectionColor(const Value: TColor);
    function GetMaxSelected: Integer;
    function GetMinSelected: Integer;
    procedure SetMaxSelected(const Value: Integer);
    procedure SetMinSelected(const Value: Integer);
    procedure SetScale(Value: THistogramScale);
  protected
    { Protected declarations }

    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    
  public
    { Public declarations }

{!!
<FS>THistogramBox.Bitmap

<FM>Declaration<FC>
property Bitmap: TBitmap;

<FM>Description<FN>
The bitmap of the current histogram
          
<FM>Example<FC>
uses
  iexHelperFunctions;

// Print the current histogram
Printer.BeginDoc;
HistogramBox1.Bitmap.PrintImage(Printer.Canvas, 0, 0, 0, 0, ievpCenter, iehpCenter, iesFitToPage);
Printer.EndDoc;
!!}
    Bitmap: TBitmap;
    
    procedure Paint; override;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Update(); override;
    procedure UpdateFromBitmap(Bitmap: TIEBitmap);
    procedure UpdateFromHistogram(Histogram: TIEHistogram);
    procedure Clear();

{!!
<FS>THistogramBox.HistogramAbsXPos

<FM>Declaration<FC>
property HistogramAbsXPos: integer;

<FM>Description<FN>
Returns the left X coordinate where the histogram will be painted inside the component client area.

Read-only
!!}
    property HistogramAbsXPos: integer read fHistogramAbsXPos;

    property SelectionColor : TColor read fSelectionColor write SetSelectionColor;
    property MinSelected : Integer read GetMinSelected write SetMinSelected;
    property MaxSelected : Integer read GetMaxSelected write SetMaxSelected;

    property Scale: THistogramScale read fScale write SetScale;

  published
    { Published declarations }
    property AttachedImageEnProc: TImageEnProc read fAIEP write SetAIEP;
    property Background: TColor read fBackground write SetBackground default clWhite;
    property HistogramKind: THistogramKind read GetHistogramKind write SetHistogramKind default [hkGray];
    property Labels: THistogramLabels read GetLabels write SetLabels default [hlVertical, hlHorizontal];
    property CompBar: boolean read fCompBar write SetCompBar default true;
    property HistogramStyle: THistogramStyle read fHistogramStyle write SetHistogramStyle default hsBars;

{!!
<FS>THistogramBox.GrayColor

<FM>Declaration<FC>
property GrayColor: Tcolor;

<FM>Description<FN>
Specifies the color of the line/bar for a gray histogram (i.e. when <A THistogramBox.HistogramKind> is [hkGray]).
!!}
    property GrayColor: TColor read fGrayColor write fGrayColor default clBlack;

{!!
<FS>THistogramBox.OnSelectionChanged

<FM>Declaration<FC>
property OnSelectionChanged: TNotifyEvent;

<FM>Description<FN>
If <A THistogramBox.MouseInteract> has been enabled then this event will occur after the user has modified the selection.

Note: Unlike <A THistogramBox.OnSelectionChanged> this event only fires once per change (on mouse up)
!!}
    property OnSelectionChanged: TNotifyEvent read fOnSelectionChanged write fOnSelectionChanged;

{!!
<FS>THistogramBox.OnSelectionChanging

<FM>Declaration<FC>
property OnSelectionChanging: TNotifyEvent;

<FM>Description<FN>
If <A THistogramBox.MouseInteract> has been enabled then this event will occur as the user modifies the selection.

Note: Unlike <A THistogramBox.OnSelectionChanged> this event will fire multiple times during a selection change (as user drags mouse)
!!}
    property OnSelectionChanging: TNotifyEvent read fOnSelectionChanging write fOnSelectionChanging;
    
    property MouseInteract: THistogramMouseInteract read fMouseInteract write SetMouseInteract default mhNone;

    property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property Font;
    property Width default 256;
    property Height default 105;
    property OnContextPopup;
  end;

implementation

uses
  iegdiplus, hyieutils, imageenview;

{$R-}

/////////////////////////////////////////////////////////////////////////////////////

constructor THistogramBox.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  IEGDIPLoadLibrary();
  ControlStyle := ControlStyle + [csOpaque, csAcceptsControls];
  fBackground := clWhite;
  fHistKind := [hkGray];
  fLabels := [hlVertical, hlHorizontal];
  fCompBar := true;
  fHistogramStyle := hsBars;
  fGrayColor := clBlack;
  Height := 105;
  Width := 256;
  bitmap := TBitmap.create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := 1;
  bitmap.Height := 1;
  fAIEP := nil;
  fMouseInteract := mhNone;
  fMouseMinX := 0;
  fMouseMaxX := 0;
  fMouseMinDown := False;
  fMouseMaxDown := False;
  fSelectionColor := clRed;
  fScale := iehsLinear;
  Update;
end;

/////////////////////////////////////////////////////////////////////////////////////

destructor THistogramBox.Destroy;
begin
  FreeAndNil(bitmap);
  IEGDIPUnLoadLibrary();
  inherited;
end;

procedure THistogramBox.Paint;
begin
  canvas.Draw(0, 0, bitmap);

  if ( fMouseInteract = mhSelectValue ) and ( fMouseMinX >= fHistogramAbsXPos ) then
  begin
    Canvas.Pen.Color := fSelectionColor;
    Canvas.MoveTo( fMouseMinX, 0 );
    Canvas.LineTo( fMouseMinX, Height );
  end;

  if ( fMouseInteract = mhSelectRange ) and ( fMouseMinX >= fHistogramAbsXPos ) then
  begin
    if fMouseMinX > fMouseMaxX then
    begin
      IESwap( fMouseMinX, fMouseMaxX );
      IESwap( fMouseMinDown, fMouseMaxDown );
    end;
    Canvas.Brush.Color := fSelectionColor;
    Canvas.FrameRect( Rect( fMouseMinX, 0 , fMouseMaxX + 1, Height ));
  end;
end;

procedure THistogramBox.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result := 0;
end;

procedure THistogramBox.WMSize(var Message: TWMSize);
begin
  inherited;
  bitmap.Width := message.Width;
  bitmap.Height := message.Height;
  Update;
end;

{!!
<FS>THistogramBox.Background

<FM>Declaration<FC>
property Background: TColor;

<FM>Description<FN>
Specifies the background color.

Note: To change the color of the font and grid use Font.Color
!!}
procedure THistogramBox.SetBackground(bk: TColor);
begin
  fBackground := bk;
  update;
end;


procedure THistogramBox.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  Cursor_Margin = 3;
begin
  inherited;

  if fMouseInteract in [ mhSelectValue, mhSelectRange ] then
  begin
    if fMouseMinDown then
      fMouseMinX := ilimit( X, fHistogramAbsXPos, Width - 1 );
    if fMouseMaxDown then
      fMouseMaxX := ilimit( X, fHistogramAbsXPos, Width - 1 );
    if fMouseMinDown or fMouseMaxDown then
    begin        
      Invalidate;
      if assigned( fOnSelectionChanging ) then
        fOnSelectionChanging( Self);
    end;

    if ( X >= fHistogramAbsXPos - Cursor_Margin div 2 ) and
       (( Abs( X - fMouseMinX ) <= Cursor_Margin ) OR ( Abs( X - fMouseMaxX ) <= Cursor_Margin )) then
      Cursor := crHSplit
    else
      Cursor := crDefault;
  end;
end;


procedure THistogramBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  if ( Button = mbLeft ) and ( fMouseInteract = mhSelectValue ) and ( X >= fHistogramAbsXPos )  then
  begin
    fMouseMinDown  := True;
    fMouseMaxDown := False;
    fMouseMinX := X;
    Invalidate;
  end
  else
  if ( Button = mbLeft ) and ( fMouseInteract = mhSelectRange ) and ( X >= fHistogramAbsXPos ) then
  begin       
    fMouseMinDown := False;
    fMouseMaxDown := False;

    // Over Min or Max item?
    if Abs( X - fMouseMinX ) < Abs( X - fMouseMaxX ) then
    begin
      fMouseMinX := X;
      if fMouseMaxX < fHistogramAbsXPos then
        fMouseMaxX := fHistogramAbsXPos;
      fMouseMinDown := True;
    end
    else
    begin
      if fMouseMinX < fHistogramAbsXPos then
        fMouseMinX := fHistogramAbsXPos;
      fMouseMaxX := X;
      fMouseMaxDown := True;
    end;

    Invalidate;
  end;
end;


procedure THistogramBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if fMouseMinDown or fMouseMaxDown then
  begin
    fMouseMinDown := False;
    fMouseMaxDown := False;
    Invalidate;

    // Ensure it is called even if user clicks once in a new position
    if assigned( fOnSelectionChanging ) then
      fOnSelectionChanging( Self);

    if assigned( fOnSelectionChanged ) then
      fOnSelectionChanged( Self);
  end;
end;


procedure THistogramBox.SetLabels(v: THistogramLabels);
begin
  if v <> fLabels then
  begin
    fLabels := v;
    Update;
  end;
end;


{!!
<FS>THistogramBox.MouseInteract

<FM>Declaration<FC>
property MouseInteract: <A THistogramMouseInteract>;

<FM>Description<FN>
Determines what effect use of the mouse has on the component

<FM>Example<FC>
// Allow the user to select a value on the histogram
HistogramBox1.MouseInteract := mhSelectValue;

<FM>See Also<FC>
- <A THistogramBox.MinSelected>
- <A THistogramBox.MaxSelected>
- <A THistogramBox.SelectionColor>
!!}
procedure THistogramBox.SetMouseInteract(v: THistogramMouseInteract);
begin
  if v <> fMouseInteract then
  begin
    fMouseInteract := v;
    Invalidate;
  end;  
end;

{!!
<FS>THistogramBox.SelectionColor

<FM>Declaration<FC>
property SelectionColor: TColor;

<FM>Description<FN>
Specifies the color of the selection line/box if you have enabled mouse interaction.

<FM>See Also<FC>
- <A THistogramBox.MouseInteract>
!!}
procedure THistogramBox.SetSelectionColor(const Value: TColor);
begin
  fSelectionColor := Value;
  Invalidate;
end;

{!!
<FS>THistogramBox.CompBar

<FM>Declaration<FC>
property CompBar: boolean;

<FM>Description<FN>
If True, a gradient bar is shown below the histogram graph.
!!}
procedure THistogramBox.SetCompBar(v: boolean);
begin
  if v <> fCompBar then
  begin
    fCompBar := v;
    Update;
  end;
end;

{!!
<FS>THistogramBox.HistogramStyle

<FM>Declaration<FC>
property HistogramStyle: <A THistogramStyle>;

<FM>Description<FN>
Specifies the styling of the histogram: Solid bars, single lines or filled lines.

Default: hsBars
!!}
procedure THistogramBox.SetHistogramStyle(v: THistogramStyle);
begin
  if v <> fHistogramStyle then
  begin
    fHistogramStyle := v;
    Update;
  end;
end;

procedure THistogramBox.SetHistogramKind(v: THistogramKind);
begin
  if v <> fHistKind then
  begin
    fHistKind := v;
    Update;
  end;
end;


function ConvHistKindToHistContent(histKind: THistogramKind): TIEHistogramContent;
begin
  result := [];
  if hkRed in histKind then result := result + [iehcRed];
  if hkGreen in histKind then result := result + [iehcGreen];
  if hkBlue in histKind then result := result + [iehcBlue];
  if hkGray in histKind then result := result + [iehcGray];
  if hkHue in histKind then result := result + [iehcHue];
end;


{!!
<FS>THistogramBox.UpdateFromBitmap

<FM>Declaration<FC>
procedure UpdateFromBitmap(Bitmap: TIEBitmap);

<FM>Description<FN>
Updates the histogram from the specified bitmap.

<FM>Example<FC>
HistogramBox1.UpdateFromBitmap( ImageEnView1.IEBitmap );
!!}
procedure THistogramBox.UpdateFromBitmap(Bitmap: TIEBitmap);
var
  proc: TImageEnProc;
  Hist: TIEHistogram;
begin
  proc := TImageEnProc.CreateFromBitmap(Bitmap);
  try
    Hist := proc.GetHistogram(ConvHistKindToHistContent(fHistKind));
    UpdateFromHistogram(Hist);
  finally
    proc.Free();
  end;
end;


{!!
<FS>THistogramBox.Clear

<FM>Declaration<FC>
procedure Clear();

<FM>Description<FN>
Reset the histogram to null values.

<FM>Example<FC>
HistogramBox1.Clear();
!!}
procedure THistogramBox.Clear();
var
  i: integer;
  Hist: TIEHistogram;
begin
  SetLength(Hist, 256);
  for i := 0 to 255 do
  begin
    Hist[i].r := 0;
    Hist[i].g := 0;
    Hist[i].b := 0;
    Hist[i].Gray := 0;
    Hist[i].Hue := 0;
  end;
  UpdateFromHistogram( Hist );
end;

// rebuild histogram from current selection (needs AttachedImageEnProc)
procedure THistogramBox.Update();
var
  i: integer;
  Hist: TIEHistogram;

  function GetRandom : integer;
  begin
    if I <= 128 then
      Result := I
    else
      Result := 256 - I;
    Result := Result + random(128);
  end;

begin
  if (assigned(fAIEP) and assigned(fAIEP.AttachedIEBitmap)) or (csDesigning in ComponentState) then
  begin
    if csDesigning in ComponentState then
    begin
      SetLength(Hist, 256);
      for i := 0 to 255 do
      begin
        Hist[i].r := GetRandom;
        Hist[i].g := GetRandom;
        Hist[i].b := GetRandom;
        Hist[i].Gray := GetRandom;
        Hist[i].Hue := GetRandom;
      end;
      UpdateFromHistogram(Hist);
    end
    else
    if Assigned( fAIEP.AttachedImageEn ) and ( fAIEP.AttachedImageEn is TImageEnView ) and
       TImageEnView( fAIEP.AttachedImageEn ).IsEmpty2 then
      Clear()
    else
    begin
      Hist := fAIEP.GetHistogram(ConvHistKindToHistContent(fHistKind));
      UpdateFromHistogram(Hist);
    end;
  end;
end;


{!!
<FS>THistogramBox.UpdateFromHistogram

<FM>Declaration<FC>
procedure UpdateFromHistogram(Histogram: <A TIEHistogram>);

<FM>Description<FN>
Updates content from the specified histogram.
!!}
procedure THistogramBox.UpdateFromHistogram(Histogram: TIEHistogram);
const
  Horz_Text_Margin = 4;
var
  MaxV: dword;
  q, w, e, dv: integer;
  dx, dy, x1: integer;
  xx: integer;
  sz: TSize;
  compdy: integer;
  px: pRGBROW;
  CVS: TIECanvas;
  histlen: integer;
  rgb: TRGB;
  Offset: Integer;

  function ScaleValue(Value: integer): integer;
  begin
    case fScale of
      iehsLinear,
      iehsLinearClipped:
        result := round(Value / MaxV * dy);
      iehsLogarithmic:
        result := round( ln(1 + Value) / ln(1 + MaxV) * dy );
      else
        result := 0;
    end;
  end;

  function IEHistogramItem(R, G, B, Gray, Hue: DWORD): THistogramItem;
  begin
    result.R := R;
    result.G := G;
    result.B := B;
    result.Gray := Gray;
    result.Hue := Hue;
  end;

  function CountOutBins(): integer;
  var
    i: integer;
  begin
    result := 0;
    for i := 0 to histlen - 1 do
    begin
      if (hkRed in fHistKind) and (Histogram[i].r > MaxV) then
        inc(result)
      else if (hkGreen in fHistKind) and (Histogram[i].g > MaxV) then
        inc(result)
      else if (hkBlue in fHistKind) and (Histogram[i].b > MaxV) then
        inc(result)
      else if (hkGray in fHistKind) and (Histogram[i].Gray > MaxV) then
        inc(result)
      else if (hkHue in fHistKind) and (Histogram[i].Hue > MaxV) then
        inc(result);
    end;
  end;

  procedure CalcMax();
  var
    i: integer;
    j: dword;
    hmax, htot, hcnt: THistogramItem;
    vmax, vtot, vcnt: dword;
  begin
    MaxV := 0;

    hmax := IEHistogramItem(0, 0, 0, 0, 0);
    htot := hmax;
    hcnt := hmax;

    for i := 0 to histlen - 1 do
    begin
      if hkRed in fHistKind then
      begin
        if Histogram[i].R > hmax.R then
          hmax.R := Histogram[i].R;
        if Histogram[i].R > 0 then
          inc(hcnt.R);
        inc(htot.R, Histogram[i].R);
      end;
      if hkGreen in fHistKind then
      begin
        if Histogram[i].G > hmax.G then
          hmax.G := Histogram[i].G;
        if Histogram[i].G > 0 then
          inc(hcnt.G);
        inc(htot.G, Histogram[i].G);
      end;
      if hkBlue in fHistKind then
      begin
        if Histogram[i].B > hmax.B then
          hmax.B := Histogram[i].B;
        if Histogram[i].B > 0 then
          inc(hcnt.B);
        inc(htot.B, Histogram[i].B);
      end;
      if hkGray in fHistKind then
      begin
        if Histogram[i].Gray > hmax.Gray then
          hmax.Gray := Histogram[i].Gray;
        if Histogram[i].Gray > 0 then
          inc(hcnt.Gray);
        inc(htot.Gray, Histogram[i].Gray);
      end;
      if hkHue in fHistKind then
      begin
        if Histogram[i].Hue > hmax.Hue then
          hmax.Hue := Histogram[i].Hue;
        if Histogram[i].Hue > 0 then
          inc(hcnt.Hue);
        inc(htot.Hue, Histogram[i].Hue);
      end;
    end;

    vmax := imax(hmax.R, imax(hmax.G, imax(hmax.B, imax(hmax.Gray, hmax.Hue))));
    vcnt := imax(hcnt.R, imax(hcnt.G, imax(hcnt.B, imax(hcnt.Gray, hcnt.Hue))));
    vtot := imax(htot.R, imax(htot.G, imax(htot.B, imax(htot.Gray, htot.Hue))));

    if (fScale = iehsLinearClipped) and (vtot <> 0) then
    begin
      j := 3;
      repeat
        MaxV := imin(vmax, j * vtot div vcnt);
        inc(j);
      until CountOutBins() < 4;
      if (vmax - MaxV) / vtot < 0.05 then // ignore clip if difference is less than 5%
        MaxV := vmax;
    end
    else
      MaxV := vmax;

  end;

begin
  Bitmap.Canvas.Brush.Color := fBackground;

  if Bitmap.Width = 1 then
  begin
    bitmap.Width := width;
    bitmap.Height := height;
  end;
  Bitmap.Canvas.FillRect(rect(0, 0, Bitmap.Width, Bitmap.Height));

  CVS := TIECanvas.Create(Bitmap.Canvas, true, true);
  try
    CVS.Brush.Color := fBackground;
    CVS.Pen.Color := fBackground;
    CVS.Pen.Style := psSolid;

    histlen := length(Histogram);

    CalcMax();

    if histlen > 0 then
    begin
      if ((GetParentForm(self) <> nil) or (ParentWindow <> 0)) and HandleAllocated then
      begin
        dx := ClientWidth;
        dy := ClientHeight;
      end
      else
      begin
        // client size still not available
        dx := Width;
        dy := Height;
      end;
      x1 := 0;
      compdy := trunc(abs(Font.Height) * 1.2);
      if fCompBar then
        dec(dy, compdy + 2);
      // LABELS
      if (hlVertical in fLabels) then
      begin
        // paint vertical axis with labels
        CVS.Font.Assign( Font );
        sz := CVS.TextExtent( WideString(IEIntToFormattedStr( MaxV, 3 )) );
        if MaxV div 2 < MaxV then
          CVS.TextOut(0, dy div 2 - sz.cy div 2, string(IEIntToFormattedStr(  MaxV div 2, 3 )) );
        CVS.TextOut(0, 0, string(IEIntToFormattedStr( MaxV, 3 )) );
        CVS.Pen.Color := Font.Color;
        dec(dx, sz.cx + Horz_Text_Margin);
        inc(x1, sz.cx + Horz_Text_Margin);
      end;
      if (hlHorizontal in fLabels) then
      begin
        // paint horizontal axis with labels
        CVS.Font.Assign( Font );
        sz := CVS.TextExtent(IntToStr(MaxV));
        dv := histlen div 4;
        for q := 0 to 3 do
          CVS.TextOut(x1 + round(((q * dv) / histlen) * dx), dy - abs(Font.Height) - 1, IntToStr(q * dv));
        q := CVS.TextWidth(IntToStr(histlen - 1));
        CVS.TextOut(x1 + dx - q, dy - abs(Font.Height) - 1, IntToStr(histlen - 1));
        dec(dy, sz.cy + 2);
        // axis
        CVS.MoveTo(x1 - 1, 0);
        CVS.LineTo(x1 - 1, dy);
        CVS.LineTo(x1 + dx, dy);
      end;
      //
      fHistogramAbsXPos := x1;
      // COMPBAR
      if fCompBar then
      begin
        for w := 0 to compdy - 1 do
        begin // row
          px := bitmap.ScanLine[bitmap.height - w - 1];
          for q := 0 to dx - 1 do
          begin
            px^[x1 + q].r := 0;
            px^[x1 + q].g := 0;
            px^[x1 + q].b := 0;
            e := round(q / dx * 256);
            if (hkRed in fHistKind) or (hkGray in fHistKind) then
              px^[x1 + q].r := e;
            if (hkGreen in fHistKind) or (hkGray in fHistKind) then
              px^[x1 + q].g := e;
            if (hkBlue in fHistKind) or (hkGray in fHistKind) then
              px^[x1 + q].b := e;
            if fHistKind = [hkHue] then
            begin
              HSV2RGB(px^[x1 + q], trunc(e / histlen * 360), 99, 50);
            end;
          end;
        end;
      end;

      Offset := 0;
      if fHistogramStyle = hsFilledLines then
        Offset := -1;
      
      // paint histogram on Bitmap
      // hsBars and hsFilledLines
      if ( MaxV > 0 ) and (( fHistogramStyle = hsBars ) or ( fHistogramStyle = hsFilledLines )) then
        for xx := 0 to dx - 1 do
        begin
          q := trunc(xx / dx * histlen);
          if hkRed in fHistKind then
          begin
            if fHistogramStyle = hsFilledLines then
              CVS.Pen.Color := IEAverageColor( Background, clRed )
            else
              CVS.Pen.Color := clRed;
            CVS.MoveTo(xx + x1, dy - 1);
            e := ScaleValue(Histogram[q].r);
            if (Histogram[q].r > 0) and (e = 0) then
              e := 1;
            CVS.LineTo(xx + x1, dy - 1 - e - Offset);
          end;
          if hkGreen in fHistKind then
          begin
            if fHistogramStyle = hsFilledLines then
              CVS.Pen.Color := IEAverageColor( Background, clGreen )
            else
              CVS.Pen.Color := clGreen;
            CVS.MoveTo(xx + x1, dy - 1);
            e := ScaleValue(Histogram[q].g);
            if (Histogram[q].g > 0) and (e = 0) then
              e := 1;
            CVS.LineTo(xx + x1, dy - 1 - e - Offset);
          end;
          if hkBlue in fHistKind then
          begin
            if fHistogramStyle = hsFilledLines then
              CVS.Pen.Color := IEAverageColor( Background, clBlue )
            else
              CVS.Pen.Color := clBlue;
            CVS.MoveTo(xx + x1, dy - 1);
            e := ScaleValue(Histogram[q].b);
            if (Histogram[q].b > 0) and (e = 0) then
              e := 1;
            CVS.LineTo(xx + x1, dy - 1 - e - Offset);
          end;
          if hkGray in fHistKind then
          begin
            if fHistogramStyle = hsFilledLines then
              CVS.Pen.Color := IEAverageColor( Background, fGrayColor )
            else
              CVS.Pen.Color := fGrayColor;
            CVS.MoveTo(xx + x1, dy - 1);
            e := ScaleValue(Histogram[q].Gray);
            if (Histogram[q].Gray > 0) and (e = 0) then
              e := 1;
            CVS.LineTo(xx + x1, dy - 1 - e - Offset);
          end;
          if hkHue in fHistKind then
          begin
            HSV2RGB(rgb, trunc(q / histlen * 360), 99, 50);                
            if fHistogramStyle = hsFilledLines then
              CVS.Pen.Color := IEAverageColor( Background, TRGB2TCOLOR(rgb) )
            else
              CVS.Pen.Color := TRGB2TCOLOR(rgb);
            CVS.MoveTo(xx + x1, dy - 1);
            e := ScaleValue(Histogram[q].Hue);
            if (Histogram[q].Hue > 0) and (e = 0) then
              e := 1;
            CVS.LineTo(xx + x1, dy - 1 - e - Offset);
          end;
        end;

      // hsLines and hsFilledLines
      if ( MaxV > 0 ) and (( fHistogramStyle = hsLines ) or ( fHistogramStyle = hsFilledLines )) then
      begin
        if hkRed in fHistKind then
        begin
          CVS.Pen.Color := clRed;
          CVS.MoveTo(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * histlen);
            CVS.LineTo(xx + x1, dy - 1 - ScaleValue(Histogram[q].r) + 1);
          end;
        end;
        if hkGreen in fHistKind then
        begin
          CVS.Pen.Color := clGreen;
          CVS.MoveTo(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * histlen);
            CVS.LineTo(xx + x1, dy - 1 - ScaleValue(Histogram[q].g) + 1);
          end;
        end;
        if hkBlue in fHistKind then
        begin
          CVS.Pen.Color := clBlue;
          CVS.MoveTo(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * histlen);
            CVS.LineTo(xx + x1, dy - 1 - ScaleValue(Histogram[q].b) + 1);
          end;
        end;
        if hkGray in fHistKind then
        begin
          CVS.Pen.Color := fGrayColor;
          CVS.MoveTo(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * histlen);
            CVS.LineTo(xx + x1, dy - 1 - ScaleValue(Histogram[q].Gray) + 1);
          end;
        end;
        if hkHue in fHistKind then
        begin
          CVS.MoveTo(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * histlen);
            HSV2RGB(rgb, trunc(q / histlen * 360), 99, 50);
            CVS.Pen.Color := TRGB2TCOLOR(rgb);
            CVS.LineTo(xx + x1, dy - 1 - ScaleValue(Histogram[q].Hue) + 1);
          end;
        end;
      end;
    end;

  finally
    CVS.Free;
  end;

  invalidate;
end;

procedure THistogramBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = fAIEP) and (Operation = opRemove) then
    fAIEP := nil;
end;


{!!
<FS>THistogramBox.AttachedImageEnProc

<FM>Declaration<FC>
property AttachedImageEnProc: <A TImageEnProc>;

<FM>Description<FN>
Use this property to attach a THistogramBox to a TImageEnProc object.

<FM>Example<FC>
HistogramBox1.AttachedImageEnProc := ImageEnView1.Proc;
HistogramBox1.Update; // now HistogramBox1 will display the histogram of an image attached to ImageEnProc1
!!}
procedure THistogramBox.SetAIEP(v: TImageEnProc);
begin
  fAIEP := v;
  if assigned(fAIEP) then
    fAIEP.FreeNotification(self)
  else
    Clear;  
end;

{!!
<FS>THistogramBox.HistogramKind

<FM>Declaration<FC>
property HistogramKind: <A THistogramKind>;

<FM>Description<FN>
Selects which channels are shown:
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>hkRed</C> <C>Red channel</C> </R>
<R> <C>hkGreen</C> <C>Green channel</C> </R>
<R> <C>hkBlue</C> <C>Blue channel</C> </R>
<R> <C>hkGray</C> <C>Gray-scale level</C> </R>
<R> <C>hkHue</C> <C>Hue (of HSV values)</C> </R>
</TABLE>

!!}
function THistogramBox.GetHistogramKind: THistogramKind;
begin
  result := fHistKind;
end;


{!!
<FS>THistogramBox.Labels

<FM>Declaration<FC>
property Labels: <A THistogramLabels>;

<FM>Description<FN>
Specifies which labels (vertical and horizontal) are shown:
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>hlVertical</C> <C>Values are shown along the X axis</C> </R>
<R> <C>hlHorizontal</C> <C>Range is shown along the Y axis</C> </R>
</TABLE>

Default: [hlVertical, hlHorizontal];
!!}
function THistogramBox.GetLabels: THistogramLabels;
begin
  result := fLabels;
end;


{!!
<FS>THistogramBox.MinSelected

<FM>Declaration<FC>
property MinSelected: Integer;

<FM>Description<FN>
If <A THistogramBox.MouseInteract> = <FC>mhSelectRange<FN> then <FC>MinSelected<FN> and <A THistogramBox.MaxSelected> specify the range of returned values.
If <A THistogramBox.MouseInteract> = <FC>mhSelectValue<FN> then <FC>MinSelected<FN> and <A THistogramBox.MaxSelected> return the same value.

Note: This valid range of <FC>MinSelected<FN> will depend on <A THistogramBox.HistogramKind>. If <A THistogramBox.HistogramKind> is <FC>[hkHue]<FN> then the range will be 0 to 359. Otherwise it will be 0 to 255. -1 can also be specified to clear the selection.
              
<FM>Example<FC>
// Select mid-point in color histogram
HistogramBox1.MinSelected := 128;

<FM>See Also<FC>
- <A THistogramBox.MaxSelected>
- <A THistogramBox.SelectionColor>
- <A THistogramBox.MouseInteract>
!!}
function THistogramBox.GetMinSelected: Integer;
begin
  if fMouseMinX < 0 then
    Result := -1
  else
  begin
    if fHistKind = [hkHue] then
      Result :=  MulDiv( 359, fMouseMinX - fHistogramAbsXPos, Width - fHistogramAbsXPos - 1 )
    else
      Result :=  MulDiv( 255, fMouseMinX - fHistogramAbsXPos, Width - fHistogramAbsXPos - 1 );
  end;
end;

procedure THistogramBox.SetMinSelected(const Value: Integer);

begin
  if fMouseMinX = Value then
    exit;

  if Value < 0 then
  begin
    // Deselect
    fMouseMinX := -1;
    fMouseMaxX := -1;
  end
  else
  begin
    if fHistKind = [hkHue] then
      fMouseMinX := fHistogramAbsXPos + MulDiv( Width - fHistogramAbsXPos - 1, Value, 359 )
    else
      fMouseMinX := fHistogramAbsXPos + MulDiv( Width - fHistogramAbsXPos - 1, Value, 255 );

    if fMouseMinX > Width - 1 then
      fMouseMinX := Width - 1;
  end;
  Invalidate;
end;


{!!
<FS>THistogramBox.MaxSelected

<FM>Declaration<FC>
property MaxSelected: Integer;

<FM>Description<FN>
If <A THistogramBox.MouseInteract> = <FC>mhSelectRange<FN> then <A THistogramBox.MinSelected> and <FC>MaxSelected<FN> specify the range of returned values.
If <A THistogramBox.MouseInteract> = <FC>mhSelectValue<FN> then <A THistogramBox.MinSelected> and <FC>MaxSelected<FN> return the same value.

Note: This valid range of <FC>MaxSelected<FN> will depend on <A THistogramBox.HistogramKind>. If <A THistogramBox.HistogramKind> is <FC>[hkHue]<FN> then the range will be 0 to 359. Otherwise it will be 0 to 255. -1 can also be specified to clear the selection.

<FM>Example<FC>
// Select from 100 to 200
HistogramBox1.MouseInteract := mhSelectRange;
HistogramBox1.MinSelected := 100;
HistogramBox1.MaxSelected := 200;

<FM>See Also<FC>
- <A THistogramBox.MinSelected>
- <A THistogramBox.SelectionColor>
- <A THistogramBox.MouseInteract>
!!}
function THistogramBox.GetMaxSelected: Integer;
begin
  If fMouseInteract = mhSelectValue then
    Result := GetMinSelected
  else
  if fMouseMaxX < 0 then
    Result := -1
  else
  begin
    if fHistKind = [hkHue] then
      Result :=  MulDiv( 359, fMouseMaxX - fHistogramAbsXPos, Width - fHistogramAbsXPos - 1 )
    else
      Result :=  MulDiv( 255, fMouseMaxX - fHistogramAbsXPos, Width - fHistogramAbsXPos - 1 );
  end;
end;

procedure THistogramBox.SetMaxSelected(const Value: Integer);
begin
  if fMouseMaxX = Value then
    exit;

  if Value < 0 then
  begin
    // Deselect
    fMouseMinX := -1;
    fMouseMaxX := -1;
  end
  else
  begin
    if fHistKind = [hkHue] then
      fMouseMaxX := fHistogramAbsXPos + MulDiv( Width - fHistogramAbsXPos - 1, Value, 359 )
    else
      fMouseMaxX := fHistogramAbsXPos + MulDiv( Width - fHistogramAbsXPos - 1, Value, 255 );

    if fMouseMaxX > Width - 1 then
      fMouseMaxX := Width - 1;
  end;
  Invalidate;
end;


{!!
<FS>THistogramBox.Scale

<FM>Declaration<FC>
property Scale: <A THistogramScale>;

<FM>Description<FN>
Specifies the histogram plot scale.
Default value is iehsLinear. Use iehsLinearClipped or iehsLogarithmic on images with a heavy background color, which may create flat histograms.

<FM>Example<FC>
// Improve range of histogram display
HistogramBox1.Scale := iehsLinearClipped;
!!}
procedure THistogramBox.SetScale(Value: THistogramScale);
begin
  if fScale <> Value then
  begin
    fScale := Value;
    Update();
  end;
end;


end.