ithermometer.pas

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

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

{$ifdef iVCL}unit  iThermometer;{$endif}
{$ifdef iCLX}unit QiThermometer;{$endif}

interface

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

type
  TiThermometerIndicatorStyle = (itisBulb, itisBar, itisBarSunken, itisBarRaised);

  TiThermometer = class(TiScaleComponent)
  private
    FBarRect                     : TRect;
    FCenterPoint                 : TPoint;

    FIndicatorColor              : TColor;
    FIndicatorWidth              : Integer;
    FOrientation                 : TiOrientation;
    FOrientationTickMarks        : TiOrientationSide;
    FEndsMargin                  : Integer;
    FIndicatorBulbSize           : Integer;
    FIndicatorBackGroundColor    : TColor;

    FCurrentMaxRect              : TRect;
    FCurrentMinRect              : TRect;
    FMovingMin                   : Boolean;
    FMovingMax                   : Boolean;
    FMouseDownX                  : Integer;
    FMouseDownY                  : Integer;
    FOldCurrentValue             : Double;

    FIndicatorStyle              : TiThermometerIndicatorStyle;
    FAutoCenter                  : Boolean;
    FReverseScale                : Boolean;
    FIndicatorFillReferenceStyle : TiPointerFillReferenceStyle;
    FIndicatorFillReferenceValue : Double;
    FOnAutoSize                  : TNotifyEvent;

    procedure SetOrientationTickMarks       (const Value: TiOrientationSide);
    procedure SetOrientation                (const Value: TiOrientation);
    procedure SetEndsMargin                 (const Value: Integer);
    procedure SetIndicatorWidth             (const Value: Integer);
    procedure SetIndicatorColor             (const Value: TColor);
    procedure SetIndicatorBulbSize          (const Value: Integer);
    procedure SetIndicatorBackGroundColor   (const Value: TColor);
    procedure SetIndicatorStyle             (const Value: TiThermometerIndicatorStyle);
    procedure SetAutoCenter                 (const Value: Boolean);
    procedure SetReverseScale               (const Value: Boolean);
    procedure SetIndicatorFillReferenceStyle(const Value: TiPointerFillReferenceStyle);
    procedure SetIndicatorFillReferenceValue(const Value: Double);
  protected
    procedure DrawTicks        (Canvas: TCanvas);
    procedure DrawIndicatorBulb(Canvas: TCanvas);
    procedure DrawIndicatorBox (Canvas: TCanvas);
    procedure DrawLimits       (Canvas: TCanvas);
    procedure DrawPointer      (Canvas: TCanvas; Position: Double; Margin, Size: Integer; DrawScaleSide: Boolean; AColor: TColor; var PositionRect: TRect);

    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;
    procedure CalcPoints;

    function  GetCenterPoint(Canvas: TCanvas): TPoint;                              override;
    function  GetPositionPixels(Value : Double) : Integer;
    function  GetTravelRange : Integer;

    property OnAutoSize                  : TNotifyEvent                read FOnAutoSize                  write FOnAutoSize;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property IndicatorWidth              : Integer                     read FIndicatorWidth              write SetIndicatorWidth           default 2;
    property IndicatorBulbSize           : Integer                     read FIndicatorBulbSize           write SetIndicatorBulbSize        default 6;
    property IndicatorStyle              : TiThermometerIndicatorStyle read FIndicatorStyle              write SetIndicatorStyle           default itisBulb;
    property EndsMargin                  : Integer                     read FEndsMargin                  write SetEndsMargin               default 10;
    property IndicatorColor              : TColor                      read FIndicatorColor              write SetIndicatorColor           default clRed;
    property IndicatorBackGroundColor    : TColor                      read FIndicatorBackGroundColor    write SetIndicatorBackGroundColor default clMaroon;
    property Orientation                 : TiOrientation               read FOrientation                 write SetOrientation              default ioVertical;
    property OrientationTickMarks        : TiOrientationSide           read FOrientationTickMarks        write SetOrientationTickMarks     default iosBottomRight;
    property AutoCenter                  : Boolean                     read FAutoCenter                  write SetAutoCenter               default True;
    property ReverseScale                : Boolean                     read FReverseScale                write SetReverseScale             default False;

    property IndicatorFillReferenceStyle : TiPointerFillReferenceStyle read FIndicatorFillReferenceStyle write SetIndicatorFillReferenceStyle;
    property IndicatorFillReferenceValue : Double                      read FIndicatorFillReferenceValue write SetIndicatorFillReferenceValue;

    property BackGroundColor;
    property BorderStyle;
    property OffsetX;
    property OffsetY;
    property CachedDrawing;
    property Transparent;

    property ShowTicksMajor;
    property ShowTicksMinor;
    property ShowTickLabels;
    property TickMajorCount;
    property TickMajorColor;
    property TickMajorLength          default 10;
    property TickMajorStyle;
    property TickMinorAlignment;
    property TickMinorCount;
    property TickMinorColor;
    property TickMinorLength          default 6;
    property TickMinorStyle;
    property TickMargin               default 8;
    property TickLabelMargin;
    property TickLabelFont;
    property TickLabelPrecision;
    property PrecisionStyle;
    property OnCustomizeTickLabel;

    property ShowTicksMajorFirstLast;
    property ShowMaxPointer;
    property ShowMinPointer;
    property MinMaxPointerSize;
    property MinMaxPointerMargin      default 5;
    property MaxPointerColor;
    property MinPointerColor;
    property BackGroundPicture;
    property MinMaxUserCanMove;

    property AutoScaleEnabled;
    property AutoScaleDesiredTicks;
    property AutoScaleMaxTicks;
    property AutoScaleStyle;
    property Width                    default 100;
    property Height                   default 150;
  end;

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

  Width               := 100;
  Height              := 150;
  TickMajorLength     := 10;
  TickMinorLength     := 6;
  TickMargin          := 8;
  MinMaxPointerMargin := 5;

  FEndsMargin               := 10;
  FAutoCenter               := True;

  FIndicatorWidth           := 2;
  FIndicatorColor           := clRed;
  FIndicatorBulbSize        := 6;
  FIndicatorBackGroundColor := clMaroon;

  CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
