具有两个或更多当前值的Delphi进度条

我想在我的软件中制作一种多色条.一种进度条,但有两个当前值.

这就是我需要它的原因.
我有一些“预算部分”,每个都有自己的限制(100美元,1000美元等)
我还有一个编辑表格,用于添加新账单(以及将账单链接到预算部分).
在这个编辑器中,我想直观地表示预算部分的完整程度,以及当前账单的价格对预算部分的影响程度.

例如,整个栏是100 $.
绿色部分表示已存储账单中的价格总和,例如60美元.
黄色部分表示当前账单的价格,尚未保存,例如5 $.

像这样：

当然,值应该动态设置.

你能推荐我用于绘制这个的任何组件(可能是一些高级进度条,可以显示多个当前值吗？)

解决方法

正如大卫所说,只是自己画画.几乎相同的麻烦.将T Image放在您想要仪表的位置,并使用以下内容：

procedure PaintTwoColorGauge(const BackgroundColor,BorderColor,FirstGaugeColor,SecondGaugeColor: TColor; FirstGaugeValue,SecondGaugeValue,TotalValue: Integer; const Img: TImage);
var B: TBitmap;
    ImgWidth,G1Width,G2Width: Integer;
begin
  B := TBitmap.Create;
  try
    B.Width := Img.Width;
    B.Height := Img.Height;
    B.Canvas.Brush.Color := BackgroundColor;
    B.Canvas.Brush.Style := bsSolid;
    B.Canvas.Pen.Style := psClear;
    B.Canvas.Pen.Width := 1;
    B.Canvas.FillRect(Rect(0,B.Width,B.Height));

    if TotalValue <> 0 then
    begin
      ImgWidth := B.Width - 2; // Don't account the width of the borders.
      G1Width := (FirstGaugeValue * ImgWidth) div TotalValue;
      G2Width := (SecondGaugeValue * ImgWidth) div TotalValue;
      if G1Width > ImgWidth then G1Width := ImgWidth; // Just in case
      if G2Width > ImgWidth then G2Width := ImgWidth;

      if G2Width > G1Width then
        begin
          B.Canvas.Brush.Color := SecondGaugeColor;
          B.Canvas.FillRect(Rect(0,G2Width,B.Height));

          B.Canvas.Brush.Color := FirstGaugeColor;
          B.Canvas.FillRect(Rect(0,B.Height));
        end
      else
        begin
          B.Canvas.Brush.Color := FirstGaugeColor;
          B.Canvas.FillRect(Rect(0,B.Height));

          B.Canvas.Brush.Color := SecondGaugeColor;
          B.Canvas.FillRect(Rect(0,B.Height));
        end;

    end;

    B.Canvas.Pen.Color := BorderColor;
    B.Canvas.Pen.Style := psSolid;
    B.Canvas.Brush.Style := bsClear;
    B.Canvas.Rectangle(0,B.Height);

    Img.Picture.Assign(B);

  finally B.Free;
  end;
end;

例如,以下是此代码对我的3 TImages的作用(我的图像在您看到它们时有意擦除)：

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintTwoColorGauge(clWhite,clBlack,clGreen,clYellow,50,55,100,Image1);
  PaintTwoColorGauge(clWhite,60,Image2);
  PaintTwoColorGauge(clWhite,20,Image3);
end;