두 개 이상의 현재 값이있는 Delphi 진행 표시 자

Question

내 소프트웨어에서 일종의 멀티 컬러 막대를 만들고 싶습니다. 일종의 진도 표시기이지만 두 가지 현재 값이 있습니다.

그래서 내가 필요한 이유입니다. 나는 "예산 편성표"를 가지고 있으며, 각자 자신의 한도액 (100 $, 1000 $ 등)을 가지고 있습니다. 또한 새 청구서를 추가하고 예산 부분에 청구서를 연결하는 편집 양식이 있습니다. 이 편집자에서는 예산 부분이 얼마나 충만하고 현재 청구서의 얼마 가격이이 예산 부분에 영향을 미치는지 시각적으로 나타내고 싶습니다.

예를 들어, 전체 막대는 100 $입니다. 녹색 부분은 저장된 지폐의 가격 합계를 의미합니다 (예 : 60 $). 노란색 부분은 현재 청구서의 가격을 의미하며, 아직 저장되지 않았습니다 (예 : 5 $). 이처럼

: 물론

는, 값이 동적으로 설정해야합니다.

는이 그리기 나에게 어떤 구성 요소를 추천 할 수 (어쩌면 일부 고급 진행 막대를, 그 이상의 현재 값을 표시 할 수 있습니까?)

Answer 1

을 데이비드에서 알 수 있듯이, 그냥 직접 페인트. 거의 같은 양의 문제. 당신이 당신의 게이지를 원하는 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; 

를 여기 (당신이 그들을 볼로 내 이미지가 의도적으로 shpaed있다)이 코드는 제 3 TImages에 수행 내용은 다음과 같습니다

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; 

Answer 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; 

글쎄, 꽤 많은 노력처럼 보입니다. 특히 단일 형태로 필요한 더듬 거리는 게이지가 더 많을 때. 따라서 그가 TImage 구성 요소를 사용하기 때문에 Cosmin Prund's answer을 좋아합니다. 필요한 경우 다시 그려야 할 부분을 "암기"할 수 있습니다. 그냥 여기에 보너스 (잘못된 입력에 약간 다른 행동) 그의 다른 코드 버전으로 :

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; 

Answer 3

나는이 I에 돈을 보내고 싶지 않아 나는 또한, 정확히 찾고 있었다

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

: 사람이 내가 너무 비싸 아니라 내 의견으로는 꽤 괜찮은 모양 하나를 발견하는 고급 구성 요소를 원하는 그럼에도 불구 경우, 제안 된 솔루션을 따를 것이다, 여기 경우 링크는 다른 사람이 유용 할 수 있어요

감사합니다.