iswitchslider.pas

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

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

{$ifdef iVCL}unit  iSwitchSlider;{$endif}
{$ifdef iCLX}unit QiSwitchSlider;{$endif}

interface

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

type
  TiSwitchSlider = class(TiSwitchMultiPosition)
  private
    FEndsMargin                    : Integer;
    FPositionOld                   : Double;
    FPointerIndicatorInactiveColor : TColor;
    FPointerIndicatorActiveColor   : TColor;
    FOrientationLabels             : TiOrientationSide;
    FOrientation                   : TiOrientation;
    FPointerHeight                 : Integer;
    FPointerStyle                  : TiSliderPointerStyle;
    FPointerWidth                  : Integer;
    FTrack3DMargin                 : Integer;
    FTrackColor                    : TColor;
    FTrackStyle                    : TiSliderTrackStyle;
    FPositionIndicatorStyle        : TiSwitchSliderIndicatorStyle;
    FOnAutoSize                    : TNotifyEvent;
    FTrackRect                     : TRect;
    FIndicatorRect                 : TRect;
    FIndicatorOverlap              : Integer;
    FAutoCenter                    : Boolean;
    FCenterOffsetX                 : Integer;
    FCenterOffsetY                 : Integer;
    FPointerHighLightColor         : TColor;
    FPointerColor                  : TColor;
    FPointerBitmap                 : TBitmap;

    function  GetTravelRange : Integer;

    procedure SetEndsMargin                   (const Value: Integer);
    procedure SetPointerIndicatorActiveColor  (const Value: TColor);
    procedure SetPointerIndicatorInactiveColor(const Value: TColor);
    procedure SetOrientationLabels            (const Value: TiOrientationSide);
    procedure SetOrientation                  (const Value: TiOrientation);
    procedure SetPointerHeight                (const Value: Integer);
    procedure SetPointerStyle                 (const Value: TiSliderPointerStyle);
    procedure SetPointerWidth                 (const Value: Integer);
    procedure SetTrackColor                   (const Value: TColor);
    procedure SetTrackStyle                   (const Value: TiSliderTrackStyle);
    procedure SetPositionIndicatorStyle       (const Value: TiSwitchSliderIndicatorStyle);
    procedure SetAutoCenter                   (const Value: Boolean);
    procedure SetPointerColor                 (const Value: TColor);
    procedure SetPointerHighLightColor        (const Value: TColor);
    procedure SetPointerBitmap                (const Value: TBitmap);
  protected
    procedure iPaintTo(Canvas: TCanvas);                                           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;
    property  TravelRange : Integer read GetTravelRange;
    procedure DrawTrack    (Canvas: TCanvas; TrackRect: TRect);
    procedure DrawTicks    (Canvas: TCanvas; TrackRect: TRect);
    procedure DrawIndicator(Canvas: TCanvas; IndicatorRect : TRect);

    procedure CalcPoints;
    procedure CalcAutoCenterOffsets;

    property OnAutoSize                    : TNotifyEvent                 read FOnAutoSize                    write FOnAutoSize;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;
  published
    property EndsMargin                    : Integer                      read FEndsMargin                    write SetEndsMargin                     default 5;
    property PointerIndicatorActiveColor   : TColor                       read FPointerIndicatorActiveColor   write SetPointerIndicatorActiveColor    default clRed;
    property PointerIndicatorInactiveColor : TColor                       read FPointerIndicatorInactiveColor write SetPointerIndicatorInactiveColor  default clBlack;
    property PointerBitmap                 : TBitmap                      read FPointerBitmap                 write SetPointerBitmap;
    property PositionIndicatorStyle        : TiSwitchSliderIndicatorStyle read FPositionIndicatorStyle        write SetPositionIndicatorStyle         default issisDot;
    property Orientation                   : TiOrientation                read FOrientation                   write SetOrientation                    default ioVertical;
    property OrientationLabels             : TiOrientationSide            read FOrientationLabels             write SetOrientationLabels              default iosBottomRight;
    property PointerHeight                 : Integer                      read FPointerHeight                 write SetPointerHeight                  default 8;
    property PointerStyle                  : TiSliderPointerStyle         read FPointerStyle                  write SetPointerStyle                   default ispsPointer;
    property PointerWidth                  : Integer                      read FPointerWidth                  write SetPointerWidth                   default 13;
    property PointerColor                  : TColor                       read FPointerColor                  write SetPointerColor                   default clBtnFace;
    property PointerHighLightColor         : TColor                       read FPointerHighLightColor         write SetPointerHighLightColor          default clBtnHighlight;
    property TrackColor                    : TColor                       read FTrackColor                    write SetTrackColor                     default clWhite;
    property TrackStyle                    : TiSliderTrackStyle           read FTrackStyle                    write SetTrackStyle                     default istsBox;
    property AutoCenter                    : Boolean                      read FAutoCenter                    write SetAutoCenter                     default False;
    property BackGroundPicture;
    property BackGroundColor;
    property Transparent;
    property OffsetX;
    property OffsetY;
    property BorderStyle;

    property Width            default 80;
    property Height           default 80;
  end;

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

  Width  := 80;
  Height := 80;

  FEndsMargin                    := 5;
  FPointerIndicatorInactiveColor := clBlack;
  FPointerIndicatorActiveColor   := clRed;
  FPointerStyle                  := ispsPointer;
  FPointerColor                  := clBtnFace;
  FPointerHighLightColor         := clBtnHighlight;

  FPointerHeight                 := 8;
  FPointerWidth                  := 13;
  FTrackColor                    := clWhite;
  FTrack3DMargin                 := 0;
  FMaxPositionCount              := 32;

  PositionLabels                 := 'Low, Medium, High';

  FPointerBitmap := TBitmap.Create;
  FPointerBitmap.Transparent := True;
  FPointerBitmap.OnChange    := InvalidateChangeEvent;

  CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
