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

📄 qiprogresscomponent.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
字号:
{*******************************************************}
{                                                       }
{       TiProgressComponent Component                   }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iProgressComponent;{$endif}
{$ifdef iCLX}unit QiProgressComponent;{$endif}

interface

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

type
  TiProgressComponent = class(TiPositionComponent)
  private
    FShowOffSegments : Boolean;
    FSectionColor1   : TColor;
    FSectionColor2   : TColor;
    FSectionColor3   : TColor;
    FSectionEnd1     : Double;
    FSectionEnd2     : Double;
    FSectionCount    : Integer;
  protected
    procedure SetSectionColor1  (const Value : TColor);
    procedure SetSectionColor2  (const Value : TColor);
    procedure SetSectionColor3  (const Value : TColor);
    procedure SetSectionEnd1    (const Value : Double);
    procedure SetSectionEnd2    (const Value : Double);
    procedure SetSectionCount   (const Value : Integer);
    procedure SetShowOffSegments(const Value : Boolean);

    procedure DefineProperties(Filer : TFiler);   override;
    procedure WriteSectionEnd1(Writer : TWriter);
    procedure ReadSectionEnd1 (Reader : TReader);
    procedure WriteSectionEnd2(Writer : TWriter);
    procedure ReadSectionEnd2 (Reader : TReader);
  public
    constructor Create(AOwner: TComponent);      override;
  published
    property BackGroundColor;
    property SectionColor1   : TColor  read FSectionColor1   write SetSectionColor1   default clLime;
    property SectionColor2   : TColor  read FSectionColor2   write SetSectionColor2   default clYellow;
    property SectionColor3   : TColor  read FSectionColor3   write SetSectionColor3   default clRed;
    property SectionEnd1     : Double  read FSectionEnd1     write SetSectionEnd1;
    property SectionEnd2     : Double  read FSectionEnd2     write SetSectionEnd2;
    property SectionCount    : Integer read FSectionCount    write SetSectionCount    default 1;
    property ShowOffSegments : Boolean read FShowOffSegments write SetShowOffSegments default True;
  end;

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

  Width  := 16;
  Height := 200;

  FSectionCount    := 1;
  FSectionColor1   := clLime;
  FSectionColor2   := clYellow;
  FSectionColor3   := clRed;
  FSectionEnd1     := 50;
  FSectionEnd2     := 75;
  FShowOffSegments := True;
end;
//****************************************************************************************************************************************************
procedure TiProgressComponent.SetSectionColor1  (const Value: TColor );begin SetColorProperty  (Value,FSectionColor1,  irtInvalidate);end;
procedure TiProgressComponent.SetSectionColor2  (const Value: TColor );begin SetColorProperty  (Value,FSectionColor2,  irtInvalidate);end;
procedure TiProgressComponent.SetSectionColor3  (const Value: TColor );begin SetColorProperty  (Value,FSectionColor3,  irtInvalidate);end;
procedure TiProgressComponent.SetSectionEnd1    (const Value: Double );begin SetDoubleProperty (Value,FSectionEnd1,    irtInvalidate);end;
procedure TiProgressComponent.SetSectionEnd2    (const Value: Double );begin SetDoubleProperty (Value,FSectionEnd2,    irtInvalidate);end;
procedure TiProgressComponent.SetShowOffSegments(const Value: Boolean);begin SetBooleanProperty(Value,FShowOffSegments,irtInvalidate);end;
//****************************************************************************************************************************************************
procedure TiProgressComponent.SetSectionCount(const Value: Integer);
begin
  if (Value < 1) or (Value > 3) then exit;
  if FSectionCount <> Value then
    begin
      FSectionCount := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiProgressComponent.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SectionEnd1_2', ReadSectionEnd1, WriteSectionEnd1, True);
  Filer.DefineProperty('SectionEnd2_2', ReadSectionEnd2, WriteSectionEnd2, True);
end;
//****************************************************************************************************************************************************
procedure TiProgressComponent.ReadSectionEnd1(Reader: TReader);begin FSectionEnd1 := Reader.ReadFloat;end;
procedure TiProgressComponent.ReadSectionEnd2(Reader: TReader);begin FSectionEnd2 := Reader.ReadFloat;end;
//****************************************************************************************************************************************************
procedure TiProgressComponent.WriteSectionEnd1(Writer: TWriter);begin Writer.WriteFloat(FSectionEnd1);end;
procedure TiProgressComponent.WriteSectionEnd2(Writer: TWriter);begin Writer.WriteFloat(FSectionEnd2);end;
//****************************************************************************************************************************************************
end.

⌨️ 快捷键说明

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