正如David所建议的那样,自己来绘制吧。几乎同样麻烦。将 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;
G1Width := (FirstGaugeValue * ImgWidth) div TotalValue;
G2Width := (SecondGaugeValue * ImgWidth) div TotalValue;
if G1Width > ImgWidth then G1Width := ImgWidth;
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;
![enter image description here](https://istack.dev59.com/FERH9.webp)
TGauge
组件源代码(在Delphi安装文件夹中的..\source\Samples\Delphi\Gauges.pas
)作为编写进度条组件的起点。 - kludg