rulerbox.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 rulerbox;

{$R-}
{$Q-}

{$I ie.inc}


interface

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

const
  MAXPOLYGLINES = 10;

type

  TPolyg = array[0..MAXPOLYGLINES - 1] of TPoint;

{!!
<FS>TGripKind

<FM>Declaration<FC>
}
  TGripKind = (gkTriangle, gkLeftTriangle, gkRightTriangle, gkArrow, gkArrow2);
{!!}

{!!
<FS>TGripsDir

<FM>Declaration<FC>
}
  TGripsDir = (gdUp, gdDown);
{!!}

{!!
<FS>TRulerDir

<FM>Declaration<FC>
}
  TRulerDir = (rdHorizontal, rdVertical);
{!!}

{!!
<FS>TRulerPosChangeEvent

<FM>Declaration<FC>
}
  TRulerPosChangeEvent = procedure(Sender: TObject; Grip: integer) of object;
{!!}

{!!
<FS>TRulerGripClickEvent

<FM>Declaration<FC>
}
  TRulerGripClickEvent = procedure(Sender: TObject; Grip: integer) of object;
{!!}

{!!
<FS>TRulerGripDblClickEvent

<FM>Declaration<FC>
}
  TRulerGripDblClickEvent = procedure(Sender: TObject; Grip: integer) of object;
{!!}

{!!
<FS>TRulerClickEvent

<FM>Declaration<FC>
}
  TRulerClickEvent = procedure(Sender: TObject; ps: double) of object;
{!!}

{!!
<FS>TRulerBox

<FM>Description<FN>
TRulerBox is a ruler. It was included in ImageEn for the histogram equalization preview dialog.

<FM>Properties<FN>

  <A TRulerBox.Background>
  <A TRulerBox.DotPerUnit>
  <A TRulerBox.FitInView>
  <A TRulerBox.Frequency>
  <A TRulerBox.GripBaseDim>
  <A TRulerBox.GripsColor>
  <A TRulerBox.GripsCount>
  <A TRulerBox.GripsDir>
  <A TRulerBox.GripsMax>
  <A TRulerBox.GripsMin>
  <A TRulerBox.GripsPos>
  <A TRulerBox.GripsKind>
  <A TRulerBox.HexLabels>
  <A TRulerBox.LabelFreq>
  <A TRulerBox.RulerColor>
  <A TRulerBox.RulerDir>
  <A TRulerBox.Ruler>
  <A TRulerBox.ViewMax>
  <A TRulerBox.ViewMin>
  <A TRulerBox.ViewPos>

<FM>Methods<FN>


<FM>Events<FN>

  <A TRulerBox.OnRulerClick>
  <A TRulerBox.OnRulerGripClick>
  <A TRulerBox.OnRulerGripDblClick>
  <A TRulerBox.OnRulerPosChange>
!!}
  TRulerBox = class(TCustomControl)
  private
    { Private declarations }
    Bitmap: TBitMap;
    fBackground: TColor;
    fGrips: TList; // lista di grips
    fGripBaseDim: integer; // dimensione base dei grip (triangoli)
    fSelGrip: integer; // grip selezionato (-1=nessuno)
    fSelGripSt: integer; // posizione iniziale durante il mouse-dragging
    fMX1, fMY1: integer; // posizioni iniziali del mouse durante il mouse-dragging
    fGripsDir: TGripsDir; // Direzione per tutti i grips
    fRuler: boolean; // rullo + etichette numeriche
    fViewPos: double; // posizione iniziale del righello
    fDPU: double; // DotPerUnit - corrispondenza righello con pixels
    fFrequency: double; // Ogni quante Unit visualizzare una tacca
    fLabelFreq: double; // Ogni quante Unit visualizzare una etichetta
    fRulerColor: TColor; // Colore ruler
    fRulerDir: TRulerDir; // Orientamento ruler
    fViewMin, fViewMax: double; // Max e Min per fViewPos
    fOnRulerPosChange: TRulerPosChangeEvent; // evento
    fOnRulerGripClick: TRulerGripClickEvent; // evento
    fOnRulerGripDblClick: TRulerGripDblClickEvent; // evento
    fOnRulerClick: TRulerClickEvent; // evento
    fFitInView: boolean; // aggiusta fDPU in base a fViewMin e fViewMax
    fHexLabels: boolean; // true visualizza labels in esadecimale
    procedure SetBackground(bk: TColor);
    procedure SetGripsCount(v: integer);
    function GetGripsCount: integer;
    procedure SetGripsPos(i: integer; p: double);
    function GetGripsPos(i: integer): double;
    procedure SetGripsCol(i, p: integer);
    function GetGripsCol(i: integer): integer;
    procedure SetGripBaseDim(v: integer);
    procedure SetGripsKind(i: integer; v: TGripKind);
    function GetGripsKind(i: integer): TGripKind;
    procedure SetGripsDir(v: TGripsDir);
    procedure SetRuler(v: boolean);
    procedure SetViewPos(v: double);
    procedure SetDPU(v: double);
    procedure SetFrequency(v: double);
    procedure SetLabelFreq(v: double);
    procedure SetRulerColor(v: TColor);
    procedure SetRulerDir(v: TRulerDir);
    procedure SetGripsMax(i: integer; v: double);
    procedure SetGripsMin(i: integer; v: double);
    function GetGripsMax(i: integer): double;
    function GetGripsMin(i: integer): double;
    procedure SetViewMin(v: double);
    procedure SetViewMax(v: double);
    procedure SetFitInView(v: boolean);
    function GetWidthInUnit: double;
    procedure SetHexLabels(v: boolean);
  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;
    function GetClickedGrip(x, y: integer): integer;
    procedure GetGripPoly(gn: integer; var poly: TPolyg);
    procedure GetGripRect(gn: integer; var rc: TRect);
    function GetRulerHeight: integer;
    procedure RepaintGrips;
    procedure RepaintRuler;
    function GetXGripPos(gn: integer): integer;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure AdjustGripLimits(gn: integer);
    procedure AdjustViewLimits;
  public
    { Public declarations }
    procedure Paint; override;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    property GripsPos[g: integer]: double read GetGripsPos write SetGripsPos; default;
    property GripsColor[g: integer]: integer read GetGripsCol write SetGripsCol;
    property GripsKind[g: integer]: TGripKind read GetGripsKind write SetGripsKind;
    property GripsMin[g: integer]: double read GetGripsMin write SetGripsMin;
    property GripsMax[g: integer]: double read GetGripsMax write SetGripsMax;
  published
    { Published declarations }
    property ViewPos: double read fViewPos write SetViewPos;
    property Background: TColor read fBackground write SetBackground default clBtnFace;
    property GripBaseDim: integer read fGripBaseDim write SetGripBaseDim default 12;
    property GripsDir: TGripsDir read fGripsDir write SetGripsDir default gdUp;
    property Ruler: boolean read fRuler write SetRuler default true;
    property DotPerUnit: double read fDPU write SetDPU;
    property Frequency: double read fFrequency write SetFrequency;
    property LabelFreq: double read fLabelFreq write SetLabelFreq;
    property RulerColor: TColor read fRulerColor write SetRulerColor default clBtnFace;
    property RulerDir: TRulerDir read fRulerDir write SetRulerDir default rdHorizontal;
    property ViewMin: double read fViewMin write SetViewMin;
    property ViewMax: double read fViewMax write SetViewMax;

{!!
<FS>TRulerBox.OnRulerPosChange

<FM>Declaration<FC>
property OnRulerPosChange: <A TRulerPosChangeEvent>;

<FM>Description<FN>
This event occurs when <A TRulerBox.ViewPos> changes.
!!}
    property OnRulerPosChange: TRulerPosChangeEvent read fOnRulerPosChange write fOnRulerPosChange;

{!!
<FS>TRulerBox.OnRulerGripClick

<FM>Declaration<FC>
property OnRulerGripClick: <A TRulerGripClickEvent>;

<FM>Description<FN>
OnRulerGripClik is called when the user clicks on a grip.
!!}
    property OnRulerGripClick: TRulerGripClickEvent read fOnRulerGripClick write fOnRulerGripClick;

{!!
<FS>TRulerBox.OnRulerGripDblClick

<FM>Declaration<FC>
property OnRulerGripDblClick: <A TRulerGripDblClickEvent>;

<FM>Description<FN>
This event occurs when the user double-click on a grip.
!!}
    property OnRulerGripDblClick: TRulerGripDblClickEvent read fOnRulerGripDblClick write fOnRulerGripDblClick;

{!!
<FS>TRulerBox.OnRulerClick

<FM>Declaration<FC>
property OnRulerClick: <A TRulerClickEvent>;

<FM>Description<FN>
OnRulerClick is called when the user clicks on the ruler.
!!}
    property OnRulerClick: TRulerClickEvent read fOnRulerClick write fOnRulerClick;

    property FitInView: boolean read fFitInView write SetFitInView default false;
    property GripsCount: integer read GetGripsCount write SetGripsCount default 1;
    property HexLabels: boolean read fHexLabels write SetHexLabels default false;
    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 Width default 300;
    property Height default 40;
    property Font;
  end;

implementation

uses hyieutils;

{$R-}

type

  TGrip = record
    Pos: double; // posizione
    Color: TColor; // colore
    Kind: TGripKind; // tipo
    Min: double; // posizione minima
    Max: double; // posizione massima
  end;
  PGrip = ^TGrip;

const
  // numero di punti per ogni tipo di grip
  NumLinesGKind: array[gkTriangle..gkArrow2] of integer = (
    3, // gkTriangle
    3, // gkLeftTriangle
    3, // gkRightTriangle
    7, // gkArrow
    5); // gkArrow2

  DISTRULLAB = 3; // Distanza fra ruler ed etichette

constructor TRulerBox.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  controlstyle := controlstyle + [csOpaque];
  fHexLabels := false;
  fGripsDir := gdUp;
  fBackground := clBtnFace;
  fGripBaseDim := 12;
  fRuler := true;
  fViewPos := 0;
  fDPU := 1;
  fFrequency := 10;
  fLabelFreq := 40;
  fRulerColor := clBtnFace;
  fViewMin := 0;
  fViewMax := 0;
  fOnRulerPosChange := nil;
  fOnRulerGripClick := nil;
  fOnRulerGripDblClick := nil;
  fOnRulerClick := nil;
  fFitInView := false;
  Height := 40;
  Width := 300;
  bitmap := TBitmap.create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := width;
  bitmap.Height := height;
  fGrips := TList.Create;
  SetGripsCount(1);
  fSelGrip := -1;
  Update;
end;

destructor TRulerBox.Destroy;
begin
  FreeAndNil(bitmap);
  while fGrips.Count > 0 do
  begin
    dispose(fGrips[0]);
    fGrips.Delete(0);
  end;
  FreeAndNil(fGrips);
  inherited;
end;

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

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

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

{!!
<FS>TRulerBox.Background

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

<FM>Description<FN>
Background is the background color.
!!}
procedure TRulerBox.SetBackground(bk: TColor);
begin
  fBackground := bk;
  update;
end;

procedure TRulerBox.SetGripsCount(v: integer);
var
  ex, q: integer;
