iloggauge.pas

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

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

{$ifdef iVCL}unit  iLogGauge;{$endif}
{$ifdef iCLX}unit QiLogGauge;{$endif}

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

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

    FOrientation          : TiOrientation;
    FOrientationTickMarks : TiOrientationSide;
    FEndsMargin           : Integer;
    FShowTicksAxis        : Boolean;
    FTickLabelStyle       : TiLogLabelStyle;
    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 SetPointerStyle        (const Value: TiLinearGaugePointerStyle);
    procedure SetPointerSize         (const Value: Integer);
    procedure SetPointerColor        (const Value: TColor);
    procedure SetShowTicksAxis       (const Value: Boolean);
    procedure SetPointerOffSet       (const Value: Integer);
    procedure SetTickLabelStyle      (const Value: TiLogLabelStyle);
    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;

    function GetPointerColor : TColor;
    function GetPointerOffSet: Integer;
    function GetPointerSize  : Integer;
    function GetPointerStyle : TiLinearGaugePointerStyle;
  protected
    procedure SetPositionMin(const Value : Double); override;

    procedure DrawTicks    (Canvas: TCanvas);
    procedure DrawTickAxis (Canvas: TCanvas);
    procedure DrawSections (Canvas: TCanvas);
    procedure DrawIndicator(Canvas: TCanvas);
    procedure DrawMinMax   (Canvas: TCanvas);
    procedure DrawLimits   (Canvas: TCanvas);
    procedure DrawPointer  (Canvas: TCanvas; APointer: TiGaugePointer);

    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 PointerOffSet        : Integer                   read GetPointerOffSet      write SetPointerOffSet        default 0;
    property PointerColor         : TColor                    read GetPointerColor       write SetPointerColor         default clBlack;
    property PointerSize          : Integer                   read GetPointerSize        write SetPointerSize          default 10;
    property PointerStyle         : TiLinearGaugePointerStyle read GetPointerStyle       write SetPointerStyle         default ilgpsPointer;

    property ShowTicksAxis        : Boolean                   read FShowTicksAxis        write SetShowTicksAxis        default True;
    property TickLabelStyle       : TiLogLabelStyle           read FTickLabelStyle       write SetTickLabelStyle       default illsValue;
    property ReverseScale         : Boolean                   read FReverseScale         write SetReverseScale         default False;
    property AutoCenter           : Boolean                   read FAutoCenter           write SetAutoCenter           default False;

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

    property TickMajorStyle;
    property TickMinorStyle;

    property TickMajorColor;
    property TickMajorLength       default 20;
    property TickMinorAlignment;
    property TickMinorColor;
    property TickMinorLength       default 7;
    property TickMargin            default 0;
    property TickLabelMargin;
    property TickLabelFont;
    property TickLabelPrecision;
    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 Width                 default 60;
    property Height                default 200;
  end;

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

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

  FEndsMargin     := 10;

  FShowTicksAxis  := True;

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

  CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
destructor TiLogGauge.Destroy;
begin
  FMinPointer.Free;
  FMaxPointer.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.SetEndsMargin    (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin,   irtBackGround);end;
procedure TiLogGauge.SetShowTicksAxis (const Value:Boolean);begin SetBooleanProperty(Value,FShowTicksAxis,irtBackGround);end;
procedure TiLogGauge.SetReverseScale  (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale, irtBackGround);end;
procedure TiLogGauge.SetAutoCenter    (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter,   irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiLogGauge.SetOrientationTickMarks(const Value: TiOrientationSide);
begin
  if FOrientationTickMarks <> Value then
    begin
      FOrientationTickMarks := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.SetTickLabelStyle(const Value: TiLogLabelStyle);
begin
  if FTickLabelStyle <> Value then
    begin
      FTickLabelStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.SetPositionMin(const Value: Double);
begin
  if Value <= 0 then raise Exception.Create('Position Min must be greater than 0');
  inherited SetPositionMin(Value);
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.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 TiLogGauge.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;
//****************************************************************************************************************************************************
function TiLogGauge.GetPositionPixels(Value : Double) : Integer;
var
  DrawRect    : TRect;
  Distance    : Integer;
begin
  DrawRect := Rect(0, 0 ,Width, Height);
  Distance := Round(TravelRange * (Log10(Value) - Log10(PositionMin))/(Log10(PositionMax) - Log10(PositionMin)));

  with DrawRect do
    case Forientation of
      ioVertical   : begin
                       case FReverseScale of
                         False : Result := Bottom - FEndsMargin - Distance;