iswitchmultiposition.pas

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

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

{$ifdef iVCL}unit  iSwitchMultiPosition;{$endif}
{$ifdef iCLX}unit QiSwitchMultiPosition;{$endif}

interface

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

type
  TiSwitchMultiPosition = class(TiCustomComponent)
  private
    FPosition                    : Integer;
    FPositionLabels              : String;
    FPositionLabelsList          : TStringList;
    FPositionLabelMargin         : Integer;
    FPositionLabelActiveFont     : TFont;
    FPositionLabelInactiveFont   : TFont;
    FShowPositionLabels          : Boolean;
    FShowPositionIndicators      : Boolean;
    FPositionIndicatorSize       : Integer;
    FPositionIndicatorMargin     : Integer;
    FPositionIndicatorColor      : TColor;
    FPositionIndicatorBevelStyle : TiBevelStyle;
    FKeyPageStepSize             : Integer;
    FKeyArrowStepSize            : Integer;
    FShowFocusRect               : Boolean;
    FOnPositionChange            : TNotifyEvent;
    FOnPositionChangeFinished    : TNotifyEvent;
    FPositionedChanged           : Boolean;
    FUserGenerated               : Boolean;
    FOnPositionChangeUser        : TNotifyEvent;
    FLastWheelTime               : TDateTime;

    function GetPositionLabel(Index: Integer): String;
    function GetPositionLabelCount           : Integer;

    procedure SetPosition                   (const Value: Integer);
    procedure SetPositionLabels             (const Value: String);
    procedure SetPositionLabelMargin        (const Value: Integer);
    procedure SetPositionLabelInactiveFont  (const Value: TFont);
    procedure SetShowPositionIndicators     (const Value: Boolean);
    procedure SetShowPositionLabels         (const Value: Boolean);
    procedure SetPositionIndicatorSize      (const Value: Integer);
    procedure SetPositionIndicatorMargin    (const Value: Integer);
    procedure SetPositionIndicatorColor     (const Value: TColor);
    procedure SetPositionLabelActiveFont    (const Value: TFont);
    procedure SetPositionIndicatorBevelStyle(const Value: TiBevelStyle);
    procedure SetKeyArrowStepSize           (const Value: Integer);
    procedure SetKeyPageStepSize            (const Value: Integer);
    procedure SetShowFocusRect              (const Value: Boolean);
    procedure SetPositionLabel              (Index: Integer; const Value: String);
  protected
    FMaxPositionCount : Integer;
    FMouseDown        : Boolean;
    FMaximumLabels    : Integer;
    FKeyDown          : Boolean;

    procedure UpdateLabelList;
    procedure DoPositionChange;
    procedure DoPositionChangeFinished;

    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}

    property UserGenerated               : Boolean           read FUserGenerated              write  FUserGenerated;
    property PositionLabelsList          : TStringList       read FPositionLabelsList;
    property PositionedChanged           : Boolean           read FPositionedChanged          write FPositionedChanged;
  public
    constructor Create(AOwner: TComponent);  override;
    destructor  Destroy;                     override;
    procedure   SetPositionNoEvent(const Value : Integer);
    property    PositionLabel[Index : Integer] : String      read GetPositionLabel             write SetPositionLabel;
    property    PositionLabelCount             : Integer     read GetPositionLabelCount;
  published
    property Position                    : Integer           read FPosition                    write SetPosition                     default 0;
    property PositionLabels              : String            read FPositionLabels              write SetPositionLabels;
    property PositionLabelMargin         : Integer           read FPositionLabelMargin         write SetPositionLabelMargin          default 5;
    property PositionLabelInactiveFont   : TFont             read FPositionLabelInactiveFont   write SetPositionLabelInactiveFont;
    property PositionLabelActiveFont     : TFont             read FPositionLabelActiveFont     write SetPositionLabelActiveFont;
    property PositionIndicatorSize       : Integer           read FPositionIndicatorSize       write SetPositionIndicatorSize        default 3;
    property PositionIndicatorMargin     : Integer           read FPositionIndicatorMargin     write SetPositionIndicatorMargin      default 10;
    property PositionIndicatorColor      : TColor            read FPositionIndicatorColor      write SetPositionIndicatorColor       default clAqua;
    property ShowPositionIndicators      : Boolean           read FShowPositionIndicators      write SetShowPositionIndicators       default True;
    property ShowPositionLabels          : Boolean           read FShowPositionLabels          write SetShowPositionLabels           default True;
    property PositionIndicatorBevelStyle : TiBevelStyle      read FPositionIndicatorBevelStyle write SetPositionIndicatorBevelStyle  default ibsLowered;
    property ShowFocusRect               : Boolean           read FShowFocusRect               write SetShowFocusRect                default True;
    property KeyArrowStepSize            : Integer           read FKeyArrowStepSize            write SetKeyArrowStepSize             default 1;
    property KeyPageStepSize             : Integer           read FKeyPageStepSize             write SetKeyPageStepSize              default 2;
    property BackGroundColor;
    property TabOrder;
    property TabStop                                                                                                                 default True;
    property OnPositionChange            : TNotifyEvent      read FOnPositionChange            write FOnPositionChange;
    property OnPositionChangeFinished    : TNotifyEvent      read FOnPositionChangeFinished    write FOnPositionChangeFinished;
    property OnPositionChangeUser        : TNotifyEvent      read FOnPositionChangeUser        write FOnPositionChangeUser;
  end;

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

  FPositionLabelMargin         := 5;
  FPositionIndicatorSize       := 3;
  FPositionIndicatorMargin     := 10;
  FPositionIndicatorColor      := clAqua;

  FPositionLabels              := 'Off, On';
  FShowFocusRect               := True;
  FShowPositionLabels          := True;
  FShowPositionIndicators      := True;
  FPositionIndicatorBevelStyle := ibsLowered;

  FKeyArrowStepSize            := 1;
  FKeyPageStepSize             := 2;

  FPositionLabelsList          := TStringList.Create;
  UpdateLabelList;

  FPositionLabelInactiveFont   := TFont.Create; FPositionLabelInactiveFont.OnChange := BackGroundChangeEvent;
  FPositionLabelActiveFont     := TFont.Create; FPositionLabelActiveFont.OnChange   := BackGroundChangeEvent;

  TabStop                      := True;
