具有两个或多个当前值的Delphi进度栏 [英] Delphi progressbar with two or more current values

问题描述

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

I want to make a kind of multi-color bar in my software. A kind of progressbar, but with two current values.

这就是为什么我需要它。
我有一些预算部分，每个部分都有其自己的限制（100 $，1000 $等）。
我也有一个编辑表单，用于添加新帐单（并将帐单链接到预算）部分）。
在此编辑器中，我想直观地表示预算部分的满额以及当前账单的价格会影响该预算部分。

That's why I need it. I have some "budget parts", and each one of them has its own limit (100$, 1000$ etc.) I also have an editing form for adding new bills (and linking bills to budget parts). In this editor I want to visually represent how full is a budget part, and how much price of current bill affects this budget part.

例如，整个酒吧是100美元。
绿色部分表示已保存的帐单的价格总和，例如60 $。
黄色部分表示当前账单的价格，尚未保存，例如5 $。

For example, the whole bar is 100$. Green part means sum of prices across saved bills, for example 60$. Yellow part means price of the current bill, which is not saved yet, for example 5$.

就像这样：

当然，值应该动态设置。

Of course, values should be set dynamically.

您能为我推荐用于绘制此图形的任何组件吗（也许是一些高级进度条，可以显示多个当前值？）

Can you recommend me any components for drawing this (maybe some advanced progressbar, that can display more than one current value?)

推荐答案

正如David所建议的那样，只需自己绘制即可。麻烦的程度差不多。将 TImage 放到您想要的仪表上，并使用类似这样的东西：

As David suggests, just paint it yourself. Just about the same amount of trouble. Drop a TImage where you want your gauge and use something like this:

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, 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, 0, G2Width, B.Height));

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

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

    end;

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

    Img.Picture.Assign(B);

  finally B.Free;
  end;
end;

例如，这是此代码对我的3个TImage的作用（如您所见，我的图像被故意切成碎片他们）：

For example, here's what this code does to my 3 TImages (my images are intentionally shpaed as you see them):

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

这篇关于具有两个或多个当前值的Delphi进度栏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！