islider.pas

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

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

{$ifdef iVCL}unit  iSlider;{$endif}
{$ifdef iCLX}unit QiSlider;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iScaleComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiScaleComponent;{$ENDIF}

type
  TiSlider = class(TiScaleComponent)
  private
    FPositionOld                   : Double;
    FMouseDown                     : Boolean;
    FMouseDownX                    : Integer;
    FMouseDownY                    : Integer;
    FLastWheelTime                 : TDateTime;
    FKeyDown                       : Boolean;
    FPointerRect                   : TRect;
    FTrackRect                     : TRect;
    FPointerOverlap                : Integer;

    FCenterOffsetX                 : Integer;
    FCenterOffsetY                 : Integer;

    FEndsMargin                    : Integer;
    FPointerIndicatorInactiveColor : TColor;
    FPointerIndicatorActiveColor   : TColor;
    FKeyPageStepSize               : Double;
    FKeyArrowStepSize              : Double;
    FMouseWheelStepSize            : Double;
    FPointerHeight                 : Integer;
    FPointerWidth                  : Integer;
    FPointerStyle                  : TiSliderPointerStyle;
    FOrientationTickMarks          : TiOrientationSide;
    FOrientation                   : TiOrientation;
    FTrack3DMargin                 : Integer;
    FTrackColor                    : TColor;
    FTrackStyle                    : TiSliderTrackStyle;
    FShowFocusRect                 : Boolean;
    FReverseScale                  : Boolean;
    FMouseControlStyle             : TiSliderMouseControlStyle;
    FOnAutoSize                    : TNotifyEvent;
    FAutoCenter                    : Boolean;
    FPointerBitmap                 : TBitmap;

    procedure SetPointerIndicatorActiveColor  (const Value: TColor);
    procedure SetPointerIndicatorInactiveColor(const Value: TColor);
    procedure SetOrientationTickMarks         (const Value: TiOrientationSide);
    procedure SetOrientation                  (const Value: TiOrientation);
    procedure SetPointerWidth                 (const Value: Integer);
    procedure SetEndsMargin                   (const Value: Integer);
    procedure SetTrackColor                   (const Value: TColor);
    procedure SetTrackStyle                   (const Value: TiSliderTrackStyle);
    procedure SetPointerStyle                 (const Value: TiSliderPointerStyle);
    procedure SetPointerHeight                (const Value: Integer);
    procedure SetShowFocusRect                (const Value: Boolean);
    procedure SetKeyArrowStepSize             (const Value: Double);
    procedure SetKeyPageStepSize              (const Value: Double);
    procedure SetMouseWheelStepSize           (const Value: Double);
    procedure SetReverseScale                 (const Value: Boolean);
    procedure SetMouseControlStyle            (const Value: TiSliderMouseControlStyle);
    procedure SetAutoCenter                   (const Value: Boolean);
    procedure SetPointerBitmap                (const Value: TBitmap);
    function  GetTravelRange : Integer;
  protected
    procedure iPaintTo(Canvas: TCanvas);                                           override;

    procedure DrawBar      (Canvas: TCanvas);
    procedure DrawTicks    (Canvas: TCanvas);
    procedure DrawIndicator(Canvas: TCanvas);
    property  TravelRange : Integer read GetTravelRange;
    function  GetPixelsToPosition(Value : Integer) : Double;
    procedure CalcPoints;
    procedure CalcAutoCenterOffsets;

    procedure DoOPCPositionChangeFinished; 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 iWantSpecialKey(var CharCode: Word; var Result: Longint);            override;
    procedure iKeyUp         (var CharCode: Word; Shift: TShiftState);             override;
    procedure iKeyDown       (var CharCode: Word; Shift: TShiftState);             override;

    procedure iDoKillFocus; override;

    {$ifdef iVCL}function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint      ): Boolean; override;{$endif}
    {$ifdef iCLX}function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; const MousePos: TPoint): Boolean; override;{$endif}

    procedure DefineProperties     (Filer: TFiler); override;
    procedure WriteKeyArrowStepSize(Writer: TWriter);
    procedure ReadKeyArrowStepSize (Reader: TReader);
    procedure WriteKeyPageStepSize (Writer: TWriter);
    procedure ReadKeyPageStepSize  (Reader: TReader);

    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 PointerIndicatorInactiveColor : TColor                    read FPointerIndicatorInactiveColor write SetPointerIndicatorInactiveColor default clBlack;
    property PointerIndicatorActiveColor   : TColor                    read FPointerIndicatorActiveColor   write SetPointerIndicatorActiveColor   default clRed;
    property PointerBitmap                 : TBitmap                   read FPointerBitmap                 write SetPointerBitmap;
    property KeyArrowStepSize              : Double                    read FKeyArrowStepSize              write SetKeyArrowStepSize;
    property KeyPageStepSize               : Double                    read FKeyPageStepSize               write SetKeyPageStepSize;
    property MouseWheelStepSize            : Double                    read FMouseWheelStepSize            write SetMouseWheelStepSize;
    property Orientation                   : TiOrientation             read FOrientation                   write SetOrientation                   default ioVertical;
    property OrientationTickMarks          : TiOrientationSide         read FOrientationTickMarks          write SetOrientationTickMarks          default iosBottomRight;
    property PointerHeight                 : Integer                   read FPointerHeight                 write SetPointerHeight                 default 10;
    property PointerStyle                  : TiSliderPointerStyle      read FPointerStyle                  write SetPointerStyle                  default ispsLed;
    property PointerWidth                  : Integer                   read FPointerWidth                  write SetPointerWidth                  default 15;
    property ShowFocusRect                 : Boolean                   read FShowFocusRect                 write SetShowFocusRect                 default True;
    property TrackColor                    : TColor                    read FTrackColor                    write SetTrackColor                    default clWhite;
    property TrackStyle                    : TiSliderTrackStyle        read FTrackStyle                    write SetTrackStyle                    default istsBox;
    property MouseControlStyle             : TiSliderMouseControlStyle read FMouseControlStyle             write SetMouseControlStyle             default ismcsSlideOnly;
    property ReverseScale                  : Boolean                   read FReverseScale                  write SetReverseScale                  default False;
    property AutoCenter                    : Boolean                   read FAutoCenter                    write SetAutoCenter                    default False;

    property BackGroundColor;
    property BorderStyle;
    property BackGroundPicture;
    property Transparent;

    property OffsetX;
    property OffsetY;

    property ShowTicksMajor;
    property ShowTicksMinor;
    property ShowTickLabels;
    property TickMajorCount;
    property TickMajorColor;
    property TickMajorLength;
    property TickMinorAlignment;
    property TickMinorCount;
    property TickMinorColor;
    property TickMinorLength;
    property TickMargin;
    property TickLabelMargin;
    property TickLabelFont;
    property TickLabelPrecision;
    property PrecisionStyle;
    property OnCustomizeTickLabel;

    property TickMajorStyle;
    property TickMinorStyle;
    property TabOrder;
    property TabStop                   default True;
    property OnPositionChangeFinished;
    property OnPositionChangeUser;

    property AutoScaleEnabled;
    property AutoScaleDesiredTicks;
    property AutoScaleMaxTicks;
    property AutoScaleStyle;
    property Width                    default 70;
    property Height                   default 200;
  end;

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

  Width   := 70;
  Height  := 200;
  TabStop := True;

  FEndsMargin                    := 5;
  FPointerIndicatorInactiveColor := clBlack;
  FPointerIndicatorActiveColor   := clRed;

  FPointerHeight                 := 10;
  FPointerWidth                  := 15;
  FTrackColor                    := clWhite;
  FTrack3DMargin                 := 2;
  FShowFocusRect                 := True;

  FKeyArrowStepSize              := 1;
  FKeyPageStepSize               := 10;
  FMouseWheelStepSize            := 1;

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

  CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
