hsvbox.pas

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

      px := bitmap.ScanLine[bitmap.height - row - 1];
      inc(px, SLWIDTH);
      for col := SLWIDTH to SLWIDTH + fBarsDistance - 1 do
      begin
        px^ := bk; // background
        inc(px);
      end;
      HSV2RGB(fo, trunc(sh * row), 99, 99);
      for col := SLWIDTH + fBarsDistance to width - 1 do
      begin
        px^ := fo;
        inc(px);
      end;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// disegna grips barra hue e quadrato valsat

procedure THSVBox.DrawGrips;
var
  x, y: integer;
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
begin
  bitmap.canvas.pen.style := psSolid;
  bitmap.canvas.pen.mode := pmNot;
  bitmap.canvas.Brush.style := bsClear;
  bitmap.canvas.pen.width := 1;
  SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
  if (SLWIDTH > 1) and (bitmap.Height-1<>0) then
  begin
    // hue
    y := round((359 - fHue) / 360 * (bitmap.height - 1));
    bitmap.Canvas.rectangle(SLWIDTH + fBarsDistance, y - 2, width, y + 2);
    // sat/val
    x := round(fSat / 99 * (SLWIDTH - 1));
    y := bitmap.height - round((bitmap.height - 1) * fVal / 99) - 1;
    bitmap.Canvas.rectangle(x - 3, y - 3, x + 3, y + 3);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// movimento mouse

procedure THSVBox.XMouseMove(X, Y: integer);
var
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
  px: TRGB;
begin
  SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
  if SLWIDTH > 1 then
  begin
    if X < SLWIDTH then
    begin
      // quadrato sat/val
      DrawGrips;
      fSat := round(X / (SLWIDTH - 1) * 99);
      fVal := 99 - round(Y / (bitmap.height - 1) * 99);
    end
    else if X >= SLWIDTH + fBarsDistance then
    begin
      // barra hue
      DrawGrips;
      fHue := 359 - round(y / (bitmap.height - 1) * 359);
      DrawValSat;
    end;
    HSV2RGB(px, fHue, fSat, fVal);
    fColor := TRGB2TColor(px);
    fRed := px.r;
    fGreen := px.g;
    fBlue := px.b;
    if Assigned(fOnChange) then
      fOnChange(Self);
    DrawGrips;
    paint;
  end;
end;

{!!
<FS>THSVBox.GetColorAt

<FM>Declaration<FC>
function GetColorAt(x,y:integer):TColor;

<FM>Description<FN>
GetColorAt returns the color at component coordinates x, y. Useful in response to MouseMove event.

!!}
function THSVBox.GetColorAt(x, y: integer): TColor;
var
  s, v: integer;
  px: TRGB;
  SLWIDTH: integer;
begin
  result := fColor;
  SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
  if SLWIDTH>1 then
  begin
    if x < SLWIDTH then
    begin
      s := round(X / (SLWIDTH - 1) * 99);
      v := 99 - round(Y / (bitmap.height - 1) * 99);
      HSV2RGB(px, fHue, s, v);
      result := TRGB2TColor(px);
    end
  end;
end;

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

procedure THSVBox.SetHue(h: integer);
var
  px: TRGB;
begin
  if h < 0 then
    h := 0;
  if h > 359 then
    h := 359;
  DrawGrips;
  fHue := h;
  HSV2RGB(px, fHue, fSat, fVal);
  fColor := TRGB2TColor(px);
  fRed := px.r;
  fGreen := px.g;
  fBlue := px.b;
  DrawValSat;
  DrawGrips;
  paint;
end;

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

procedure THSVBox.SetSat(s: integer);
var
  px: TRGB;
begin
  if s < 0 then
    s := 0;
  if s > 99 then
    s := 99;
  DrawGrips;
  fSat := s;
  HSV2RGB(px, fHue, fSat, fVal);
  fColor := TRGB2TColor(px);
  fRed := px.r;
  fGreen := px.g;
  fBlue := px.b;
  DrawGrips;
  paint;
end;

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

procedure THSVBox.SetVal(v: integer);
var
  px: TRGB;