begin
  ex := fGrips.Count;
  if v <> ex then
  begin
    if v < ex then
      // free
      for q := v - 1 downto ex do
        dispose(fGrips[q]);
    //
    fGrips.Count := v;
    // init
    for q := ex to v - 1 do
    begin
      fGrips[q] := new(PGrip);
      // defaults
      PGrip(fGrips[q])^.Pos := 0;
      PGrip(fGrips[q])^.Color := fBackground;
      PGrip(fGrips[q])^.Kind := gkTriangle;
      PGrip(fGrips[q])^.Min := fViewMin;
      PGrip(fGrips[q])^.Max := fViewMax;
    end;
    Update;
  end;
end;

{!!
<FS>TRulerBox.GripsCount

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

<FM>Description<FN>
GripsCount gets/sets number of the grips. 

!!}
function TRulerBox.GetGripsCount: integer;
begin
  result := fGrips.Count;
end;

procedure TRulerBox.SetGripsPos(i: integer; p: double);
begin
  if (i < fGrips.Count) then
  begin
    PGrip(fGrips[i])^.Pos := p;
    AdjustGripLimits(i);
    if assigned(fOnRulerPosChange) then
      fOnRulerPosChange(self, i);
    Update;
    Paint;
  end;
end;

{!!
<FS>TRulerBox.GripsPos

<FM>Declaration<FC>
property GripsPos[g:integer]: double;

<FM>Description<FN>
GripsPos is the current position of the grip g.
!!}
function TRulerBox.GetGripsPos(i: integer): double;
begin
  if i < fGrips.Count then
    result := PGrip(fGrips[i])^.Pos
  else
    result := 0;
end;

{!!
<FS>TRulerBox.GripsColor

<FM>Declaration<FC>
property GripsColor[g:integer]: integer;

<FM>Description<FN>
GripsColor sets color of the grip g.

!!}
procedure TRulerBox.SetGripsCol(i, p: integer);
begin
  if i < fGrips.Count then
  begin
    PGrip(fGrips[i])^.Color := p;
    Update;
  end;
end;

function TRulerBox.GetGripsCol(i: integer): integer;
begin
  if i < fGrips.Count then
    result := PGrip(fGrips[i])^.Color
  else
    result := 0;
end;

{!!
<FS>TRulerBox.GripBaseDim

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

<FM>Description<FN>
Base of the grip triangles in pixels.
!!}
procedure TRulerBox.SetGripBaseDim(v: integer);
begin
  fGripBaseDim := v;
  Update;
end;

procedure TRulerBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) then
  begin
    fSelGrip := GetClickedGrip(x, y);
    fMX1 := X;
    fMY1 := Y;
    if fSelGrip >= 0 then
    begin
      if (ssDouble in Shift) and assigned(fOnRulerGripDblClick) then
        fOnRulerGripDblClick(Self, fSelGrip);
      fSelGripSt := GetXGripPos(fSelGrip);
    end
    else
    begin
      if assigned(fOnRulerClick) then
        fOnRulerClick(self, X / fDPU + fViewPos);
    end;
  end;
end;

procedure TRulerBox.SetGripsKind(i: integer; v: TGripKind);
begin
  if i < fGrips.Count then
    PGrip(fGrips[i])^.Kind := v;
  Update;
end;

{!!
<FS>TRulerBox.GripsKind

<FM>Declaration<FC>
property GripsKind[g:integer]: <A TGripKind>;

<FM>Description<FN>
GripsKind is the kind of the grip g (triangle, arrow, etc).

!!}
function TRulerBox.GetGripsKind(i: integer): TGripKind;
begin
  result := gkTriangle; // default
  if i < fGrips.Count then
    result := PGrip(fGrips[i])^.Kind;
end;

// rest. -1=nessuno
function TRulerBox.GetClickedGrip(x, y: integer): integer;
var
  q: integer;
  rc: TRect;
begin
  result := -1;
  for q := fGrips.Count - 1 downto 0 do
  begin
    GetGripRect(q, rc);
    if PtInRect(rc, Point(x, y)) then
    begin
      result := q;
      break;
    end;
  end;
end;

// restituisce il rettangolo in cui