ipercentbar.pas

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

procedure TiPercentBar.SetItemValue(Index: Integer; const Value: Double);
var
  TempValue : Double;
begin
  if Value < 0 then TempValue := 0 else TempValue := Value;
  if (Index < 0) or (Index > FItemList.Count) then raise Exception.Create('Item Index out of Bounds');
  (FitemList.Objects[Index] as TiPercentItemObject).Value := TempValue;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.SetTitleHorizontalAlignment(const Value: TiTitleHorizontalAlignment);
begin
  if FTitleHorizontalAlignment <> Value then
    begin
      FTitleHorizontalAlignment := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Items', ReadItems, WriteItems, DoWriteItems);
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.ReadItems(Reader: TReader);
var
  iPercentItemObject : TiPercentItemObject;
begin
  ClearList;
  Reader.ReadListBegin;
  while not Reader.EndOfList do
    begin
      iPercentItemObject := TiPercentItemObject.Create;
      FItemList.AddObject('', iPercentItemObject);
      iPercentItemObject.Title := Reader.ReadString;

      Reader.ReadListBegin;
      iPercentItemObject.Color := Reader.ReadInteger;
      iPercentItemObject.Value := Reader.ReadFloat;
      Reader.ReadListEnd
    end;
  Reader.ReadListEnd;
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.WriteItems(Writer: TWriter);
var
  x                  : Integer;
  iPercentItemObject : TiPercentItemObject;
begin
  Writer.WriteListBegin;
  for x := 0 to FItemList.Count - 1 do
    begin
      iPercentItemObject := FItemList.Objects[x] as TiPercentItemObject;
      Writer.WriteString (iPercentItemObject.Title);
      Writer.WriteListBegin;
      Writer.WriteInteger(iPercentItemObject.Color);
      Writer.WriteFloat(iPercentItemObject.Value);
      Writer.WriteListEnd;
    end;
  Writer.WriteListEnd;
end;
//****************************************************************************************************************************************************
function TiPercentBar.DoWriteItems: Boolean;
begin
  Result := FItemList.Count <> 0;
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.iPaintTo(Canvas: TCanvas);
var
  ATextString        : String;
  ATextRect          : TRect;
  AWidth             : Integer;
  YPoint             : Integer;
  x                  : Integer;
  iPercentItemObject : TiPercentItemObject;
  LegendLeft         : Integer;
  LegendRowHeight    : Integer;
  LegendHeight       : Integer;
  LegendWidth        : Integer;
  TotalValue         : Double;
  ItemPercent        : Double;
  PreviousY          : Double;
  BarCenterX         : Integer;
  BarHeight          : Integer;
  BarRect            : TRect;
  TitleHeight        : Integer;
  TitleWidth         : Integer;
  TitleCenterX       : Integer;
  MaxTitleWidth      : Integer;
  MaxValueWidth      : Integer;
  MaxPercentWidth    : Integer;
  ShowTitle          : Boolean;