begin
  if v < 0 then
    v := 0;
  if v > 99 then
    v := 99;
  DrawGrips;
  fVal := v;
  HSV2RGB(px, fHue, fSat, fVal);
  fColor := TRGB2TColor(px);
  fRed := px.r;
  fGreen := px.g;
  fBlue := px.b;
  DrawGrips;
  paint;
end;

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

{!!
<FS>THSVBox.SetRGB

<FM>Declaration<FC>
procedure SetRGB(r, g, b: byte);

<FM>Description<FN>
Sets current color as RGB. 

!!}
procedure THSVBox.SetRGB(r, g, b: byte);
var
  px: TRGB;
begin
  DrawGrips;
  fRed := r;
  fGreen := g;
  fBlue := b;
  px := creatergb(fRed, fGreen, fBlue);
  RGB2HSV(px, fHue, fSat, fVal);
  fColor := TRGB2TColor(px);
  DrawValSat;
  DrawGrips;
  paint;
end;

/////////////////////////////////////////////////////////////////////////////////////
// movimento mouse

procedure THSVBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
begin
  inherited;
  //
  if MouseCapture then
  begin
    SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
    if SLWIDTH > 0 then
    begin
      if x < 0 then
        x := 0;
      if y < 0 then
        y := 0;
      if y >= bitmap.height then
        y := bitmap.height - 1;
      if fMouseSel = 1 then
      begin
        if x >= SLWIDTH then
          x := SLWIDTH - 1;
        XMouseMove(x, y);
      end
      else if fMouseSel = 2 then
      begin
        if x < SLWIDTH + fBarsDistance then
          x := SLWIDTH + fBarsDistance
        else if x >= bitmap.width then
          x := bitmap.width - 1;
        XMouseMove(x, y);
      end;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// pressione di un bottone del mouse

procedure THSVBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
begin
  inherited;
  if (Button = mbLeft) then
  begin
    SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
    if SLWIDTH > 0 then
    begin
      if x < SLWIDTH then
      begin
        fMouseSel := 1; // capture val/sat
        XMouseMove(x, y);
      end
      else if x >= SLWIDTH + fBarsDistance then
      begin
        fMouseSel := 2; // capture hue
        XMouseMove(x, y);
      end
      else
        fMouseSel := 0; // nessun capture
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// rilascio mouse
// fMouseSel 0=niente  1=capture su sat/val  2=capture su hue

procedure THSVBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  fMouseSel := 0;
end;

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

{!!
<FS>THSVBox.SetColor

<FM>Declaration<FC>
procedure SetColor(cl: TColor);

<FM>Description<FN>
Sets current color as TColor.

!!}
procedure THSVBox.SetColor(cl: TColor);
var
  rgb: TRGB;
begin
  DrawGrips;
  rgb := TColor2TRGB(cl);
  fRed := rgb.r;
  fGreen := rgb.g;
  fBlue := rgb.b;
  RGB2HSV(rgb, fHue, fSat, fVal);
  fColor := cl;
  DrawValSat;
  DrawGrips;
  paint;
end;

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

{!!
<FS>THSVBox.HueBarWidth

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

<FM>Description<FN>
HueBarWidth specifies the width of the Hue bar. Set this value to 0 to remove the Hue bar (right bar).

<FM>Example<FC>

HSVBox1.HueBarWidth:=0;  // removes Hue bar
!!}
procedure THSVBox.SetHueBarWidth(v: integer);
begin
  if v >= 0 then
  begin
    fHueBarWidth := v;
    DrawHue;
    DrawValSat;
    DrawGrips;
    invalidate;
  end;
end;

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

{!!
<FS>THSVBox.BarsDistance

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

<FM>Description<FN>
BarsDistance specifies the distance of Hue bar from color box (left box).

<FM>Example<FC>

HSVBox1.BarsDistance:=0;	// removes distance from color bar and hue bar
!!}
procedure THSVBox.SetBarsDistance(v: integer);
begin
  if v >= 0 then
  begin
    fBarsDistance := v;
    DrawHue;
    DrawValSat;
    DrawGrips;
    invalidate;
  end;
end;

end.