destructor TiSwitchSlider.Destroy;
begin
  FPointerBitmap.Free;
  inherited Destroy;
end;
//*************************************************************************************************************************************
procedure TiSwitchSlider.SetEndsMargin                   (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin,                   irtInvalidate);end;
procedure TiSwitchSlider.SetPointerIndicatorActiveColor  (const Value:TColor); begin SetColorProperty  (Value,FPointerIndicatorActiveColor,  irtInvalidate);end;
procedure TiSwitchSlider.SetPointerIndicatorInactiveColor(const Value:TColor); begin SetColorProperty  (Value,FPointerIndicatorInactiveColor,irtInvalidate);end;
procedure TiSwitchSlider.SetPointerHeight                (const Value:Integer);begin SetIntegerProperty(Value,FPointerHeight,                irtInvalidate);end;
procedure TiSwitchSlider.SetPointerWidth                 (const Value:Integer);begin SetIntegerProperty(Value,FPointerWidth,                 irtInvalidate);end;
procedure TiSwitchSlider.SetTrackColor                   (const Value:TColor); begin SetColorProperty  (Value,FTrackColor,                   irtInvalidate);end;
procedure TiSwitchSlider.SetAutoCenter                   (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter,                   irtBackGround);end;
procedure TiSwitchSlider.SetPointerColor                 (const Value: TColor);begin SetColorProperty  (Value, FPointerColor,                irtBackGround);end;
procedure TiSwitchSlider.SetPointerHighLightColor        (const Value: TColor);begin SetColorProperty  (Value, FPointerHighLightColor,       irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiSwitchSlider.SetOrientationLabels(const Value: TiOrientationSide);
begin
  if FOrientationLabels <> Value then
    begin
      FOrientationLabels := Value;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchSlider.SetTrackStyle(const Value: TiSliderTrackStyle);
begin
  if FTrackStyle <> Value then
    begin
      FTrackStyle := Value;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchSlider.SetPositionIndicatorStyle(const Value: TiSwitchSliderIndicatorStyle);
begin
  if FPositionIndicatorStyle <> Value then
    begin
      FPositionIndicatorStyle := Value;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchSlider.SetPointerBitmap(const Value: TBitmap);
begin
  FPointerBitmap.Assign(Value);
  FPointerBitmap.Transparent     := True;
  FPointerBitmap.TransparentMode := tmAuto;
end;
//*************************************************************************************************************************************
procedure TiSwitchSlider.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin