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

📄 qilineargauge.pas

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

{$ifdef iVCL}unit  iLinearGauge;{$endif}
{$ifdef iCLX}unit QiLinearGauge;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iGaugePointer,  iGaugeComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiGaugePointer, QiGaugeComponent;{$ENDIF}

type
  TiLinearGauge = class(TiGaugeComponent)
  private
    FBarRect              : TRect;

    FOrientation          : TiOrientation;
    FOrientationTickMarks : TiOrientationSide;
    FEndsMargin           : Integer;
    FShowTicksAxis        : Boolean;
    FReverseScale         : Boolean;

    FMouseDownX           : Integer;
    FMouseDownY           : Integer;
    FOldCurrentValue      : Double;
    FOnAutoSize           : TNotifyEvent;
    FPointerOverlap       : Integer;
    FAutoCenter           : Boolean;
    FCenterOffsetX        : Integer;
    FCenterOffsetY        : Integer;

    FMinPointer           : TiGaugePointer;
    FMaxPointer           : TiGaugePointer;

    procedure SetOrientationTickMarks(const Value: TiOrientationSide);
    procedure SetOrientation         (const Value: TiOrientation);
    procedure SetEndsMargin          (const Value: Integer);
    procedure SetShowTicksAxis       (const Value: Boolean);
    procedure SetReverseScale        (const Value: Boolean);
    procedure SetAutoCenter          (const Value: Boolean);

    procedure CalcPoints;
    procedure CalcAutoCenterOffsets;

    function  GetTravelRange : Integer;
    property  TravelRange : Integer read GetTravelRange;
    function  GetPositionPixels(Value : Double) : Integer;

    procedure SetPointerStyle        (const Value: TiLinearGaugePointerStyle);
    procedure SetPointerSize         (const Value: Integer);
    procedure SetPointerColor        (const Value: TColor);
    procedure SetPointerOffSet       (const Value: Integer);

    function GetPointerStyle  : TiLinearGaugePointerStyle;
    function GetPointerSize   : Integer;
    function GetPointerColor  : TColor;
    function GetPointerOffSet : Integer;
  protected
    procedure DrawTicks    (Canvas: TCanvas);
    procedure DrawSections (Canvas: TCanvas);
    procedure DrawIndicator(Canvas: TCanvas);
    procedure DrawPointer  (Canvas: TCanvas; APointer: TiGaugePointer);
    procedure DrawMinMax   (Canvas: TCanvas);
    procedure DrawLimits   (Canvas: TCanvas);

    procedure InitializePointer(iGaugePointer : TiGaugePointer); override;

    procedure iPaintTo(Canvas: TCanvas);                                           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;

    property OnAutoSize           : TNotifyEvent              read FOnAutoSize           write FOnAutoSize;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;

    function GetPointersOffSet(Index: Integer): Integer;
    function GetPointersStyle (Index: Integer): TiLinearGaugePointerStyle;

    procedure SetPointersOffSet(Index: Integer; Value: Integer);
    procedure SetPointersStyle(Index: Integer; Value: TiLinearGaugePointerStyle);
  published
    property EndsMargin           : Integer                   read FEndsMargin           write SetEndsMargin            default 10;
    property Orientation          : TiOrientation             read FOrientation          write SetOrientation           default ioVertical;
    property OrientationTickMarks : TiOrientationSide         read FOrientationTickMarks write SetOrientationTickMarks  default iosBottomRight;

    property PointerStyle         : TiLinearGaugePointerStyle read GetPointerStyle       write SetPointerStyle          default ilgpsPointer;
    property PointerSize          : Integer                   read GetPointerSize        write SetPointerSize           default 10;
    property PointerColor         : TColor                    read GetPointerColor       write SetPointerColor          default clBlack;
    property PointerOffSet        : Integer                   read GetPointerOffSet      write SetPointerOffSet         default 0;

    property ShowTicksAxis        : Boolean                   read FShowTicksAxis        write SetShowTicksAxis         default True;
    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 CachedDrawing;
    property Transparent;
    property OffsetX;
    property OffsetY;

    property TickMajorStyle;
    property TickMinorStyle;

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

    property SectionColor1;
    property SectionColor2;
    property SectionColor3;
    property SectionColor4;
    property SectionColor5;
    property SectionCount;
    property SectionEnd1;
    property SectionEnd2;
    property SectionEnd3;
    property SectionEnd4;

    property ShowMaxPointer;
    property ShowMinPointer;
    property MinMaxPointerSize;
    property MinMaxPointerMargin;
    property MaxPointerColor;
    property MinPointerColor;

    property MinMaxUserCanMove;

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

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

  Width           := 60;
  Height          := 200;
  TickMajorLength := 20;
  TickMinorLength := 7;
  TickMargin      := 0;

  FEndsMargin     := 10;
  FShowTicksAxis  := True;

  FMinPointer     := TiGaugePointer.Create(nil);
  FMaxPointer     := TiGaugePointer.Create(nil);

  CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
destructor TiLinearGauge.Destroy;
begin
  FMinPointer.Free;
  FMaxPointer.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetEndsMargin    (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin,   irtBackGround);end;
procedure TiLinearGauge.SetShowTicksAxis (const Value:Boolean);begin SetBooleanProperty(Value,FShowTicksAxis,irtBackGround);end;
procedure TiLinearGauge.SetReverseScale  (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale, irtBackGround);end;
procedure TiLinearGauge.SetAutoCenter    (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter,   irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetOrientationTickMarks(const Value: TiOrientationSide);
begin
  if FOrientationTickMarks <> Value then
    begin
      FOrientationTickMarks := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetOrientation(const Value: TiOrientation);
var
  TempWidth : Integer;
begin
  if FOrientation <> Value then
    begin
      FOrientation := Value;
      if not Loading then
        begin
          TempWidth := Width;
          Width     := Height;
          Height    := TempWidth;
          if Assigned(FOnAutoSize) then FOnAutoSize(Self);
        end;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
function TiLinearGauge.GetTravelRange : Integer;
var
  DrawRect : TRect;
begin
  DrawRect := Rect(0, 0 ,Width, Height);
  with DrawRect do
    case Forientation of
      ioHorizontal : Result := Right  - Left - (2 * FEndsMargin);
      ioVertical   : Result := Bottom - Top  - (2 * FEndsMargin);
      else           Result := 0;
    end;
end;

⌨️ 快捷键说明

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