hsvbox.pas

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

(*
Copyright (c) 1998-2007 by HiComponents. All rights reserved.

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.

HiComponents grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

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

email: [e-mail]

http://www.hicomponents.com
*)

unit hsvbox;

{$R-}
{$Q-}

{$I ie.inc}

interface

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

type

{!!
<FS>THSVBox

<FM>Description<FN>
THSVBox allows selection of a color in the HSV (Hue Saturation Value) color space.

<FM>Properties<FN>

  <A THSVBox.Background>
  <A THSVBox.BarsDistance>
  <A THSVBox.Blue>
  <A THSVBox.Color>
  <A THSVBox.Green>
  <A THSVBox.HueBarWidth>
  <A THSVBox.Hue>
  <A THSVBox.Red>
  <A THSVBox.Sat>
  <A THSVBox.Val>

<FM>Methods<FN>

  <A THSVBox.GetColorAt>
  <A THSVBox.SetColor>
  <A THSVBox.SetRGB>

<FM>Events<FN>

  <A THSVBox.OnChange>
!!}
  THSVBox = class(TCustomControl)
  private
    { Private declarations }
    fHue: integer; // da 0 a 359
    fSat: integer; // da 0 a 99
    fVal: integer; // da 0 a 99
    fRed: byte;
    fGreen: byte;
    fBlue: byte;
    bitmap: TBitMap;
    fBackground: TColor;
    fOnChange: TNotifyEvent;
    fMouseSel: integer; // 0=niente  1=capture su sat/val  2=capture su hue
    fColor: TColor;
    fHueBarWidth: integer;
    fBarsDistance: integer;
  protected
    { Protected declarations }
    procedure SetHue(h: integer);
    procedure SetSat(s: integer);
    procedure SetVal(v: integer);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure SetBackground(bk: TColor);
    procedure DrawValSat;
    procedure DrawHue;
    procedure DrawGrips;
    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 XMouseMove(X, Y: integer);
    procedure SetHueBarWidth(v: integer);
    procedure SetBarsDistance(v: integer);
  public
    { Public declarations }
    procedure Paint; override;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure SetRGB(r, g, b: byte);
    procedure SetColor(cl: TColor);
    function GetColorAt(x, y: integer): TColor;
  published
    { Published declarations }

{!!
<FS>THSVBox.Hue

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

<FM>Description<FN>
Hue channel of the current color.
!!}
    property Hue: integer read fHue write SetHue default 0; // da 0 a 359

{!!
<FS>THSVBox.Sat

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

<FM>Description<FN>
Saturation channel of the current color.
!!}
    property Sat: integer read fSat write SetSat default 0; // da 0 a 99

{!!
<FS>THSVBox.Val

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

<FM>Description<FN>
Value channel of the current color.
!!}
    property Val: integer read fVal write SetVal default 0; // da 0 a 99

{!!
<FS>THSVBox.Red

<FM>Declaration<FC>
property Red: byte;

<FM>Description<FN>
Red channel of the conversion from current HSV color to RGB.

Read-only
!!}
    property Red: byte read fRed; // ATN!! IT MUST BE READ-ONLY!!

{!!
<FS>THSVBox.Green

<FM>Declaration<FC>
property Green: byte;

<FM>Description<FN>
Green channel of the conversion from current HSV color to RGB.

Read-only
!!}
    property Green: byte read fGreen; // ATN!! IT MUST BE READ-ONLY!!

{!!
<FS>THSVBox.Blue

<FM>Declaration<FC>
property Blue: byte;

<FM>Description<FN>
Blue channel of the conversion from current HSV color to RGB.

Read-only
!!}
    property Blue: byte read fBlue; // ATN!! IT MUST BE READ-ONLY!!

{!!
<FS>THSVBox.Color

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

<FM>Description<FN>
Conversion of current HSV color in TColor.

Read-only
!!}
    property Color: TColor read fColor; // ATN!! IT MUST BE READ-ONLY!!

    property Background: TColor read fBackground write SetBackground default clBtnFace;

{!!
<FS>THSVBox.OnChange

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

<FM>Description<FN>
This event is called whenever a color is changed.
!!}
    property OnChange: TNotifyEvent read fOnChange write fOnChange;

    property HueBarWidth: integer read fHueBarWidth write SetHueBarWidth default 20;
    property BarsDistance: integer read fBarsDistance write SetBarsDistance default 5;
    property Align;
{$IFDEF IESUPPORTANCHORS}
    property Anchors;
{$ENDIF}
    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;
  end;

implementation

uses hyieutils;

{$R-}


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

constructor THSVBox.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  //controlstyle:=controlstyle+[csOpaque];
  ControlStyle := ControlStyle + [csOpaque, csAcceptsControls];
  fHueBarWidth := 20;
  fBarsDistance := 5;
  fOnChange := nil;
  fBackground := clBtnFace;
  fMouseSel := 0; // nessun capture
  Height := 105;
  Width := 105;
  fHue := 0;
  fSat := 0;
  fVal := 0;
  fRed := 0;
  fGreen := 0;
  fBlue := 0;
  fColor := 0;
  bitmap := TBitmap.create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := width;
  bitmap.Height := height;
  DrawHue;
  DrawValSat;
  DrawGrips;
end;

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

destructor THSVBox.Destroy;
begin
  FreeAndNil(bitmap);
  inherited;
end;

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

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

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

procedure THSVBox.WMSize(var Message: TWMSize);
begin
  inherited;
  bitmap.Width := message.Width;
  bitmap.Height := message.Height;
  DrawHue;
  DrawValSat;
  DrawGrips;
  invalidate;
end;

{!!
<FS>THSVBox.Background

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

<FM>Description<FN>
Background is the background color.
!!}
procedure THSVBox.SetBackground(bk: TColor);
begin
  fBackground := bk;
  DrawHue;
  DrawValSat;
  DrawGrips;
  invalidate;
end;

/////////////////////////////////////////////////////////////////////////////////////
// disegna quadrato Sat/val, non invalida

procedure THSVBox.DrawValSat;
var
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
  v: integer;
  ss, sv: single;
  col, row: integer;
  px: pRGB;
begin
  SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
  if (SLWIDTH > 0) and (bitmap.Height>0) then
  begin
    ss := 100 / SLWIDTH;
    sv := 100 / bitmap.height;
    // disegna quadrato Sat/Val
    for row := 0 to bitmap.height - 1 do
    begin
      v := trunc(sv * row);
      px := bitmap.ScanLine[bitmap.height - row - 1];
      for col := 0 to SLWIDTH - 1 do
      begin
        HSV2RGB(px^, fHue, trunc(ss * col), v);
        inc(px);
      end;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// disegna barra hue
// e intermezzo tra barra hue e quadrato

procedure THSVBox.DrawHue;
var
  SLWIDTH: integer; // larghezza in pixel del quadrato Sat/Val
  sh: single;
  col, row: integer;
  px: pRGB;
  bk: TRGB;
  fo: TRGB;
begin
  SLWIDTH := bitmap.width - fBarsDistance - fHueBarWidth;
  if (SLWIDTH > 0) and (Bitmap.Height>0) then
  begin
    sh := 360 / bitmap.height;
    // draws hue bar
    bk := TColor2TRGB(fBackground);
    for row := 0 to bitmap.height - 1 do
    begin