end;
//*************************************************************************************************************************************
destructor TiSwitchMultiPosition.Destroy;
begin
  FPositionLabelsList.Free;
  FPositionLabelInactiveFont.Free;
  FPositionLabelActiveFont.Free;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.DoPositionChange;
begin
  if not Loading then
    begin
      if                          Assigned(OnChangeProtected)     then OnChangeProtected    (Self, 'Position');
      if                          Assigned(FOnPositionChange)     then FOnPositionChange    (Self);
      if (FUserGenerated) then if Assigned(FOnPositionChangeUser) then FOnPositionChangeUser(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.DoPositionChangeFinished;
begin
  if not Loading then
    begin
      if PositionedChanged then
        begin
          PositionedChanged := False;
          if Assigned(FOnPositionChangeFinished)then FOnPositionChangeFinished(Self);
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionLabelMargin    (const Value:Integer);begin if FPositionLabelMargin    <>Value then begin FPositionLabelMargin    :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetShowPositionIndicators (const Value:Boolean);begin if FShowPositionIndicators <>Value then begin FShowPositionIndicators :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetShowPositionLabels     (const Value:Boolean);begin if FShowPositionLabels     <>Value then begin FShowPositionLabels     :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetPositionIndicatorSize  (const Value:Integer);begin if FPositionIndicatorSize  <>Value then begin FPositionIndicatorSize  :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetPositionIndicatorMargin(const Value:Integer);begin if FPositionIndicatorMargin<>Value then begin FPositionIndicatorMargin:=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetPositionIndicatorColor (const Value:TColor); begin if FPositionIndicatorColor <>Value then begin FPositionIndicatorColor :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetKeyArrowStepSize       (const Value:Integer);begin if FKeyArrowStepSize       <>Value then begin FKeyArrowStepSize       :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetKeyPageStepSize        (const Value:Integer);begin if FKeyPageStepSize        <>Value then begin FKeyPageStepSize        :=Value;BackGroundChange;end;end;
procedure TiSwitchMultiPosition.SetShowFocusRect          (const Value:Boolean);begin if FShowFocusRect          <>Value then begin FShowFocusRect          :=Value;BackGroundChange;end;end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionLabelInactiveFont(const Value:TFont);begin FPositionLabelInactiveFont.Assign(Value); BackGroundChange;end;
procedure TiSwitchMultiPosition.SetPositionLabelActiveFont  (const Value:TFont);begin FPositionLabelActiveFont.Assign(Value);   BackGroundChange;end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionNoEvent(const Value: Integer);
var