⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ipositioncomponent.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*******************************************************}
{                                                       }
{       TiPositionComponent                             }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iPositionComponent;{$endif}
{$ifdef iCLX}unit QiPositionComponent;{$endif}

interface

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

type
  TiPositionComponent = class(TiCustomComponent)
  private
    FLimitList                : TStringList;
    FPosition                 : Double;
    FPositionMax              : Double;
    FPositionMin              : Double;
    FShowMaxPointer           : Boolean;
    FShowMinPointer           : Boolean;
    FCurrentMin               : Double;                        
    FCurrentMax               : Double;
    FMinMaxPointerMargin      : Integer;
    FMinMaxPointerSize        : Integer;
    FMinPointerColor          : TColor;
    FMaxPointerColor          : TColor;
    FOnPositionChange         : TNotifyEvent;
    FOnCurrentMaxChange       : TNotifyEvent;
    FOnCurrentMinChange       : TNotifyEvent;
    FOnPositionChangeFinished : TNotifyEvent;
    FOnPositionOverMax        : TNotifyEvent;
    FOnPositionUnderMin       : TNotifyEvent;
    FPositionedChanged        : Boolean;
    FMinMaxFixed              : Boolean;
    FMinMaxUserCanMove        : Boolean;
    FOnPositionOverLimit      : TOnPositionLimit;
    FOnPositionUnderLimit     : TOnPositionLimit;
    FUserGenerated            : Boolean;
    FOnPositionChangeUser     : TNotifyEvent;

    procedure SetShowMaxPointer         (const Value: Boolean);
    procedure SetShowMinPointer         (const Value: Boolean);
    procedure SetCurrentMax             (const Value: Double);
    procedure SetCurrentMin             (const Value: Double);
    procedure SetMinMaxPointerMargin    (const Value: Integer);
    procedure SetMinMaxPointerSize      (const Value: Integer);
    procedure SetMaxPointerColor        (const Value: TColor);
    procedure SetMinPointerColor        (const Value: TColor);
    procedure SetPositionPercent        (const Value: Double);
    procedure SetMinMaxFixed            (const Value: Boolean);
    procedure SetMinMaxUserCanMove      (const Value: Boolean);
    procedure SetLimitUpperValue        (Index: Integer; const Value: Double);
    procedure SetLimitLowerValue        (Index: Integer; const Value: Double);
    procedure SetLimitUpperPointerColor (Index: Integer; const Value: TColor);
    procedure SetLimitPointerMargin     (Index: Integer; const Value: Integer);
    procedure SetLimitPointerSize       (Index: Integer; const Value: Integer);
    procedure SetLimitShowUpperPointer  (Index: Integer; const Value: Boolean);
    procedure SetLimitDrawScaleSide     (Index: Integer; const Value: Boolean);
    function GetLimitLowerValue         (Index: Integer): Double;
    function GetLimitUpperPointerColor  (Index: Integer): TColor;
    function GetLimitPointerMargin      (Index: Integer): Integer;
    function GetLimitPointerSize        (Index: Integer): Integer;
    function GetLimitShowUpperPointer   (Index: Integer): Boolean;
    function GetLimitUpperValue         (Index: Integer): Double;
    function GetLimitDrawScaleSide      (Index: Integer): Boolean;
    function GetPositionPercent : Double;
    function GetLimitCount      : Integer;
    function GetLimitLowerPointerColor(Index: Integer): TColor;
    function GetLimitShowLowerPointer(Index: Integer): Boolean;
    procedure SetLimitLowerPointerColor(Index: Integer; const Value: TColor);
    procedure SetLimitShowLowerPointer(Index: Integer; const Value: Boolean);
  protected
    function GetPosition: Double;               virtual;
    procedure SetPosition(const Value: Double); virtual;

    function ValuePercent(Value : Double) : Double;

    procedure DefineProperties (Filer  : TFiler); override;
    procedure WritePositionMax2(Writer : TWriter);
    procedure ReadPositionMax2 (Reader : TReader);

    procedure DoPositionChange;
    procedure DoCurrentMaxChange;
    procedure DoCurrentMinChange;
    procedure DoPositionOverMax;
    procedure DoPositionUnderMin;
    procedure DoPositionChangeFinished;
    procedure DoOPCPositionChangeFinished; virtual;

    procedure DoPositionOverLimit(Index : Integer);
    procedure DoPositionUnderLimit(Index : Integer);

    procedure SetPositionMin(const Value : Double); virtual;
    procedure SetPositionMax(const Value : Double); virtual;
    procedure SetPositionMinMax(Min, Max : Double);
    procedure DoLimitBounds;       
    procedure DoPointerBounds;                      virtual;

    function  GetLimitObject(Index : Integer) : TiLimitObject;

    property UserGenerated            : Boolean      read FUserGenerated            write  FUserGenerated;

    property ShowMaxPointer           : Boolean      read FShowMaxPointer           write SetShowMaxPointer       default False;
    property ShowMinPointer           : Boolean      read FShowMinPointer           write SetShowMinPointer       default False;
    property MinMaxPointerSize        : Integer      read FMinMaxPointerSize        write SetMinMaxPointerSize    default 8;
    property MinMaxPointerMargin      : Integer      read FMinMaxPointerMargin      write SetMinMaxPointerMargin  default 0;
    property MaxPointerColor          : TColor       read FMaxPointerColor          write SetMaxPointerColor      default clAqua;
    property MinPointerColor          : TColor       read FMinPointerColor          write SetMinPointerColor      default clYellow;
    property PositionedChanged        : Boolean      read FPositionedChanged        write FPositionedChanged;
    property MinMaxUserCanMove        : Boolean      read FMinMaxUserCanMove        write SetMinMaxUserCanMove    default False;

    property OnPositionChangeFinished : TNotifyEvent read FOnPositionChangeFinished write FOnPositionChangeFinished;
    property OnPositionChangeUser     : TNotifyEvent read FOnPositionChangeUser     write FOnPositionChangeUser;
  public
    constructor Create(AOwner: TComponent);    override;
    destructor  Destroy;                       override;

    procedure   AddLimit(PointerSize, PointerMargin : Integer; DrawScaleSide : Boolean; UpperValue, LowerValue : Double; UpperPointerColor, LowerPointerColor : TColor);
    procedure   RemoveLimit(Index : Integer);
    procedure   RemoveAllLimits;
    property    LimitUpperValue       [Index : Integer] : Double  read GetLimitUpperValue        write SetLimitUpperValue;
    property    LimitLowerValue       [Index : Integer] : Double  read GetLimitLowerValue        write SetLimitLowerValue;
    property    LimitPointerSize      [Index : Integer] : Integer read GetLimitPointerSize       write SetLimitPointerSize;
    property    LimitPointerMargin    [Index : Integer] : Integer read GetLimitPointerMargin     write SetLimitPointerMargin;
    property    LimitUpperPointerColor[Index : Integer] : TColor  read GetLimitUpperPointerColor write SetLimitUpperPointerColor;
    property    LimitLowerPointerColor[Index : Integer] : TColor  read GetLimitLowerPointerColor write SetLimitLowerPointerColor;
    property    LimitShowUpperPointer [Index : Integer] : Boolean read GetLimitShowUpperPointer  write SetLimitShowUpperPointer;
    property    LimitShowLowerPointer [Index : Integer] : Boolean read GetLimitShowLowerPointer  write SetLimitShowLowerPointer;
    property    LimitDrawScaleSide    [Index : Integer] : Boolean read GetLimitDrawScaleSide     write SetLimitDrawScaleSide;
    property    LimitCount                              : Integer read GetLimitCount;

    procedure   SetPositionNoEvent(const Value : Double);
    procedure   ResetMinMax;
    property    PositionPercent      : Double           read GetPositionPercent       write SetPositionPercent;
  published
    property Position                : Double           read GetPosition              write SetPosition;
    property PositionMax             : Double           read FPositionMax             write SetPositionMax;
    property PositionMin             : Double           read FPositionMin             write SetPositionMin;

    property CurrentMax              : Double           read FCurrentMax              write SetCurrentMax;
    property CurrentMin              : Double           read FCurrentMin              write SetCurrentMin;
    property MinMaxFixed             : Boolean          read FMinMaxFixed             write SetMinMaxFixed       default False;

    property OnPositionChange        : TNotifyEvent     read FOnPositionChange        write FOnPositionChange;
    property OnCurrentMaxChange      : TNotifyEvent     read FOnCurrentMaxChange      write FOnCurrentMaxChange;
    property OnCurrentMinChange      : TNotifyEvent     read FOnCurrentMinChange      write FOnCurrentMinChange;
    property OnPositionOverMax       : TNotifyEvent     read FOnPositionOverMax       write FOnPositionOverMax;
    property OnPositionUnderMin      : TNotifyEvent     read FOnPositionUnderMin      write FOnPositionUnderMin;

    property OnPositionOverLimit     : TOnPositionLimit read FOnPositionOverLimit     write FOnPositionOverLimit;
    property OnPositionUnderLimit    : TOnPositionLimit read FOnPositionUnderLimit    write FOnPositionUnderLimit;
  end;

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

  FPositionMax       := 100;
  FPositionMin       := 0;
  FMaxPointerColor   := clAqua;
  FMinPointerColor   := clYellow;
  FMinMaxPointerSize := 8;

  FLimitList := TStringList.Create;
end;
//****************************************************************************************************************************************************
destructor TiPositionComponent.Destroy;
begin
  FLimitList.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiPositionComponent.SetShowMaxPointer     (const Value:Boolean);begin SetBooleanProperty(Value,FShowMaxPointer     ,irtBackGround);end;
procedure TiPositionComponent.SetShowMinPointer     (const Value:Boolean);begin SetBooleanProperty(Value,FShowMinPointer     ,irtBackGround);end;
procedure TiPositionComponent.SetMinMaxPointerMargin(const Value:Integer);begin SetIntegerProperty(Value,FMinMaxPointerMargin,irtBackGround);end;
procedure TiPositionComponent.SetMinMaxPointerSize  (const Value:Integer);begin SetIntegerProperty(Value,FMinMaxPointerSize  ,irtBackGround);end;
procedure TiPositionComponent.SetMaxPointerColor    (const Value:TColor); begin SetColorProperty  (Value,FMaxPointerColor    ,irtInvalidate);end;
procedure TiPositionComponent.SetMinPointerColor    (const Value:TColor); begin SetColorProperty  (Value,FMinPointerColor    ,irtInvalidate);end;
procedure TiPositionComponent.SetMinMaxFixed        (const Value:Boolean);begin SetBooleanProperty(Value,FMinMaxFixed        ,irtInvalidate);end;
procedure TiPositionComponent.SetMinMaxUserCanMove  (const Value:Boolean);begin SetBooleanProperty(Value,FMinMaxUserCanMove  ,irtInvalidate);end;
//****************************************************************************************************************************************************
procedure TiPositionComponent.SetPositionNoEvent(const Value: Double);
var
  TempOnPositionChange : TNotifyEvent;
begin
  TempOnPositionChange := FOnPositionChange;
  FOnPositionChange    := nil;
  try
    SetPosition(Value);
  finally
    FOnPositionChange := TempOnPositionChange;
  end;
end;
//****************************************************************************************************************************************************
procedure TiPositionComponent.SetPosition(const Value : Double);
var
  CanEdit   : Boolean;
  TempValue : Double;
  x         : Integer;
begin
  if Loading then
    begin
      FPosition := Value;
      Exit;
    end;

  TempValue := Value;

  if TempValue > FPositionMax then TempValue := FPositionMax;
  if TempValue < FPositionMin then TempValue := FPositionMin;

  if FPosition <> TempValue then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Position', CanEdit);

      if CanEdit then
        begin
          FPosition := TempValue;

          FPositionedChanged := True;

          if FPosition > CurrentMax then if not FMinMaxFixed then CurrentMax := FPosition;
          if FPosition < CurrentMin then if not FMinMaxFixed then CurrentMin := FPosition;

          if FPosition > CurrentMax then DoPositionOverMax;
          if FPosition < CurrentMin then DoPositionUnderMin;

          for x := 0 to FLimitList.Count - 1 do
            begin
              if FPosition > (FLimitList.Objects[x] as TiLimitObject).UpperValue then DoPositionOverLimit(x);
              if FPosition < (FLimitList.Objects[x] as TiLimitObject).LowerValue then DoPositionUnderLimit(x);
            end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -