cdibdial.pas

Delphi控件

unit cDIBDial;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, cDIBImageList,
  cDIBControl, cDIB;

const
  DHT_NONE = 0;
  DHT_POINTER = 1;
  DHT_SMALLCHANGEDOWN = 2;
  DHT_SMALLCHANGEUP = 3;
  DHT_PAGECHANGEDOWN = 4;
  DHT_PAGECHANGEUP = 5;
  DHT_USER = 6;

type
  EDIBDialError = class(EDIBControlError);
  TDIBDialMouseControlStyle = (mcsCircular, mcsLinear);
  TDIBDialMouseLinearSensitivity = (mlsVertical, mlsHorizontal, mlsBoth);


  TDIBDialSettings = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
  private
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  protected
    procedure Changed;
  public
    constructor Create; virtual;
  end;

  TCustomDIBDialPointerAngles = class(TDIBDialSettings)
  private
    FResolution: Extended;
    FStart: Integer;
    FRange: Integer;
    procedure SetRange(const Value: Integer);
    procedure SetResolution(const Value: Extended);
    procedure SetStart(const Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    property Start: Integer read FStart write SetStart default 0;
    property Range: Integer read FRange write SetRange default 360;
    property Resolution: Extended read FResolution write SetResolution;
  public
    constructor Create; override;
  end;

  TCustomDIBDialPointerOpacities = class(TDIBDialSettings)
  private
    FActive: Byte;
    FNormal: Byte;
    procedure SetActive(const Value: Byte);
    procedure SetNormal(const Value: Byte);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    property Active: Byte read FActive write SetActive default 255;
    property Normal: Byte read FNormal write SetNormal default 255;
  public
    constructor Create; override;
  end;

  TDIBDialPointerAngles = class(TCustomDIBDialPointerAngles)
  published
    property Start;
    property Range;
    property Resolution;
  end;

  TDIBDialPointerOpacities = class(TCustomDIBDialPointerOpacities)
  published
    property Active;
    property Normal;
  end;

  TAbstractDIBDial = class(TCustomDIBControl)
  private
    FPointerAngles: TCustomDIBDialPointerAngles;
    FPointerOpacities: TCustomDIBDialPointerOpacities;
    FPosition: Integer;
    FMin: Integer;
    FMax: Integer;
    FPageSize: Integer;
    FSmallChange: Integer;
    FIndexPointer: TDIBImageLink;
    FIndexMain: TDIBImageLink;
    FOnChange: TNotifyEvent;
    FPointerNumGlyphs: Integer;
    FPointerRotate: Boolean;
    FPointerRadius: Integer;
    FPointerCaptured: Boolean;
    FHorizontalPixelsPerPosition: Extended;
    FVerticalPixelsPerPosition: Extended;
    FMouseControlStyle: TDIBDialMouseControlStyle;
    FMouseLinearSensitivity: TDIBDialMouseLinearSensitivity;
    FMouseDownPosition: Integer;
    FCapturePosition: TPoint;
    function CircularMouseToPosition(X, Y: Integer): Integer;
    function LinearMouseToPosition(X, Y: Integer): Integer;
    procedure SetPointerAngles(const Value: TCustomDIBDialPointerAngles);
    procedure SetPointerOpacities(const Value: TCustomDIBDialPointerOpacities);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure SetPageSize(const Value: Integer);
    procedure SetSmallChange(const Value: Integer);
    procedure SetPointerNumGlyphs(const Value: Integer);
    procedure SetPointerRotate(const Value: Boolean);
    procedure SetPointerRadius(const Value: Integer);
    procedure SetHorizontalPixelsPerPosition(const Value: Extended);
    procedure SetVerticalPixelsPerPosition(const Value: Extended);
  protected
    function CanAutoSize(var Width, Height: Integer): Boolean; override;
    function CreatePointerAngles: TCustomDIBDialPointerAngles; virtual; abstract;
    function CreatePointerOpacities: TCustomDIBDialPointerOpacities; virtual; abstract;
    function PositionToAngle: Integer; virtual; abstract;

    procedure CapturePointer;
    function ConstrainPosition(APosition: Integer): Integer;
    function DialHitTest(X, Y: Integer): Integer; virtual;
    procedure ReleasePointer;
    procedure Changed; virtual;
    function GetPointerRect: TRect;
    function MouseToPosition(X, Y: Integer): Integer; virtual;
    procedure Paint; override;
    procedure ImageChanged(Index: Integer; Operation: TDIBOperation); override;
    procedure SettingsChanged(Sender: TObject); virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    property CapturePosition: TPoint read FCapturePosition;
    property HorizontalPixelsPerPosition: Extended read FHorizontalPixelsPerPosition write SetHorizontalPixelsPerPosition;
    property IndexMain: TDIBImageLink read FIndexMain write FIndexMain;
    property IndexPointer: TDIBImageLink read FIndexPointer write FIndexPointer;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property MouseControlStyle: TDIBDialMouseControlStyle read FMouseControlStyle write FMouseControlStyle default mcsCircular;
    property MouseDownPosition: Integer read FMouseDownPosition;
    property MouseLinearSensitivity: TDIBDialMouseLinearSensitivity read FMouseLinearSensitivity write FMouseLinearSensitivity default mlsBoth;
    property PageSize: Integer read FPageSize write SetPageSize default 1;
    property PointerAngles: TCustomDIBDialPointerAngles read FPointerAngles write SetPointerAngles;
    property PointerNumGlyphs: Integer read FPointerNumGlyphs write SetPointerNumGlyphs default 1;
    property PointerOpacities: TCustomDIBDialPointerOpacities read FPointerOpacities write SetPointerOpacities;
    property PointerRadius: Integer read FPointerRadius write SetPointerRadius default -1;
    property PointerRotate: Boolean read FPointerRotate write SetPointerRotate default False;
    property Position: Integer read FPosition write SetPosition default 0;
    property SmallChange: Integer read FSmallChange write SetSmallChange default 1;
    property VerticalPixelsPerPosition: Extended read FVerticalPixelsPerPosition write SetVerticalPixelsPerPosition;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;

  TCustomDIBDial = class(TAbstractDIBDial)
  private
    function GetPointerAngles: TDIBDialPointerAngles;
    function GetPointerOpacities: TDIBDialPointerOpacities;
    procedure SetPointerAngles(const Value: TDIBDialPointerAngles);
    procedure SetPointerOpacities(const Value: TDIBDialPointerOpacities);
  protected
    function CreatePointerAngles: TCustomDIBDialPointerAngles; override;
    function CreatePointerOpacities: TCustomDIBDialPointerOpacities; override;
    function PositionToAngle: Integer; override;

    property PointerAngles: TDIBDialPointerAngles read GetPointerAngles write SetPointerAngles;
    property PointerOpacities: TDIBDialPointerOpacities read GetPointerOpacities write SetPointerOpacities;
  end;

  TDIBDial = class(TCustomDIBDial)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Accelerator;
    property Align;
    property Anchors;
    property AutoSize;
    property DIBFeatures;
    property DIBImageList;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Hint;
    property HorizontalPixelsPerPosition;
    property IndexMain;
    property IndexPointer;
    property Max;
    property Min;
    property MouseControlStyle;
    property MouseLinearSensitivity;
    property Opacity;
    property PageSize;
    property ParentShowHint;
    property PointerAngles;
    property PointerOpacities;
    property PointerNumGlyphs;
    property PointerRadius;
    property PointerRotate;
    property PopupMenu;
    property Position;
    property ShowHint;
    property SmallChange;
    property DIBTabOrder;
    property Tag;
    property VerticalPixelsPerPosition;
    property Visible;

    {$I WinControlEvents.inc}

    property OnChange;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnstartDrag;
  end;

implementation

{ TDIBDialSettings }

procedure TDIBDialSettings.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

constructor TDIBDialSettings.Create;
begin
  inherited;
end;

{ TCustomDIBDialPointerAngles }

procedure TCustomDIBDialPointerAngles.AssignTo(Dest: TPersistent);
begin
  if Dest is TCustomDIBDialPointerAngles then with TCustomDIBDialPointerAngles(Dest) do
  begin
    FRange := Self.Range;
    FStart := Self.Start;
    FResolution := Self.Resolution;
    Changed; 
  end else
    inherited;
end;

constructor TCustomDIBDialPointerAngles.Create;
begin
  inherited;
  FStart := 0;
  FRange := 360;
  FResolution := 0;
end;

procedure TCustomDIBDialPointerAngles.SetRange(const Value: Integer);
begin
  if (Range < 1) or (Range > 360) then
    raise EDIBDialError.Create('Range must be 1..360');
  FRange := Value;
  if Range > Resolution then Resolution := Range;
  Changed;
end;

procedure TCustomDIBDialPointerAngles.SetResolution(const Value: Extended);
begin
  if (Value < 0) or (Value > Range) then
    raise EDIBDialError.Create('Resolution must be above 0 and less than ' + IntToStr(Range + 1));
  FResolution := Value;
  Changed;
end;

procedure TCustomDIBDialPointerAngles.SetStart(const Value: Integer);
begin
  if (Value < 0) or (Value > 359) then
    raise EDIBDialError.Create('Start must be 0..359');
  FStart := Value;
  Changed;
end;

{ TCustomDIBDialPointerOpacities }

procedure TCustomDIBDialPointerOpacities.AssignTo(Dest: TPersistent);
begin
  if Dest is TCustomDIBDialPointerOpacities then with TCustomDIBDialPointerOpacities(Dest) do
  begin
    FActive := Self.Active;
    FNormal := Self.Normal;
    Changed;
  end else
    inherited;
end;

constructor TCustomDIBDialPointerOpacities.Create;
begin
  inherited;
  FActive := 255;
  FNormal := 255;
end;

procedure TCustomDIBDialPointerOpacities.SetActive(const Value: Byte);
begin
  FActive := Value;
  Changed;
end;

procedure TCustomDIBDialPointerOpacities.SetNormal(const Value: Byte);
begin
  FNormal := Value;
  Changed;
end;

{ TAbstractDIBDial }

function TAbstractDIBDial.CanAutoSize(var Width, Height: Integer): Boolean;
var
  MainDIB: TMemoryDIB;
  PointerDIB: TMemoryDIB;
  BiggestPointerSize: Integer;
  SmallestDimension: Integer;
begin
  Result := False;
  if IndexMain.GetImage(MainDIB) then
  begin
    Width := MainDIB.Width;
    Height := MainDIB.Height;
    if IndexPointer.GetImage(PointerDIB) then
    begin
      if MainDIB.Width < MainDIB.Height then
        SmallestDimension := MainDIB.Width
      else
        SmallestDimension := MainDIB.Height;

      if PointerDIB.Width > PointerDIB.Height then
        BiggestPointerSize := PointerDIB.Width
      else
        BiggestPointerSize := PointerDIB.Height;
      if PointerRadius > 0 then
      begin
        if SmallestDimension < (BiggestPointerSize div 2) + PointerRadius then
          SmallestDimension := (BiggestPointerSize div 2) + PointerRadius;
        if Width < SmallestDimension then Width := SmallestDimension;
        if Height < SmallestDimension then Height := SmallestDimension;
      end;
    end;
    Result := True;
  end;
end;

procedure TAbstractDIBDial.CapturePointer;
begin
  if IsMouseRepeating then StopRepeating;
  FPointerCaptured := True;
  Invalidate;
end;

procedure TAbstractDIBDial.Changed;
begin
  Invalidate;
end;

function TAbstractDIBDial.CircularMouseToPosition(X, Y: Integer): Integer;
var
  Range: Integer;
  Angle: Extended;
begin
  Range := Max - (Min - 1);
  Angle := SafeAngle(RelativeAngle(Width div 2, Height div 2, X, Y) - PointerAngles.Start);
  Result := Round(Angle * Range / PointerAngles.Range);
  if Result > Max then Result := Max;