ProgressBar als VUMeter

[Deep-Sea]

Zitat von matashen:

Kannst du dich da nicht im Draw-ereigniss einklinken und selber zeichnen, dann kannst du selber für jeden Effekt sorgen.

Naja wenn dann würde ich sagen: Ganz alleine machen ^^ also von TGraphicControl ableiten ...
Oh, da fällt mir ein, ich hab da irgendwo noch was rumliegen ...

Delphi-Quellcode:

unit ULEDMeter;

interface

uses Windows, Classes, Controls, Graphics;

type
  TLEDMeter = class(TGraphicControl)
  private
    FPosition: integer;
    FBarWidth: integer;
    FZone1: integer;
    FZone2: integer;
    FZone1Color: integer;
    FZone2Color: integer;
    FZone3Color: integer; 
    procedure SetPosition(Value: integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Color;
    property Position: integer read FPosition write SetPosition;
    property BarWidth: integer read FBarWidth write FBarWidth;
    property Zone1: integer read FZone1 write FZone1;
    property Zone2: integer read FZone2 write FZone2;
    property Zone1Color: integer read FZone1Color write FZone1Color;
    property Zone2Color: integer read FZone2Color write FZone2Color;
    property Zone3Color: integer read FZone3Color write FZone3Color;
  end;

implementation

{ TLEDMeter }

constructor TLEDMeter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 25;
  Height := 150;
  FPosition := 0;
  FBarWidth := 5;
  FZone1 := 70;
  FZone2 := 90;
  FZone1Color := clLime;
  FZone2Color := clYellow;
  FZone3Color := clRed;
end;

destructor TLEDMeter.Destroy;
begin
  inherited Destroy;
end;

procedure TLEDMeter.SetPosition(Value: integer);
begin
  if (FPosition <> Value) and (FPosition in [0..100]) then begin
    FPosition := Value;
    Paint;
  end;
end;

procedure TLEDMeter.Paint;
var
  i, Pos, BarCount: integer;
  Bar: TBitmap;
begin
  Bar := TBitmap.Create;
  Bar.Width := Width;
  Bar.Height := Height;
  Bar.Canvas.Brush.Color := Color;
  Bar.Canvas.FillRect(Rect(0, 0, Width, Height));
  Bar.Canvas.Pen.Width := 1;

  if Height > Width then BarCount := Height else BarCount := Width;

  for i := 0 to BarCount do
  begin
    Pos := (i * 100) div BarCount;
    if Pos < FPosition then
    begin
      if i mod (FBarWidth + 1) = FBarWidth then Bar.Canvas.Pen.Color := Color
      else begin
        if Pos < FZone1 then Bar.Canvas.Pen.Color := FZone1Color;
        if (Pos >= FZone1) and (Pos < FZone2) then Bar.Canvas.Pen.Color := FZone2Color;
        if Pos >= FZone2 then Bar.Canvas.Pen.Color := FZone3Color;
      end;

      if Height > Width then
      begin
        Bar.Canvas.PenPos := Point(0, Height-i);
        Bar.Canvas.LineTo(Width, Height-i);
      end else begin
        Bar.Canvas.PenPos := Point(i, 0);
        Bar.Canvas.LineTo(i, Height);
      end;
    end else break;
  end;

  Canvas.CopyRect(Rect(0, 0, Width,Height), Bar.Canvas,Rect(0, 0, Width, Height));
  Bar.Free;
end;

end.

Ohne Garantie und ganz böse auf 3 Farben beschränkt ... aber vlt. geht es ja