ispectrumdisplay.pas

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

procedure TiSpectrumDisplay.SetOuterMarginBottom(const Value: Integer);
begin
  if FOuterMarginBottom <> Value then
    begin
      FOuterMarginBottom := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetOuterMarginLeft(const Value: Integer);
begin
  if FOuterMarginLeft <> Value then
    begin
      FOuterMarginLeft := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetOuterMarginRight(const Value: Integer);
begin
  if FOuterMarginRight <> Value then
    begin
      FOuterMarginRight := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetOuterMarginTop(const Value: Integer);
begin
  if FOuterMarginTop <> Value then
    begin
      FOuterMarginTop := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetBarCount(const Value: Integer);
begin
  if (Value < 1) or (Value > 1024) then raise Exception.Create('Bar Count must be between 1 and 1024');
  if FBarCount <> Value then
    begin
      FBarCount := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetBarSpacing(const Value: Integer);
begin
  if FBarSpacing <> Value then
    begin
      FBarSpacing := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetBarWidth(const Value: Integer);
begin
  if FBarWidth <> Value then
    begin
      FBarWidth := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.iSetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
    begin
      FAutoSize := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.DoAutoSize;
begin
  if FDoingAutoSize              then Exit;
  if csLoading in ComponentState then Exit;

  if FAutoSize then
    begin
      FDoingAutoSize := True;
      try
        with Canvas do
          begin
            Width := FOuterMarginLeft + FOuterMarginRight + FBarCount*(FBarWidth) + (FBarCount-1)*FBarSpacing + 2*BorderMargin;
          end;
        if Assigned(FOnAutoSize) then FOnAutoSize(Self);
      finally
        FDoingAutoSize := False;
      end;
    end;
end;
//****************************************************************************************************************************************************
function TiSpectrumDisplay.GetBarValue(Index: Integer): Double;
begin
  Result := FData[Index].Value;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetBarValue(Index: Integer; const Value: Double);
begin
  if (Index < 0) or (Index > FBarCount - 1) then raise Exception.Create('Index out of Bounds');
  FData[Index].Value := Value;
  if Value > FData[Index].Peak then
    begin
      FData[Index].Peak           := Value;
      FData[Index].PeakUpdateTime := Now;
    end;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
function TiSpectrumDisplay.GetBarXColor(Index: Integer): TColor;
begin
  if (Index < 0) or (Index > FBarCount - 1) then raise Exception.Create('Index out of Bounds');
  Result := FData[Index].Color;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.SetBarXColor(Index: Integer; const Value: TColor);
begin
  if (Index < 0) or (Index > FBarCount - 1) then raise Exception.Create('Index out of Bounds');
  FData[Index].Color := Value;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.DecayTimerEvent(Sender: TObject);
var
  x : Integer;
begin
  for x := 0 to FBarCount - 1 do
    begin
      if FData[x].Peak > FData[x].Value then
        if Now > (FData[x].PeakUpdateTime + FDecayInitialDelay/(24*60*60*1000)) then
          begin
            FData[x].Peak := FData[x].Peak - (FScaleMax - FScaleMin)/100;
            if FData[x].Peak < FData[x].Value then FData[x].Peak := FData[x].Value;
            InvalidateChange;
          end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.CalcRects;
begin
//  FBarWidth  := (Width - 2*BorderMargin - FOuterMarginLeft - FOuterMarginRight) div FBarCount - FBarSpacing;
  FStartLeft := (Width - 2*BorderMargin - FOuterMarginLeft - FOuterMarginRight - FBarCount*(FBarWidth) - (FBarCount-1)*FBarSpacing) div 2 + FOuterMarginLeft + BorderMargin;
  FBarBottom := Height - FOuterMarginBottom - BorderMargin;
  FBarHeight := Height - FOuterMarginTop - FOuterMarginBottom - 2*BorderMargin;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.iPaintTo(Canvas: TCanvas);
var
  x      : Integer;
  ALeft  : Integer;
  ATop   : Integer;
  AValue : Double;
begin
  with Canvas do
    begin
      DrawBackGround(Canvas, BackGroundColor);

      if (FScaleMax - FScaleMin) = 0 then Exit;

      CalcRects;

      ALeft := FStartLeft;

      for x := 0 to FBarCount - 1 do
        begin
          Brush.Color := GetBarXColor(x);
          Pen.Color   := GetBarXColor(x);

          AValue := FData[x].Value;

          if AValue > FScaleMax then AValue := FScaleMax;
          if AValue < FScaleMin then AValue := FScaleMin;

          ATop := FBarBottom - Round(FBarHeight * (AValue - FScaleMin)/(FScaleMax - FScaleMin));
          if FBarWidth = 1 then
            begin
              Polyline([Point(ALeft, ATop), Point(ALeft, FBarBottom)]);
            end
          else
            begin
              Rectangle(ALeft, ATop, ALeft + FBarWidth, FBarBottom);
            end;
          ALeft := ALeft + FBarWidth + FBarSpacing;
        end;

      if FPeakShow then
        begin
          ALeft     := FStartLeft;
          Pen.Color := FPeakLineColor;

          for x := 0 to FBarCount - 1 do
            begin
              if FData[x].Peak > FData[x].Value then
                begin
                  AValue := FData[x].Peak;

                  if AValue > FScaleMax then AValue := FScaleMax;
                  if AValue < FScaleMin then AValue := FScaleMin;

                  ATop := FBarBottom - Round(FBarHeight * (AValue - FScaleMin)/(FScaleMax - FScaleMin));

                  PolyLine([Point(ALeft, ATop), Point(ALeft + FBarWidth, ATop)]);
                end;
              ALeft := ALeft + FBarWidth + FBarSpacing;
            end;
        end;
    end;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
function TiSpectrumDisplay.OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean;
var
  x : Integer;
begin
  Result := inherited OPCNewDataSpecial(iOPCItem);

  for x := 0 to FBarCount-1 do
    if UpperCase('Bar(' + IntToStr(x) + ').Value') = UpperCase(iOPCItem.PropertyName) then
      begin
        Result := True;
        BarValue[x] := iOPCItem.Data;
      end;
end;
//****************************************************************************************************************************************************
procedure TiSpectrumDisplay.UpdateOPCSpecialList;
var
  x : Integer;
begin
  if not Assigned(OPCSpecialList) then Exit;
  OPCSpecialList.Clear;
  for x := 0 to FBarCount-1 do
    OPCSpecialList.Add('Bar(' + IntToStr(x) + ').Value');
end;
{$endif}
//****************************************************************************************************************************************************
end.