procedure TiThermometer.SetIndicatorWidth             (const Value:Integer);begin SetIntegerProperty(Value,FIndicatorWidth,             irtBackGround);end;
procedure TiThermometer.SetIndicatorColor             (const Value:TColor); begin SetColorProperty  (Value,FIndicatorColor,             irtBackGround);end;
procedure TiThermometer.SetEndsMargin                 (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin,                 irtBackGround);end;
procedure TiThermometer.SetAutoCenter                 (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter,                 irtBackGround);end;
procedure TiThermometer.SetIndicatorBulbSize          (const Value:Integer);begin SetIntegerProperty(Value,FIndicatorBulbSize,          irtBackGround);end;
procedure TiThermometer.SetIndicatorBackGroundColor   (const Value:TColor); begin SetColorProperty  (Value,FIndicatorBackGroundColor,   irtBackGround);end;
procedure TiThermometer.SetReverseScale               (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale,               irtBackGround);end;
procedure TiThermometer.SetIndicatorFillReferenceValue(const Value:Double );begin SetDoubleProperty (Value,FIndicatorFillReferenceValue,irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiThermometer.SetOrientationTickMarks(const Value: TiOrientationSide);
begin
  if FOrientationTickMarks<>Value then
    begin
      FOrientationTickMarks := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiThermometer.SetIndicatorStyle(const Value: TiThermometerIndicatorStyle);
begin
  if FIndicatorStyle <> Value then
    begin
      FIndicatorStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiThermometer.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;
//****************************************************************************************************************************************************
procedure TiThermometer.SetIndicatorFillReferenceStyle(const Value: TiPointerFillReferenceStyle);
begin
  if FIndicatorFillReferenceStyle <> Value then
    begin
      FIndicatorFillReferenceStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
function TiThermometer.GetPositionPixels(Value: Double): Integer;
begin
  with FBarRect do
    case FOrientation of
      ioVertical   : begin
                       case FReverseScale and (FIndicatorStyle <> itisBulb) of
                         False : Result := Bottom - Round((Bottom - Top) * ValuePercent(Value));
                         else    Result := Top    + Round((Bottom - Top) * ValuePercent(Value));
                       end;
                     end;
      else           begin
                       case FReverseScale and (FIndicatorStyle <> itisBulb) of
                         False : Result := Left  + Round((Right - Left) * ValuePercent(Value));
                         else    Result := Right - Round((Right - Left) * ValuePercent(Value));
                       end;
                     end;
    end;
end;
//****************************************************************************************************************************************************
function TiThermometer.GetTravelRange : Integer;
var
  DrawRect : TRect;
begin
  DrawRect := Rect(0, 0 ,Width, Height);
  with DrawRect do