destructor TiSlider.Destroy;
begin
  FPointerBitmap.Free;
  inherited Destroy;
end;
//****************************************************************************************************************************************************
procedure TiSlider.SetPointerIndicatorActiveColor  (const Value:TColor );begin SetColorProperty  (Value,FPointerIndicatorActiveColor,  irtBackGround);end;
procedure TiSlider.SetPointerIndicatorInactiveColor(const Value:TColor );begin SetColorProperty  (Value,FPointerIndicatorInactiveColor,irtBackGround);end;
procedure TiSlider.SetPointerHeight                (const Value:Integer);begin SetIntegerProperty(Value,FPointerHeight,                irtBackGround);end;
procedure TiSlider.SetPointerWidth                 (const Value:Integer);begin SetIntegerProperty(Value,FPointerWidth,                 irtBackGround);end;
procedure TiSlider.SetEndsMargin                   (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin,                   irtBackGround);end;
procedure TiSlider.SetTrackColor                   (const Value:TColor );begin SetColorProperty  (Value,FTrackColor,                   irtBackGround);end;
procedure TiSlider.SetReverseScale                 (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale,                 irtBackGround);end;
procedure TiSlider.SetShowFocusRect                (const Value:Boolean);begin SetBooleanProperty(Value,FShowFocusRect,                irtInvalidate);end;
procedure TiSlider.SetKeyArrowStepSize             (const Value:Double );begin SetDoubleProperty (Value,FKeyArrowStepSize,             irtInvalidate);end;
procedure TiSlider.SetKeyPageStepSize              (const Value:Double );begin SetDoubleProperty (Value,FKeyPageStepSize,              irtInvalidate);end;
procedure TiSlider.SetMouseWheelStepSize           (const Value:Double );begin SetDoubleProperty (Value,FMouseWheelStepSize,           irtInvalidate);end;
procedure TiSlider.SetAutoCenter                   (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter,                   irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiSlider.SetOrientationTickMarks(const Value: TiOrientationSide);
begin
  if FOrientationTickMarks <> Value then
    begin
      FOrientationTickMarks := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.SetTrackStyle(const Value: TiSliderTrackStyle);
begin
  if FTrackStyle <> Value then
    begin
      FTrackStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.SetMouseControlStyle(const Value: TiSliderMouseControlStyle);
begin
  if FMouseControlStyle <> Value then