Prozentualer Fortschritt als Text in ProgressBar...

[FriFra]

Ich würde gern den prozentualen Fortschritt als Text in der Mitte einer Progressbar anzeigen. Ich weiß, das TGauge das kann, jedoch wird diese nicht von der von mir verwendeten Skinengine (suiskin) "geskinnt", weshalb ich den Text nun gern irgendwie auf eine normale Progressbar packen würde :gruebel:

[CalganX]

Hi,
du könntest über Canvas draufmalen. Ansonsten könntest du auch noch gucken, ob das PSDK irgendwas hergibt in diese Richtung. Zum Beispiel irgendeine Nachricht, die das automatisch macht, die aber nicht von der VCL gekapselt wurde oder sowas.

Chris

[Luckie]

Einfach auf den Canvas der Progressbar schreiben:

Delphi-Quellcode:

procedure foo(Progressbar: TProgressbar; const Text: String);
var
  dc: HDC;
  rect: TRect;
begin
  dc := GetWindowDC(Progressbar.Handle);
  GetClientRect(Progressbar.Handle, rect);
  SetBkMode(dc, TRANSPARENT);
  DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
  InvalidateRect(Progressbar.Handle, @rect, True);
end;

Man müsste das natürlich noch verfeinern, damit er eine andere Farbe für die Schrift nimmt, wenn der balken unter dem Text liegt. Aber etwas kannst du ja auch selber machen. ;)

[FriFra]

Danke Luckie ;)

Ich hab den Code noch etwas angepasst...

Delphi-Quellcode:

procedure TDupFind_Main.WritePercent(Progressbar: TProgressbar);
var
  dc: HDC;
  rect: TRect;
  Text: string;
begin
  if (ProgressBar.Max = 0) or (ProgressBar.Position = 0) then
    Text := '0%'
  else if ProgressBar.Max = ProgressBar.Position then
    Text := '100%'
  else
    Text := IntToStr(Trunc(100 / ProgressBar.Max * ProgressBar.Position)) + '%';
  dc := GetWindowDC(Progressbar.Handle);
  rect := ProgressBar.ClientRect;
  SetBkMode(dc, TRANSPARENT);
  DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER or
    DT_CENTER);
  InvalidateRect(Progressbar.Handle, @rect, True);
end;

Die procedure rufe ich nun bei jedem Setzen der Position auf. 3 Probleme hab ich allerdings noch:
1. Wie ändere ich die Textfarbe? "SetDCBrushColor(dc,clred);" funktioniert jedenfalls nicht...
2. Wie ändere ich den Textstyle? Jetzt ist der Text immer Fett...
3. Es ist alles stark am Flimmern. Bei jedem neuzeichnen des Progressbar wird der Text wieder weggebügelt

[Luckie]

1.: SetTextColor
2.: CreateFont, SelectObject. Würd eich aber am Anfang einmal in den DC der Progressbar selektieren und nicht jedes mal.
3.: Bei meinem Code flackert nichts, auch wenn sie schnell läuft. Nachtrag: Dein Code flackert bei mir auch nicht. Löst du irgendwo anders noch irgendwelche Repaints aus?

[omata]

Moin,

alternativ gibt es auch eine fertige Komponente (im Reiter Beispiele) -> Gauge.

MfG
Thorsten

[CalganX]

Hi,

Zitat:

Zitat von FriFra

Ich weiß, das TGauge das kann, jedoch wird diese nicht von der von mir verwendeten Skinengine (suiskin) "geskinnt",

wer lesen kann, ist klar im Vorteil. :zwinker:

Chris

[omata]

Ups, sorry - du hast recht

[FriFra]

Zitat:

Zitat von Luckie

1.: SetTextColor
2.: CreateFont, SelectObject. Würd eich aber am Anfang einmal in den DC der Progressbar selektieren und nicht jedes mal.
3.: Bei meinem Code flackert nichts, auch wenn sie schnell läuft. Nachtrag: Dein Code flackert bei mir auch nicht. Löst du irgendwo anders noch irgendwelche Repaints aus?

Danke für die Tips ;)
1. und 2. hab ich hinbekommen.

3. Der Code flackert Doch!
Also hier ist nun meine aktuelle procedure:

Delphi-Quellcode:

procedure TDupFind_Main.WritePercent(Progressbar: TProgressbar);
var
  dc: HDC;
  myfont: Cardinal;
  rect: TRect;
  Text: string;
begin
  if (ProgressBar.Max = 0) or (ProgressBar.Position = 0) then
    Text := '0%'
  else if ProgressBar.Max = ProgressBar.Position then
    Text := '100%'
  else
    Text := IntToStr(Trunc(100 / ProgressBar.Max * ProgressBar.Position)) + '%';
  dc := GetWindowDC(Progressbar.Handle);

  myfont := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH,
    'Verdana');

  SetBkMode(dc, TRANSPARENT);
  SetTextColor(dc, clBlack);
  SelectObject(dc, myfont);

  rect := ProgressBar.ClientRect;
  SetBkMode(dc, TRANSPARENT);
  DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER or
    DT_CENTER);
  InvalidateRect(Progressbar.Handle, @rect, True);
end;

Der Aufruf erfolgt bei mir so:

Delphi-Quellcode:

          ProgressBar1.Position := FCnt;
          WritePercent(ProgressBar1);

Beim Setzen der Position wird die Progressbar neu gezeichnet und damit mein Text überzeichnet, durch das anschließende neu schreiben des Textes entsteht ein ziemlich nerviger Flimmereffekt...

[turboPASCAL]

wer zuletzt kommt... folge dem Link... http://www.delphipraxis.net/internal...=411076#411076

Kann auch % Text Darstellen und ist bei den Farben variabel.

[FriFra]

Ich hab gerade mal die folgende Zeile rausgenommen:

Delphi-Quellcode:

InvalidateRect(Progressbar.Handle, @rect, True);

Jetzt ist das Flimmern weg :-D :roll:

[Luckie]

Tut mir leid, das kann ich nicht bestätigen. Und ich habe dir doch geasgt, du sollst die Schrift einmal setzen und nicht jedes mal, wenn du den Text setzt. Hm, das scheint irgendwie nicht so ganz zu funktionieren, zumindest im OnCreate der Form nicht.

Dann löst du irgendwo anders noch ein Repaint oder Refresh aus, was dann natürlich doppelt ist. Ich brauche das, weil sonst der Text nur ein schwarzen Rechteck ist.

[Luckie]

Zitat:

Zitat von turboPASCAL

wer zuletzt kommt... folge dem Link... http://www.delphipraxis.net/internal...=411076#411076

Kann auch % Text Darstellen und ist bei den Farben variabel.

Da diese Progressbar auch wohl komplett selber gezeichnte wird, wird es wohl ähnliche Probleme mit seiner Skinning Komponente geben.

[FriFra]

Zitat:

Zitat von Luckie

Tut mir leid, das kann ich nicht bestätigen. Und ich habe dir doch geasgt, du sollst die Schrift einmal setzen und nicht jedes mal, wenn du den Text setzt. Hm, das scheint irgendwie nicht so ganz zu funktionieren, zumindest im OnCreate der Form nicht.

Dann löst du irgendwo anders noch ein Repaint oder Refresh aus, was dann natürlich doppelt ist. Ich brauche das, weil sonst der Text nur ein schwarzen Rechteck ist.

Also ich nehme an, dass suiSkin den einen oder anderen zusätzlichen Repaint auslöst... Ich muss die Schrift jedenfalls jedes mal neu setzen, da ich sonst immer Fetten schwarzen Text mit weißem Hintergrund habe ;) ... aber jetzt läuft ja alles...

[Luckie]

Was für eine Farbe hat denn dein Fortschrittsbalken? Ach so, zum Schluss bitte noch ReleaseDC aufrufen.

[turboPASCAL]

Zitat:

Zitat von Luckie

Zitat:

Zitat von turboPASCAL

wer zuletzt kommt... folge dem Link... http://www.delphipraxis.net/internal...=411076#411076

Kann auch % Text Darstellen und ist bei den Farben variabel.

Da diese Progressbar auch wohl komplett selber gezeichnte wird, wird es wohl ähnliche Probleme mit seiner Skinning Komponente geben.

Sie ist.

Delphi-Quellcode:

TQProgressBar = class(TCustomControl)

[FriFra]

Zitat:

Zitat von Luckie

Was für eine Farbe hat denn dein Fortschrittsbalken?

Über dem ProgressBar liegt ein Farbverlauf ;)
http://www.frifra.de/Temp/progressbar.jpg

[jfheins]

Könntest du nicht einfach die WM_PAINT-Message der Progressbar abfangen (WndProc umbiegen ?), weitersenden, und dann nochmal deine Prozentzahl draufpinseln ?
(Dann wäre die Zeit ohne Prozentzahl am geringsten)

[Luckie]

Zitat:

Zitat von FriFra

Zitat:

Zitat von Luckie

Was für eine Farbe hat denn dein Fortschrittsbalken?

Über dem ProgressBar liegt ein Farbverlauf ;)
http://www.frifra.de/Temp/progressbar.jpg

Hmpf, du mogelst. Ich dachte du hättest das Problem mit der Schriftfarbe irgendwie gelöst. :roll:

[FriFra]

Hab ich auch ;) wenn ich z.B: clRed verwende, dann wird die Schrift auch rot...

[Luckie]

Ja, nee, schon klar. ;)

Ich meine, wenn der Balken hinter der Schrift ist, dass sie dann die Farbe wechselt, dass man sie noch lesen kann.

[FriFra]

Das Problem habe ich nicht... der Balken hat ja eine Farbe, wo man die Schrift genauso sieht wie auf dem Hintergrund ;)

[jfheins]

Und alle ignorieren Sie mich :? :evil: :cry:
(Schon das 2. Thema in dieser Woche ...)

So geht es:
(zumindest bei mir)

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ComCtrls, StdCtrls, xpman;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
      { Private-Deklarationen }
      OldProgressWndProc: TWndMethod; 
      procedure ProgressWndProc(var Msg: TMessage);
   public
      { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.ProgressWndProc(var Msg: TMessage);
var 
  dc: HDC; 
  rect: TRect; 
begin
   OldProgressWndProc (Msg);

   if Msg.Msg = WM_PAINT then
// Wenn die Progressbar neugezeichnet wurde,
// und somit die Zahl weg ist: Prozentzahl neu draufpinseln
   begin
      dc := GetWindowDC(Progressbar1.Handle);
      Windows.GetClientRect(Progressbar1.Handle, rect);
      SetBkMode(dc, TRANSPARENT);
      DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
                  // vll. noch       ReleaseDC(Progressbar1.Handle, dc);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   OldProgressWndProc := ProgressBar1.WindowProc;
   ProgressBar1.WindowProc := ProgressWndProc;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   repeat
      ProgressBar1.StepIt;
      Application.ProcessMessages;
      Sleep (50);
   until ProgressBar1.Position = 100;
end;

end.

Weitestgehend ohne Flimmern, ich habs jetzt aber nicht mit suiskin (oder wie das heißt) ausprobiert ...

[Luckie]

Warum der Umstand? Aber gut, so geht es auch.

[jfheins]

Ich kenne jetzt nicht diese Skinkompo, aber so wird die Prozentzahl immer draufgepinselt, und nicht nur, wenn er .StepIt aufruft und dann die Prozentzahl neu draufmalt ;)

(Sie könnte sich ja zwischendurch neuzeichnen)

[FriFra]

jfheins: Ich hab jetzt mal Deinen Code getestet... das Problem ist nur, dass mein Progressbar niemals die Message WM_PAINT bekommt...

[FriFra]

Also, jetzt hab ich's hinbekommen...

Delphi-Quellcode:

  if (Msg.Msg = 1026) or (Msg.Msg = WM_PAINT) then

WM_PAINT hab ich zwar drin gelassen, aber diese Message ist bei meinen Tests noch nie bei meiner Progressbar angekommen. Die relevante Message ist 1026, was das für eine Message sein soll hab ich noch nicht rausbekommen...

[ManuMF]

Für faule Leute wie mich :angel2: gibt es auch die Bars aus der JEDI-VCL.
Bei manchen steht der Fortschritt auch drauf.

[FriFra]

Soweit läuft ja jetzt alles schonmal ganz gut...
Wenn ich allerdings die SkinEngine deaktiviere, wird der Hintergrund der Progressbar nätürlich nicht aktualisiert und das ganze sieht dann so aus:
http://www.frifra.de/Temp/progressbar2.jpg

Wenn ich "SetBkMode(dc, TRANSPARENT);" deaktiviere kann man den Text zwar lesen, aber man hat natürlich einen weißen Hintergrund:
http://www.frifra.de/Temp/progressbar3.jpg

Wenn ich nun vorher "InvalidateRect(Progressbar1.Handle, @rect, True);" aufrufe gibt es ein fürchterliches geflimmer...

[Daniel G]

mal 'ne blöde Zwischenfrage:

Wenn das mit deiner Skin - Kompo so derbe Probleme gibt, warum packst du die Prozentzahl als Label denn nicht neben die Progressbar?

[FriFra]

MIT der Kompo gibt's ja gerade keine Probleme ;)
http://www.frifra.de/Temp/progressbar.jpg

nur wenn die Kompo nicht Aktiv ist, also OHNE Kompo gibts Probleme:
http://www.frifra.de/Temp/progressbar2.jpg

[FriFra]

:x Irgend etwas an meiner procedure "frisst" Systemresourcen... Der Speicherverbrauch ist normal, aber es kommt auf einigen Rechnern zu Abstürzen mit der Meldung "Systemresourcen erschöpft". Wenn ich die procedure nicht benutze indem ich das "Umbiegen" der WndProc auskommentiere tritt das Problem nicht mehr auf :?

Delphi-Quellcode:

procedure TTest_Main.FormCreate(Sender: TObject);
var
 ...
begin
  ...
  OldProgressWndProc := ProgressBar1.WindowProc;
  ProgressBar1.WindowProc := ProgressWndProc;
  ...
end;  


procedure TTest_Main.ProgressWndProc(var Msg: TMessage);
var
  dc: HDC;
  rect: TRect;
  myfont: Cardinal;
  Text: string;
begin
  OldProgressWndProc(Msg);

  if ((Msg.Msg = 1026) or (Msg.Msg = WM_PAINT)) and (ProgressBar1.Min = 0) then
    // Wenn die Progressbar neugezeichnet wurde,
    // und somit die Zahl weg ist: Prozentzahl neu draufpinseln
  begin
    if (ProgressBar1.Max = 0) or (ProgressBar1.Position = 0) then
      Text := '0%'
    else if ProgressBar1.Max = ProgressBar1.Position then
      Text := '100%'
    else
      Text := IntToStr(Trunc(100 / ProgressBar1.Max * ProgressBar1.Position)) +
        '%';
    dc := GetWindowDC(Progressbar1.Handle);
    try
      rect := ProgressBar1.ClientRect;
      //InvalidateRect(Progressbar1.Handle, @rect, True);
      myfont := CreateFont(-11, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET,
        OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH,
        'Verdana');
      if suiSkinEngine1.Active = True then
        SetBkMode(dc, TRANSPARENT);
      SetTextColor(dc, clBlack);
      SelectObject(dc, myfont);
      DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER
        or DT_CENTER);
    finally
      ReleaseDC(Progressbar1.Handle, dc);
    end;
  end;
end;

[Luckie]

Zu jedem SelectObject gehört auch ein DeleteObjert.

[FriFra]

:oops: :wall: ja wo er recht hat, hat er recht der Luckie ;), Danke

[FriFra]

Bisher lief alles wunderbar... Jetzt kam ein Update der Skin-Komponente und nun wird mein drüber gemalter Test immer wieder gelöscht (flackern) :?
Hat jemand eine Idee, wie ich sofort nach dem Neuzeichnen meinenText wiederdrübergebügelt bekomme, ohne dass es fackert?