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

📄 igaugecomponent.pas

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

{$ifdef iVCL}unit  iGaugeComponent;{$endif}
{$ifdef iCLX}unit QiGaugeComponent;{$endif}

interface

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

type
  TiGaugeComponent = class(TiScaleComponent)
  private
    FPointerManager      : TiGaugePointerManager;

    FSectionEnd1         : Double;
    FSectionEnd2         : Double;
    FSectionEnd3         : Double;
    FSectionEnd4         : Double;
    FSectionCount        : Integer;
    FSectionColor1       : TColor;
    FSectionColor2       : TColor;
    FSectionColor3       : TColor;
    FSectionColor4       : TColor;
    FSectionColor5       : TColor;
    FOnClickPointer      : TIndexObjectEvent;
  protected
    procedure SetSectionColor1(const Value: TColor);
    procedure SetSectionColor2(const Value: TColor);
    procedure SetSectionColor3(const Value: TColor);
    procedure SetSectionColor4(const Value: TColor);
    procedure SetSectionColor5(const Value: TColor);
    procedure SetSectionCount (const Value: Integer);
    procedure SetSectionEnd1  (const Value: Double);
    procedure SetSectionEnd2  (const Value: Double);
    procedure SetSectionEnd3  (const Value: Double);
    procedure SetSectionEnd4  (const Value: Double);

    function GetPosition: Double;                   override;
    procedure SetPosition(const Value: Double);     override;
    procedure DoPointerBounds;                      override;

    function GetPointers(Index: Integer): TiGaugePointer;
    function GetPointerCount: Integer;

    procedure DefineProperties(Filer : TFiler); override;
    procedure WriteSectionEnd1(Writer : TWriter);
    procedure ReadSectionEnd1 (Reader : TReader);
    procedure WriteSectionEnd2(Writer : TWriter);
    procedure ReadSectionEnd2 (Reader : TReader);

    property SectionColor1 : TColor  read FSectionColor1 write SetSectionColor1 default clGreen;
    property SectionColor2 : TColor  read FSectionColor2 write SetSectionColor2 default clYellow;
    property SectionColor3 : TColor  read FSectionColor3 write SetSectionColor3 default clRed;
    property SectionColor4 : TColor  read FSectionColor4 write SetSectionColor4 default clYellow;
    property SectionColor5 : TColor  read FSectionColor5 write SetSectionColor5 default clYellow;
    property SectionCount  : Integer read FSectionCount  write SetSectionCount  default 0;
    property SectionEnd1   : Double  read FSectionEnd1   write SetSectionEnd1;
    property SectionEnd2   : Double  read FSectionEnd2   write SetSectionEnd2;
    property SectionEnd3   : Double  read FSectionEnd3   write SetSectionEnd3;
    property SectionEnd4   : Double  read FSectionEnd4   write SetSectionEnd4;

    procedure InsertEvent(Sender: Tobject);
    procedure RemoveEvent(Sender: Tobject);
    procedure ChangeEvent(Sender: Tobject);

    property PointerManager : TiGaugePointerManager read FPointerManager;

    procedure InitializePointer(iGaugePointer : TiGaugePointer); virtual;
    {$ifdef iVCL}
    procedure UpdateOPCSpecialList;                            override;
    function  OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean; override;
    {$endif}
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;

    function AddPointer: Integer;

    procedure RemoveAllPointers;
    procedure DeletePointer(Index: Integer);

    property PointerCount             : Integer        read GetPointerCount;
    property Pointers[Index: Integer] : TiGaugePointer read GetPointers;

    function GetPointersVisible (Index: Integer): Boolean;
    function GetPointersPosition(Index: Integer): Double;
    function GetPointersSize    (Index: Integer): Integer;
    function GetPointersColor   (Index: Integer): TColor;

    procedure SetPointersVisible (Index: Integer; Value: Boolean);
    procedure SetPointersPosition(Index: Integer; Value: Double);
    procedure SetPointersSize    (Index: Integer; Value: Integer);
    procedure SetPointersColor   (Index: Integer; Value: TColor);
  published
    property OnClickPointer: TIndexObjectEvent read FOnClickPointer write FOnClickPointer;
  end;

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

  FSectionColor1 := clGreen;
  FSectionColor2 := clYellow;
  FSectionColor3 := clRed;
  FSectionColor4 := clYellow;
  FSectionColor5 := clYellow;

  FSectionEnd1   := 50;
  FSectionEnd2   := 75;

  FPointerManager := TiGaugePointerManager.Create(ChangeEvent, InsertEvent, RemoveEvent);
  FPointerManager.Add;
end;
//****************************************************************************************************************************************************
destructor TiGaugeComponent.Destroy;
begin
  FPointerManager.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiGaugeComponent.SetSectionColor1(const Value: TColor);begin SetColorProperty  (Value,FSectionColor1,irtBackGround);end;
procedure TiGaugeComponent.SetSectionColor2(const Value: TColor);begin SetColorProperty  (Value,FSectionColor2,irtBackGround);end;
procedure TiGaugeComponent.SetSectionColor3(const Value: TColor);begin SetColorProperty  (Value,FSectionColor3,irtBackGround);end;
procedure TiGaugeComponent.SetSectionColor4(const Value: TColor);begin SetColorProperty  (Value,FSectionColor4,irtBackGround);end;
procedure TiGaugeComponent.SetSectionColor5(const Value: TColor);begin SetColorProperty  (Value,FSectionColor5,irtBackGround);end;
procedure TiGaugeComponent.SetSectionEnd1  (const Value: Double);begin SetDoubleProperty (Value,FSectionEnd1,  irtBackGround);end;
procedure TiGaugeComponent.SetSectionEnd2  (const Value: Double);begin SetDoubleProperty (Value,FSectionEnd2,  irtBackGround);end;
procedure TiGaugeComponent.SetSectionEnd3  (const Value: Double);begin SetDoubleProperty (Value,FSectionEnd3,  irtBackGround);end;
procedure TiGaugeComponent.SetSectionEnd4  (const Value: Double);begin SetDoubleProperty (Value,FSectionEnd4,  irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiGaugeComponent.SetSectionCount(const Value: Integer);
begin
  if FSectionCount <> Value then
    begin
      FSectionCount := Value;
      if FSectionCount < 0 then FSectionCount := 0;
      if FSectionCount > 5 then FSectionCount := 5;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugeComponent.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SectionEnd1_2', ReadSectionEnd1, WriteSectionEnd1, True);
  Filer.DefineProperty('SectionEnd2_2', ReadSectionEnd2, WriteSectionEnd2, True);

⌨️ 快捷键说明

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