3

ソフトウェアで一種のマルチカラーバーを作りたいです。プログレスバーの一種ですが、現在の値は2つです。

だから私はそれが必要です。私はいくつかの「予算パーツ」を持っており、それぞれに独自の制限（100 $、1000 $など）があります。また、新しい請求書を追加する（および請求書を予算パーツにリンクする）ための編集フォームもあります。このエディターでは、予算部分がどれだけいっぱいで、現在の請求書の価格がこの予算部分にどの程度影響するかを視覚的に表現したいと思います。

たとえば、バー全体が100ドルです。緑の部分は、保存された請求書全体の価格の合計を意味します（例：60ドル）。黄色の部分は、現在の請求書の価格を意味しますが、まだ保存されていません。たとえば、5ドルです。

このような：マルチパートプログレスバー

もちろん、値は動的に設定する必要があります。

これを描画するためのコンポーネントを教えてください（複数の現在の値を表示できる高度なプログレスバーかもしれません）。

4

3 に答える 3

4

デビッドが示唆しているように、自分でペイントするだけです。ほぼ同じ量のトラブル。TImageゲージが必要な場所にドロップして、次のようなものを使用します。

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に対して行うことは次のとおりです（私の画像は、表示されているとおりに意図的に変更されています）。

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;

ここに画像の説明を入力してください

于 2013-01-14T19:10:49.190 に答える
2

あなた自身を書いてください、それは楽しいです！しかし、それほど難しいことではありませんが、独自のコンポーネントを作成することは困難な作業のように見える可能性があります。特に初心者の使用または経験のない場合。

次のオプションは、自分で描画することです。したがって、意図されたコンポーネントは「常に」TPaintBoxコントロールである必要があります。OnPaintイベントハンドラーを実装すると、必要に応じて自身を再描画します。このようなペイントボックスをダブルゲージコンポーネントに変換する方法の実装例を次に示します。

type
  TDoubleGauge = record
    BackgroundColor: TColor;
    BorderColor: TColor;
    Color1: TColor;
    Color2: TColor;
    Value1: Integer;
    Value2: Integer;
    MaxValue: Integer;
  end;

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    FDoubleGauge: TDoubleGauge;
  end;

...

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  Box: TPaintBox absolute Sender;
  MaxWidth: Integer;
  Width1: Integer;
  Width2: Integer;
begin
  with FDoubleGauge do
  begin
    Box.Canvas.Brush.Color := BackgroundColor;
    Box.Canvas.Pen.Color := BorderColor;
    Box.Canvas.Rectangle(0, 0, Box.Width, Box.Height);
    if MaxValue <> 0 then
    begin
      MaxWidth := Box.Width - 2;
      Width1 := (MaxWidth * Value1) div MaxValue;
      Width2 := (MaxWidth * Value2) div MaxValue;
      Box.Canvas.Brush.Color := Color2;
      if Abs(Value2) < Abs(MaxValue) then
        Box.Canvas.FillRect(Rect(1, 1, Width2, Box.Height - 1));
      Box.Canvas.Brush.Color := Color1;
      if Abs(Value1) < Abs(Value2) then
        Box.Canvas.FillRect(Rect(1, 1, Width1, Box.Height - 1));
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDoubleGauge.BackgroundColor := clWhite;
  FDoubleGauge.BorderColor := clBlack;
  FDoubleGauge.Color1 := clGreen;
  FDoubleGauge.Color2 := clYellow;
  FDoubleGauge.Value1 := 50;
  FDoubleGauge.Value2 := 60;
  FDoubleGauge.MaxValue := 100;
  PaintBox1.Invalidate;
end;

まあ、それはかなりの努力のように見えます。特に、単一のフォームに必要なそのような二重ゲージがもっとある場合。したがって、私はCosmin Prundの答えが好きです。なぜなら、彼はTImage必要なときに再描画する必要があるものを「記憶」できるコンポーネントを使用しているからです。ボーナスとして、ここでは彼のコードの代替バージョン（無効な入力での動作がわずかに異なります）：

procedure DrawDoubleGauge(BackgroundColor, BorderColor, Color1, Color2: TColor;
  Value1, Value2, MaxValue: Integer; Img: TImage);
var
  Width: Integer;
  Width1: Integer;
  Width2: Integer;
begin
  Img.Canvas.Brush.Color := BackgroundColor;
  Img.Canvas.Pen.Color := BorderColor;
  Img.Canvas.Rectangle(0, 0, Img.Width, Img.Height);
  if MaxValue <> 0 then
  begin
    Width := Img.Width - 2;
    Width1 := (Width * Value1) div MaxValue;
    Width2 := (Width * Value2) div MaxValue;
    Img.Canvas.Brush.Color := Color2;
    if Abs(Value2) < Abs(MaxValue) then
      Img.Canvas.FillRect(Rect(1, 1, Width2, Img.Height - 1));
    Img.Canvas.Brush.Color := Color1;
    if Abs(Value1) < Abs(Value2) then
      Img.Canvas.FillRect(Rect(1, 1, Width1, Img.Height - 1));
  end;
end;
于 2013-01-14T20:54:27.430 に答える
1

私もこれを正確に探していました、私はこれにお金をかけたくないので、提案された解決策に従います、それにもかかわらず、誰かが高度なコンポーネントを望むなら、私はあまり高価ではなく、私の意見ではかなりまともなものを見つけました、他の誰かに役立つ可能性がある場合のリンクは次のとおりです。

http://www.tmssoftware.com/site/advprogr.asp?s=

ありがとうございます。

于 2013-10-03T17:03:21.907 に答える