begin
  with Canvas do
    begin
      DrawBackGround(Canvas, BackGroundColor);

      Font.Assign(FTitleFont);
      Brush.Style := bsSolid;
      Pen.Style   := psSolid;

      ShowTitle := Length(Trim(FTitleText)) > 0;
      if ShowTitle then TitleHeight := TextHeight('ABC') + FTitleMargin else  TitleHeight := 0;

      if FItemList.Count <> 0 then
        begin
          TotalValue      := 0;
          for x := 0 to FItemList.Count - 1 do
            TotalValue := TotalValue + (FItemList.Objects[x] as TiPercentItemObject).Value;

          MaxTitleWidth   := 0;
          MaxValueWidth   := 0;
          MaxPercentWidth := 0;

          Font.Assign(FLegendFont);
          for x := 0 to FItemList.Count - 1 do
            begin
              iPercentItemObject  := FItemList.Objects[x] as TiPercentItemObject;

              AWidth := TextWidth(Trim(iPercentItemObject.Title));
              if AWidth > MaxTitleWidth then MaxTitleWidth := AWidth;

              AWidth := TextWidth(Format('%.' + IntToStr(FLegendValuePrecision) + 'f', [iPercentItemObject.Value]));
              if AWidth > MaxValueWidth then MaxValueWidth := AWidth;

              if TotalValue = 0 then
                AWidth := TextWidth(Format('%.' + IntToStr(FLegendPercentPrecision) + 'f', [1/FItemList.Count*100]) + '%')
              else
                AWidth := TextWidth(Format('%.' + IntToStr(FLegendPercentPrecision) + 'f', [iPercentItemObject.Value/TotalValue*100]) + '%');
              if AWidth > MaxPercentWidth then MaxPercentWidth := AWidth;
            end;

          LegendWidth := 20 + FLegendMargin + MaxTitleWidth;
          if FLegendShowPercent then LegendWidth := LegendWidth + MaxPercentWidth;
          if FLegendShowValue   then LegendWidth := LegendWidth + MaxValueWidth;

          BarCenterX := (Width - LegendWidth) div 2;
          BarHeight  := Height - 2*FOuterMargin - TitleHeight;
          BarRect    := Rect(BarCenterX - FBarWidth div 2, FOuterMargin, BarCenterX + FBarWidth - FBarWidth div 2, FOuterMargin + BarHeight);

          LegendLeft      := BarCenterX + FBarWidth div 2 + FLegendMargin;
          LegendRowHeight := TextHeight('ABC');
          LegendHeight    := (FItemList.Count * LegendRowHeight);
          YPoint          := (BarRect.Top + BarRect.Bottom) div 2 - LegendHeight div 2 + LegendRowHeight div 2;
          Font.Assign(FLegendFont);
          PreviousY := BarRect.Top;

          for x := 0 to FItemList.Count - 1 do
            begin
              iPercentItemObject   := FItemList.Objects[x] as TiPercentItemObject;
              Brush.Color          := iPercentItemObject.Color;
              Brush.Style          := bsSolid;
              Pen.Color            := iPercentItemObject.Color;

              if TotalValue = 0 then ItemPercent := 1/FItemList.Count
              else                   ItemPercent := iPercentItemObject.Value / TotalValue;

              FillRect(Rect(BarRect.Left, Round(PreviousY), BarRect.Right, Round(PreviousY + ItemPercent*BarHeight)));
              PreviousY            := PreviousY + ItemPercent*BarHeight;

              Rectangle(LegendLeft + 5, Round(YPoint - 2), LegendLeft + 15, Round(YPoint + 2)); //Color Line

              Brush.Style := bsClear;

              ATextString := Trim(iPercentItemObject.Title);
              ATextRect   := Rect(LegendLeft  + 20, YPoint - LegendRowHeight div 2, Width - 5, YPoint + LegendRowHeight div 2);
              TextOut(ATextRect.Left, ATextRect.Top, ATextString);

              if FLegendShowValue then
                begin
                  ATextString      := Format('%.' + IntToStr(FLegendValuePrecision) + 'f', [iPercentItemObject.Value]);
                  ATextRect.Left   := ATextRect.Left + MaxTitleWidth + FLegendValueMargin;
                  ATextRect.Right  := ATextRect.Left + MaxValueWidth;
                  TextOut(ATextRect.Right - TextWidth(ATextString), ATextRect.Top, ATextString);
                end
              else
                begin
                  ATextRect.Left   := ATextRect.Left + MaxTitleWidth;
                  ATextRect.Right  := ATextRect.Left;
                end;

              if FLegendShowPercent then
                begin
                  if TotalValue = 0 then
                    ATextString := Format('%.' + IntToStr(FLegendPercentPrecision) + 'f', [1/FItemList.Count*100]) + '%'
                  else
                    ATextString := Format('%.' + IntToStr(FLegendPercentPrecision) + 'f', [iPercentItemObject.Value/TotalValue*100]) + '%';
                    
                  ATextRect.Left   := ATextRect.Right + FLegendPercentMargin;
                  ATextRect.Right  := ATextRect.Left + MaxPercentWidth;
                  TextOut(ATextRect.Right - TextWidth(ATextString), ATextRect.Top, ATextString);
                end;

              YPoint := YPoint + LegendRowHeight;
            end;
        end
      else
        begin
          BarCenterX     := Width  div 2;  //Required if Item Count = 0
          BarRect.Bottom := Height div 2; //Required if Item Count = 0
        end;

      if ShowTitle then
        begin
          Font.Assign(FTitleFont);
          ATextString  := Trim(FTitleText);
          TitleCenterX := BarCenterX;
          TitleWidth   := TextWidth(FTitleText);
          case FTitleHorizontalAlignment of
            ithaCenterDisplay : TitleCenterX := BarCenterX;
            ithaCenterControl : TitleCenterX := Width div 2;
          end;
          Brush.Style := bsClear;
          TextOut(TitleCenterX - TitleWidth div 2, BarRect.Bottom + FTitleMargin, ATextString);
        end;
    end;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
function TiPercentBar.OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean;
var
  x : Integer;
begin
  Result := inherited OPCNewDataSpecial(iOPCItem);

  for x := 0 to FItemList.Count-1 do
    if UpperCase('Item(' + IntToStr(x) + ').Value') = UpperCase(iOPCItem.PropertyName) then
      begin
        Result := True;
        SetItemValue(x, iOPCItem.Data);
      end;
end;
//****************************************************************************************************************************************************
procedure TiPercentBar.UpdateOPCSpecialList;
var
  x : Integer;
begin
  if not Assigned(OPCSpecialList) then Exit;
  OPCSpecialList.Clear;
  for x := 0 to FItemList.Count-1 do
    OPCSpecialList.Add('Item(' + IntToStr(x) + ').Value');
end;
{$endif}
//****************************************************************************************************************************************************
end.