Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi ProgressBar als VUMeter (https://www.delphipraxis.net/103264-progressbar-als-vumeter.html)

iron 13. Nov 2007 13:30


ProgressBar als VUMeter
 
Ich versuche eine ProgressBar als VuMeter zu realisieren .

Ich hab zwar eine passende LEDMeter Kompo von picsoft nur hab ich da problem mit der richtigen anzeige des effektes.

Ich versuche also bei einer Progressbar diesen drei Farben Effekt zu bekommen.

Ich möchte das er von Position zu position Farben ändert.

Delphi-Quellcode:
for a:= 0 to 20000 do
 if Form1.ProgressBar1.Position =a then SendMessage(Form1.ProgressBar1.Handle, BAR_CONST, 0, clLime);
for b:= 20000 to 28000 do
 if Form1.ProgressBar1.Position =b then SendMessage(Form1.ProgressBar1.Handle, BAR_CONST, 0, clYellow);
for c:= 28000 to 32768 do
 if Form1.ProgressBar1.Position =c then SendMessage(Form1.ProgressBar1.Handle, BAR_CONST, 0, clRed);
So ändert er zwar die Farbe ab der gewünschten Position, nur nicht im drei farben stil sondern komplett ab position die ganze ProgressBar.

Ich wollte es mal mit ner Progressbar probieren weil ich das Problem mit dieser obengenannter Kompo schonmal hier erwähnt hatte.

Kennt jemand ne passende Lösung oder vielleicht ne Kompo die mit diesen 32768 klar kommt?

matashen 13. Nov 2007 13:37

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

Gruß matthias

Deep-Sea 13. Nov 2007 13:48

Re: ProgressBar als VUMeter
 
Zitat:

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 :P


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:51 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz