Displaying text on a TProgressBar

Hi,

I would like to know how to display text on a TProgressBar in Delphi 4 Professional.  I was hoping to display some centred text such as "50% (10k of 20k) transferred" on the face of the TProgressBar.  However, there doesn't appear to be a Caption or Text property to specify the text.

I tried to position a label over it and use that to display the text, however the label always appears behind the TProgressBar, so this doesn't seem to work.

Any ideas?

Thanks in Advance,

Richard
Richard2000Asked:
Who is Participating?
 
TOndrejCommented:
Here's a quick example using TProgressBar:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    FProgressBarWndProc: TWndMethod;
    procedure ProgressBar1WndProc(var Message: TMessage);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ProgressBar1WndProc(var Message: TMessage);
var
  Canvas: TCanvas;
  R: TRect;
  B: TBitmap;
begin
  case Message.Msg of
    WM_PAINT:
      with ProgressBar1 do
      begin
        Canvas := TCanvas.Create;
        try
          Canvas.Handle := GetDC(Handle);
          try
            // erase background
            R := ClientRect;
            Canvas.Brush.Color := Color;
            Canvas.FillRect(R);
            // let the progressbar paint itself
            FProgressBarWndProc(Message);
            // draw text
            B := TBitmap.Create;
            try
              B.Width := R.Right - R.Left;
              B.Height := R.Bottom - R.Top;
              B.Canvas.Brush.Color := clBlack;
              B.Canvas.FillRect(R);
              B.Canvas.Font := Self.Font;
              B.Canvas.Font.Color := clWhite;
              DrawText(B.Canvas.Handle, PChar(Format('%.0f%%',
                [100 * Position / Max])), -1, R, DT_NOCLIP or DT_CENTER);
              BitBlt(Canvas.Handle, 0, 0, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCINVERT);
            finally
              B.Free;
            end;
          finally
            ReleaseDC(Handle, Canvas.Handle);
          end;
        finally
          Canvas.Free;
        end;
      end;
    else
      FProgressBarWndProc(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FProgressBarWndProc := ProgressBar1.WindowProc;
  ProgressBar1.WindowProc := ProgressBar1WndProc;
  ProgressBar1.Smooth := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ProgressBar1.WindowProc := FProgressBarWndProc;
  FProgressBarWndProc := nil;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  with Sender as TTrackBar do
    ProgressBar1.Position := Position;
end;

end.

HTH
TOndrej
0
 
AloneCommented:
Try to set Transparent property of the label to True

WBR...
0
 
DrDelphiCommented:
use a TGauge instead... you'll find it on the Samples tab.


Good luck!!
0
 
freshman3kCommented:
Hello!

Try any of these, they are gradient and it includes a caption property and its free.

Here is the link to downloads(all have what you want):
1)http://www.jazarsoft.com/cgi-bin/download.cgi?id=15
2)http://www.torry.net/vcl/indicat/meters/empggauge.zip
3)http://www.torry.net/vcl/indicat/meters/tprogr.zip
4)http://www.torry.net/vcl/indicat/meters/vlxprogress.zip

Good Luck!

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.