itank.pas

Iocomp Ultra Pack v3.0.2 Sources.For.Delphi 数据显示编程插件,可用于工业控制

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

{$ifdef iVCL}unit  iTank;{$endif}
{$ifdef iCLX}unit QiTank;{$endif}

interface

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

type
  TiTankPointerStyle = (itpsBar, itpsCutOut1, itpsCutOut2, itpsLargeWindow, itpsCustom);

  TTankCustomPoint = class
  public
    X : Double;
    Y : Double;
  end;

  TiTank = class(TiPositionComponent)
  private
    FTankColor       : TColor;
    FTankShow        : Boolean;
    FTankShadowColor : TColor;
    FMaskingBitmap   : TBitmap;
    FPointerColor    : TColor;
    FPointerStyle    : TiTankPointerStyle;
    FOrientation     : TiOrientation;
    FOnAutoSize      : TNotifyEvent;
    FPointerReverse  : Boolean;
    FCustomList      : TStringList;
    FMaxPoint        : Double;
    FMinPoint        : Double;
  protected
    procedure SetTankColor      (const Value: TColor);
    procedure SetTankShow       (const Value: Boolean);
    procedure SetTankShadowColor(const Value: TColor);
    procedure SetPointerColor   (const Value: TColor);
    procedure SetPointerStyle   (const Value: TiTankPointerStyle);
    procedure SetOrientation    (const Value: TiOrientation);
    procedure SetPointerReverse (const Value: Boolean);

    procedure iPaintTo(Canvas: TCanvas);                          override;

    procedure DrawCutOut            (Canvas: TCanvas; AColor: TColor);

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

    function  CustomPointsAdd(X, Y: Double): Integer;
    procedure CustomPointsClear;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);   override;
  published
    property TankColor       : TColor             read FTankColor         write SetTankColor;
    property TankShadowColor : TColor             read FTankShadowColor   write SetTankShadowColor;
    property TankShow        : Boolean            read FTankShow          write SetTankShow;
    property PointerStyle    : TiTankPointerStyle read FPointerStyle      write SetPointerStyle;
    property PointerColor    : TColor             read FPointerColor      write SetPointerColor;
    property PointerReverse  : Boolean            read FPointerReverse    write SetPointerReverse;
    property Orientation     : TiOrientation      read FOrientation       write SetOrientation              default ioVertical;

    property BackGroundColor;
    property Transparent;
    property Width            default 90;
    property Height           default 200;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiTank.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width            := 90;
  Height           := 200;

  FTankColor       := clSilver;
  FTankShow        := True;
  FTankShadowColor := clGray;
  FPointerColor    := clBlue;
  FOrientation     := ioVertical;

  FMaskingBitmap   := TBitmap.Create;
  FCustomList      := TStringList.Create;

  FPointerStyle    := itpsCutOut1;
end;
//****************************************************************************************************************************************************
destructor TiTank.Destroy;
begin
  FCustomList.Free;
  FMaskingBitmap.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiTank.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Assigned(FMaskingBitmap) then
    begin
      FMaskingBitmap.Width  := Width;
      FMaskingBitmap.Height := Height;
    end;
end;
//****************************************************************************************************************************************************
procedure TiTank.SetTankColor      (const Value: TColor );begin SetColorProperty  (Value, FTankColor,       irtBackGround);end;
procedure TiTank.SetTankShadowColor(const Value: TColor );begin SetColorProperty  (Value, FTankShadowColor, irtBackGround);end;
procedure TiTank.SetPointerColor   (const Value: TColor );begin SetColorProperty  (Value, FPointerColor,    irtBackGround);end;
procedure TiTank.SetTankShow       (const Value: Boolean);begin SetBooleanProperty(Value, FTankShow,        irtBackGround);end;
procedure TiTank.SetPointerReverse (const Value: Boolean);begin SetBooleanProperty(Value, FPointerReverse,  irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiTank.SetPointerStyle(const Value: TiTankPointerStyle);
begin
  if FPointerStyle <> Value then
    begin
      FPointerStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiTank.SetOrientation(const Value: TiOrientation);
var
  TempWidth : Integer;
begin
  if FOrientation <> Value then
    begin
      FOrientation := Value;
      BackGroundChange;
      if not Loading then
        begin
          TempWidth := Width;
          Width     := Height;
          Height    := TempWidth;
          if Assigned(FOnAutoSize) then FOnAutoSize(Self);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiTank.iPaintTo(Canvas: TCanvas);
var
  i              : Integer;
  Bitmap         : TBitmap;
  MaxPixels      : Integer;
  MinPixels      : Integer;
  PositionPixels : Integer;
begin
  if FPointerStyle = itpsCustom then
    begin
      FMaxPoint := 0;
      FMinPoint := 100;

      for i := 0 to FCustomList.Count-1 do
        begin
          if (FCustomList.Objects[i] as TTankCustomPoint).Y > FMaxPoint then FMaxPoint := (FCustomList.Objects[i] as TTankCustomPoint).Y;
          if (FCustomList.Objects[i] as TTankCustomPoint).Y < FMinPoint then FMinPoint := (FCustomList.Objects[i] as TTankCustomPoint).Y;
        end;
    end
  else
    begin
      FMaxPoint := 90;
      FMinPoint := 10;
    end;

  with Canvas do
    begin
      if BackGroundChanged then
        begin
          CreateBackGroundBitmap;
                            DrawBackGround        (BackGroundBitmap.Canvas, BackGroundColor);
          if FTankShow then DrawGradientBackGround(BackGroundBitmap.Canvas);

          DrawCutOut(BackGroundBitmap.Canvas, PointerColor);

          FMaskingBitmap.Canvas.Brush.Style := bsSolid;
          FMaskingBitmap.Canvas.Brush.Color := clBlack;
          FMaskingBitmap.Canvas.FillRect(Rect(0, 0 ,Width, Height));
          DrawCutOut(FMaskingBitmap.Canvas, clWhite);

          ResetBackGroundChange;
        end;

      TransferBackGround(Canvas);

      Bitmap := TBitmap.Create;
      try
        Bitmap.Width  := Width;
        Bitmap.Height := Height;

        Bitmap.Canvas.Brush.Style := bsSolid;
        Bitmap.Canvas.Brush.Color := clWhite;
        Bitmap.Canvas.FillRect(Rect(0, 0 ,Width, Height));

        Bitmap.Canvas.Brush.Style := bsSolid;
        Bitmap.Canvas.Brush.Color := clBlack;
        Bitmap.Canvas.Pen.Color   := clBlack;

        case FOrientation of
          ioVertical : begin
                         MaxPixels      := Round(Height* FMinPoint/100);
                         MinPixels      := Round(Height* FMaxPoint/100);

                         if FPointerReverse then
                           begin
                             PositionPixels := Round(MaxPixels - PositionPercent*(MaxPixels-MinPixels));
                             Bitmap.Canvas.Rectangle(0, MaxPixels, Width, PositionPixels);
                           end
                         else
                           begin
                             PositionPixels := Round(PositionPercent*(MaxPixels-MinPixels) + MinPixels);
                             Bitmap.Canvas.Rectangle(0, PositionPixels, Width, MinPixels);
                           end;
                       end
          else         begin