histogrambox.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

    Update;
  end;
end;

{!!
<FS>THistogramBox.HistogramStyle

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

<FM>Description<FN>
Specifies if the histogram is displayed as lines or vertical bars.
!!}
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;

/////////////////////////////////////////////////////////////////////////////////////
// ricostruisce l'istogramma in base alla selezione corrente

procedure THistogramBox.Update;
var
  MaxV: dword; // massimo valore tra r,g,b,gray (max valore verticale)
  q, w, e: integer;
  PHist: PHistogram;
  dx, dy, x1: integer;
  xx: integer;
  sz: TSize;
  compdy: integer;
  px: pRGBROW;
begin
  bitmap.Canvas.Brush.Color := fBackground;
  bitmap.canvas.fillrect(rect(0, 0, bitmap.width, bitmap.height));
  if (assigned(fAIEP) and assigned(fAIEP.AttachedIEBitmap)) or (csDesigning in ComponentState) then
  begin
    new(pHist);
    if csDesigning in ComponentState then
      for q := 0 to 255 do
      begin
        pHist^[q].r := random(256);
        pHist^[q].g := random(256);
        pHist^[q].b := random(256);
        pHist^[q].Gray := random(256);
      end
    else
      fAIEP.GetHistogram(pHist);
    // trova massimo valore nell'istogramma
    MaxV := 0;
    for q := 0 to 255 do
    begin
      if (hkRed in fHistKind) and (PHist^[q].r > MaxV) then
        MaxV := PHist^[q].r;
      if (hkGreen in fHistKind) and (PHist^[q].g > MaxV) then
        MaxV := PHist^[q].g;
      if (hkBlue in fHistKind) and (PHist^[q].b > MaxV) then
        MaxV := PHist^[q].b;
      if (hkGray in fHistKind) and (PHist^[q].Gray > MaxV) then
        MaxV := PHist^[q].Gray;
    end;
    if MaxV > 0 then
    begin
      dx := width;
      dy := height;
      x1 := 0;
      compdy := trunc(abs(Font.Height) * 1.2);
      if fCompBar then
        dec(dy, compdy + 2);
      // LABELS
      if (hlVertical in fLabels) then
      begin
        // disegna asse verticale con numerazioni
        bitmap.canvas.font := Font;
        //sz:=bitmap.canvas.textextent(inttostr(MaxV));
        if assigned(fAIEP) and assigned(fAIEP.AttachedIEBitmap) then
          sz := bitmap.canvas.textextent(inttostr(fAIEP.AttachedIEBitmap.Width * fAIEP.AttachedIEBitmap.Height))
        else
          sz := bitmap.canvas.textextent(inttostr(MaxV));
        bitmap.canvas.TextOut(0, dy div 2, inttostr(MaxV div 2));
        bitmap.canvas.TextOut(0, 0, inttostr(MaxV));
        bitmap.canvas.pen.Color := Font.Color;
        dec(dx, sz.cx + 2);
        inc(x1, sz.cx + 2);
      end;
      if (hlHorizontal in fLabels) then
      begin
        // disegna asse orizzontale con numerazioni
        bitmap.canvas.font := Font;
        if assigned(fAIEP) and assigned(fAIEP.AttachedIEBitmap) then
          sz := bitmap.canvas.textextent(inttostr(fAIEP.AttachedIEBitmap.Width * fAIEP.AttachedIEBitmap.Height))
        else
          sz := bitmap.canvas.textextent(inttostr(MaxV));
        for q := 0 to 3 do
          bitmap.canvas.TextOut(x1 + round(((q * 64) / 256) * dx), dy - abs(Font.Height) - 1, inttostr(q * 64));
        q := bitmap.canvas.TextWidth('255');
        bitmap.canvas.TextOut(x1 + dx - q, dy - abs(Font.Height) - 1, '255');
        dec(dy, sz.cy + 2);
        // assi
        bitmap.Canvas.MoveTo(x1 - 1, 0);
        bitmap.Canvas.LineTo(x1 - 1, dy);
        bitmap.Canvas.LineTo(x1 + dx, dy);
      end;
      //
      fHistogramXPos := Left + 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;
          end;
        end;
      end;
      // disegna istogramma su Bitmap
      // hsBars
      if fHistogramStyle = hsBars then
        for xx := 0 to dx - 1 do
        begin
          q := trunc(xx / dx * 256);
          if hkRed in fHistKind then
          begin
            bitmap.canvas.pen.color := clRed;
            bitmap.canvas.MoveTo(xx + x1, dy - 1);
            e := round((PHist^[q].r / MaxV) * dy);
            if (PHist^[q].r > 0) and (e = 0) then
              e := 1;
            bitmap.canvas.LineTo(xx + x1, dy - 1 - e);
          end;
          if hkGreen in fHistKind then
          begin
            bitmap.canvas.pen.color := clGreen;
            bitmap.canvas.MoveTo(xx + x1, dy - 1);
            e := round((PHist^[q].g / MaxV) * dy);
            if (PHist^[q].g > 0) and (e = 0) then
              e := 1;
            bitmap.canvas.LineTo(xx + x1, dy - 1 - e);
          end;
          if hkBlue in fHistKind then
          begin
            bitmap.canvas.pen.color := clBlue;
            bitmap.canvas.MoveTo(xx + x1, dy - 1);
            e := round((PHist^[q].b / MaxV) * dy);
            if (PHist^[q].b > 0) and (e = 0) then
              e := 1;
            bitmap.canvas.LineTo(xx + x1, dy - 1 - e);
          end;
          if hkGray in fHistKind then
          begin
            bitmap.canvas.pen.color := fGrayColor;
            bitmap.canvas.MoveTo(xx + x1, dy - 1);
            e := round((PHist^[q].Gray / MaxV) * dy);
            if (PHist^[q].Gray > 0) and (e = 0) then
              e := 1;
            bitmap.canvas.LineTo(xx + x1, dy - 1 - e);
          end;
        end;
      // hsLines
      if fHistogramStyle = hsLines then
      begin
        if hkRed in fHistKind then
        begin
          bitmap.canvas.pen.color := clRed;
          bitmap.canvas.moveto(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * 256);
            bitmap.canvas.LineTo(xx + x1, dy - 1 - round((PHist^[q].r / MaxV) * dy) + 1);
          end;
        end;
        if hkGreen in fHistKind then
        begin
          bitmap.canvas.pen.color := clGreen;
          bitmap.canvas.moveto(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * 256);
            bitmap.canvas.LineTo(xx + x1, dy - 1 - round((PHist^[q].g / MaxV) * dy) + 1);
          end;
        end;
        if hkBlue in fHistKind then
        begin
          bitmap.canvas.pen.color := clBlue;
          bitmap.canvas.moveto(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * 256);
            bitmap.canvas.LineTo(xx + x1, dy - 1 - round((PHist^[q].b / MaxV) * dy) + 1);
          end;
        end;
        if hkGray in fHistKind then
        begin
          bitmap.canvas.pen.color := fGrayColor;
          bitmap.canvas.moveto(x1, dy - 1);
          for xx := 0 to dx - 1 do
          begin
            q := trunc(xx / dx * 256);
            bitmap.canvas.LineTo(xx + x1, dy - 1 - round((PHist^[q].Gray / MaxV) * dy) + 1);
          end;
        end;
      end;
    end;
    //
    dispose(pHist);
  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 if you want to attach THistogramBox to a TImageEnProc object.


<FM>Example<FC>

HistogramBox1.AttachedImageEnProc:=ImageEnProc1;
HistogramBox1.Update; // now HistogramBox1 display the histogram of image attached to ImageEnProc1
!!}
procedure THistogramBox.SetAIEP(v: TImageEnProc);
begin
  fAIEP := v;
  if assigned(fAIEP) then
    fAIEP.FreeNotification(self);
end;

{!!
<FS>THistogramBox.HistogramKind

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

<FM>Description<FN>
Selects which channels are shown.

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

{!!
<FS>THistogramBox.Labels

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

<FM>Description<FN>
Labels sets which labels (vertical and horizontal) are shown.
!!}
function THistogramBox.GetLabels: THistogramLabels;
begin
  result := fLabels;
end;

end.