iswitchrotary.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiSwitchRotary Component                        }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iSwitchRotary;{$endif}
{$ifdef iCLX}unit QiSwitchRotary;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iMath,  iSwitchMultiPosition;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiMath, QiSwitchMultiPosition;{$ENDIF}

type
  TiRotaryStartDegrees       = (irsd000, irsd045, irsd090, irsd135, irsd180, irsd225, irsd270, irsd315);
  TiSwitchRotaryPointerStyle = (isrpsPointer, isrpsRectangle);
  TiRotaryDesiredSpacing     = (irds22p5, irds45, irds90);

  TiSwitchRotary = class(TiSwitchMultiPosition)
  private
    FMouseDownDegrees       : Double;
    FCenterPoint            : TPoint;
    FDegreesStep            : Double;

    FPointerLength          : Integer;
    FPointerHeight          : Integer;
    FPositionLabelAlignment : TiLabelAlignment;
    FPointerStyle           : TiSwitchRotaryPointerStyle;
    FRotationStartDegrees   : TiRotaryStartDegrees;
    FMouseControlStyle      : TiRotaryMouseControlStyle;
    FPointerColor           : TColor;
    FPointerHighLightColor  : TColor;
    FRotationDesiredSpacing : TiRotaryDesiredSpacing;

    function  AngleOffset : Integer;

    procedure SetPointerLength         (const Value: Integer);
    procedure SetPointerHeight         (const Value: Integer);
    procedure SetPositionLabelAlignment(const Value: TiLabelAlignment);
    procedure SetPointerStyle          (const Value: TiSwitchRotaryPointerStyle);
    procedure SetRotationStartDegrees  (const Value: TiRotaryStartDegrees);
    procedure SetMouseControlStyle     (const Value: TiRotaryMouseControlStyle);
    procedure SetPointerColor          (const Value: TColor);
    procedure SetPointerHighLightColor (const Value: TColor);
    procedure SetRotationDesiredSpacing(const Value: TiRotaryDesiredSpacing);
  protected
    procedure SetPositionFromMouse(X, Y : Integer);
    function  GetCenterPoint(Canvas: TCanvas): TPoint;                             override;
    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove(                      Shift: TShiftState; X, Y: Integer); override;
    procedure iDoKillFocus;                                                        override;
    procedure iPaintTo(Canvas: TCanvas);                                           override;
    procedure DrawIndicator         (Canvas: TCanvas; CenterPoint: TPoint; Angle: Double);
    procedure DrawIndicatorPointer  (Canvas: TCanvas; CenterPoint: TPoint; Angle: Double);
    procedure DrawIndicatorRectangle(Canvas: TCanvas; CenterPoint: TPoint; Angle: Double);
    procedure DrawTicks             (Canvas: TCanvas; CenterPoint: TPoint; AngleOffset: Double);
  public
    constructor Create(AOwner: TComponent);  override;
  published
    property PositionLabelAlignment : TiLabelAlignment           read FPositionLabelAlignment write SetPositionLabelAlignment default ilaCenter;
    property RotationStartDegrees   : TiRotaryStartDegrees       read FRotationStartDegrees   write SetRotationStartDegrees   default irsd180;
    property RotationDesiredSpacing : TiRotaryDesiredSpacing     read FRotationDesiredSpacing write SetRotationDesiredSpacing default irds45;
    property PointerLength          : Integer                    read FPointerLength          write SetPointerLength          default 25;
    property PointerHeight          : Integer                    read FPointerHeight          write SetPointerHeight          default 6;
    property PointerStyle           : TiSwitchRotaryPointerStyle read FPointerStyle           write SetPointerStyle           default isrpsPointer;
    property PointerColor           : TColor                     read FPointerColor           write SetPointerColor           default clBtnFace;
    property PointerHighLightColor  : TColor                     read FPointerHighLightColor  write SetPointerHighLightColor  default clBtnHighlight;
    property MouseControlStyle      : TiRotaryMouseControlStyle  read FMouseControlStyle      write SetMouseControlStyle      default irmcsGoto;
    property BackGroundPicture;
    property BackGroundColor;
    property OffsetX;
    property OffsetY;
    property Transparent;
    property PositionLabelMargin default 15;
    property Width               default 100;
    property Height              default 80;
  end;

implementation
//*************************************************************************************************************************************
constructor TiSwitchRotary.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width   := 100;
  Height  := 80;

  FMaximumLabels          := 16;
  FDegreesStep            := 45;

  FPointerLength          := 25;
  FPointerHeight          := 6;
  FPointerColor           := clBtnFace;
  FPointerHighLightColor  := clBtnHighlight;
  FMaxPositionCount       := 8;
  FRotationStartDegrees   := irsd180;
  FRotationDesiredSpacing := irds45;

  PositionLabelMargin     := 15;

  MouseControlStyle       := irmcsGoto;

  CreateBackGroundPicture;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetPositionLabelAlignment(const Value:TiLabelAlignment);          begin if FPositionLabelAlignment<>Value then begin FPositionLabelAlignment:=Value;BackGroundChange;end;end;
procedure TiSwitchRotary.SetPointerStyle          (const Value:TiSwitchRotaryPointerStyle);begin if FPointerStyle          <>Value then begin FPointerStyle          :=Value;BackGroundChange;end;end;
procedure TiSwitchRotary.SetRotationStartDegrees  (const Value:TiRotaryStartDegrees);      begin if FRotationStartDegrees  <>Value then begin FRotationStartDegrees  :=Value;BackGroundChange;end;end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetPointerColor          (const Value: TColor);begin SetColorProperty(Value, FPointerColor,          irtBackGround);end;
procedure TiSwitchRotary.SetPointerHighLightColor (const Value: TColor);begin SetColorProperty(Value, FPointerHighLightColor, irtBackGround);end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetPointerLength(const Value:Integer);
begin
  if FPointerLength <> Value then
    begin
      FPointerLength := Value;
      if FPointerHeight > FPointerLength then FPointerLength := FPointerHeight;
      BackGroundChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetPointerHeight(const Value:Integer);
begin
  if FPointerHeight <> Value then
    begin
      FPointerHeight := Value;
      if FPointerHeight > FPointerLength then FPointerLength := FPointerHeight;
      BackGroundChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetMouseControlStyle(const Value: TiRotaryMouseControlStyle);
begin
  if FMouseControlStyle <> Value then
    begin
      FMouseControlStyle := Value;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetRotationDesiredSpacing(const Value: TiRotaryDesiredSpacing);
begin
  if FRotationDesiredSpacing <> Value then
    begin
      FRotationDesiredSpacing := Value;
      BackGroundChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.SetPositionFromMouse(X, Y: Integer);
var
  Degrees     : Double;
  NewPosition : Integer;
begin
  Degrees := RadToDeg(ArcTan2(Y-FCenterPoint.Y,X-FCenterPoint.x));
  if Degrees < 0 then Degrees := Degrees + 360;
  Degrees := Degrees + AngleOffset + FDegreesStep/2;
  if Degrees >= 360 then Degrees := Degrees - 360;
  if Degrees > (PositionLabelCount*FDegreesStep + FDegreesStep/2) then exit;
  NewPosition := Trunc(Degrees/FDegreesStep);
  if NewPosition > PositionLabelCount then NewPosition := NewPosition - 8;
  Position := NewPosition;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      SetFocus;
      UserGenerated := True;
      try
        case FMouseControlStyle of
          irmcsRotate : begin
                          FMouseDown        := True;
                          FMouseDownDegrees := RadToDeg(ArcTan2(Y-FCenterPoint.Y,X-FCenterPoint.x));
                          InvalidateChange;
                        end;
          irmcsGoto   : begin
                          FMouseDown        := True;
                          SetPositionFromMouse(X, Y);
                          InvalidateChange;
                        end;
        end;
      finally
        UserGenerated := False;
      end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.iMouseMove(Shift: TShiftState; X, Y: Integer);
var
  CurrentDegrees : Double;
  DeltaAngle     : Double;
begin
  if FMouseDown then
    begin
      UserGenerated := True;
      try
        case FMouseControlStyle of
          irmcsRotate : begin
                          CurrentDegrees  := RadToDeg(ArcTan2(Y-FCenterPoint.y,X-FCenterPoint.x));

                          DeltaAngle      := FMouseDownDegrees - CurrentDegrees;
                          if DeltaAngle >  200 then DeltaAngle := DeltaAngle - 360;
                          if DeltaAngle < -200 then DeltaAngle := DeltaAngle + 360;

                          if DeltaAngle > (FDegreesStep/2) then
                            begin
                              Position          := Position - 1;
                              FMouseDownDegrees := CurrentDegrees  - FDegreesStep;
                            end
                          else if DeltaAngle < -FDegreesStep/2 then
                            begin
                              Position          := Position + 1;
                              FMouseDownDegrees := CurrentDegrees + FDegreesStep;
                            end;
                        end;
          irmcsGoto   : SetPositionFromMouse(X, Y);
        end;
      finally
        UserGenerated := False;
      end;
   end;
end;
//*************************************************************************************************************************************
procedure TiSwitchRotary.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  InvalidateChange;
  if FMouseDown  then
    begin
      FMouseDown := False;
      DoPositionChangeFinished;
    end;
end;
//*************************************************************************************************************************************
function TiSwitchRotary.AngleOffset: Integer;
begin
  case FRotationStartDegrees of
    irsd000 : Result :=   0;
    irsd045 : Result :=  45;
    irsd090 : Result :=  90;
    irsd135 : Result := 135;
    irsd180 : Result := 180;
    irsd225 : Result := 225;
    irsd270 : Result := 270;
    irsd315 : Result := 315;
    else      Result := 0;
  end;
end;
//*************************************************************************************************************************************
function TiSwitchRotary.GetCenterPoint(Canvas: TCanvas): TPoint;
var
  ClientRect     : TRect;
  CenterPoint    : TPoint;
  TempPoint      : TPoint;
  MinX, MaxX     : Double;
  MinY, MaxY     : Double;
  MaxRadius      : Integer;
  x              : Integer;
  MaxLabelHeight : Integer;
begin
  ClientRect  := Rect(0, 0, Width, Height);
  CenterPoint := inherited GetCenterPoint(Canvas);

  MaxRadius   := FPointerLength;
  if ShowPositionIndicators then MaxRadius := MaxRadius + PositionIndicatorMargin + PositionIndicatorSize;

  MaxLabelHeight := 0;
  Canvas.Font.Assign(PositionLabelActiveFont);
  if Canvas.TextHeight('A') > MaxLabelHeight then MaxLabelHeight := Canvas.TextHeight('A');
  Canvas.Font.Assign(PositionLabelInactiveFont);
  if Canvas.TextHeight('A') > MaxLabelHeight then MaxLabelHeight := Canvas.TextHeight('A');

  if FPositionLabelAlignment = ilaJustified then MaxLabelHeight := MaxLabelHeight + MaxLabelHeight div 2;

  MaxRadius := MaxRadius + PositionLabelMargin + MaxLabelHeight;

  TempPoint := GetXYRadPoint(AngleOffset, MaxRadius, Point(0,0));
  MaxX := TempPoint.x;
  MinX := TempPoint.x;
  MaxY := TempPoint.y;
  MinY := TempPoint.y;

  for x := 2 to PositionLabelsList.Count do
    begin
      TempPoint := GetXYRadPoint(AngleOffset - (x - 1)*FDegreesStep, MaxRadius, Point(0,0));
      if TempPoint.x > MaxX then MaxX := TempPoint.x;
      if TempPoint.x < MinX then MinX := TempPoint.x;
      if TempPoint.y > MaxY then MaxY := TempPoint.y;
      if TempPoint.y < MinY then MinY := TempPoint.y;
      TempPoint := GetXYRadPoint(AngleOffset - (x - 1)*FDegreesStep, -FPointerLength, Point(0,0));
      if TempPoint.x > MaxX then MaxX := TempPoint.x;
      if TempPoint.x < MinX then MinX := TempPoint.x;
      if TempPoint.y > MaxY then MaxY := TempPoint.y;
      if TempPoint.y < MinY then MinY := TempPoint.y;


    end;