CODEWITHSUNDEEP
delphidelphi-xe8
stevenvh
stevenvh

Reputation: 3139

Method for placing a TProgressBar on a TStatusBar no longer works

In the past I used the method described here to place a TProgressBar on a TStatusBar in Delphi:

procedure TForm1.FormCreate(Sender: TObject);
var
  ProgressBarStyle: integer;
begin
  //enable status bar 2nd Panel custom drawing
  StatusBar1.Panels[1].Style := psOwnerDraw;
  //place the progress bar into the status bar
  ProgressBar1.Parent := StatusBar1;
  //remove progress bar border
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;  
  const Rect: TRect);
begin
  if Panel = StatusBar.Panels[1] then
  with ProgressBar1 do
  begin
    Top := Rect.Top;
    Left := Rect.Left;
    Width := Rect.Right - Rect.Left;
    Height := Rect.Bottom - Rect.Top;
  end;
end;

But (after a recent Windows update?) this no longer works, i.e. the old programs still work as expected, but newly compiled ones don't. I'm using the same Delphi version, XE8, on Windows 10.

Does this mean that this method was inappropriate? What is the right way to do this?

Upvotes: 0

Views: 2283

Answers (3)

Remy Lebeau
Remy Lebeau

Reputation: 596256

As others have explained, your mismanagement of the TProgressBar's window styles is the cause of your problem.

I want to add that you do not need to use (and should not be using) the TStatusBar.OnDrawPanel event to position the TProgressBar at all. It is a drawing event, not an object management event. If you are not going to manually draw a progress bar onto the TStatusBar.Canvas then you should get rid of the OnDrawPanel handler completely.

You can instead position the TProgressBar one time at startup, by using the SB_GETRECT message to get the panel's coordinates and dimensions and then position the TProgressBar accordingly, eg:

uses
  CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);
var
  ...
  R: TRect;
begin
  // no need to set the panel's Style to psOwnerDraw!
  ...
  //place the progress bar into the status bar
  SendMessage(StatusBar1.Handle, SB_GETRECT, 1, LPARAM(@R));
  ProgressBar1.Parent := StatusBar1;
  ProgressBar1.SetBounds(R.Left, R.Top, R.Width, R.Height);
  ...
end;

If your Form is resizable, you can use the TStatusBar.OnResize event to reposition the TProgressBar if the panel resizes:

uses
  CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // no need to set the panel's Style to psOwnerDraw!
  ...
  //place the progress bar into the status bar
  ProgressBar1.Parent := StatusBar1;
  StatusBar1Resize(nil);
  ...
end;

procedure TForm1.StatusBar1Resize(Sender: TObject);
var
  R: TRect;
begin
  //place the progress bar over the 2nd panel
  SendMessage(StatusBar1.Handle, SB_GETRECT, 1, LPARAM(@R));
  ProgressBar1.SetBounds(R.Left, R.Top, R.Width, R.Height);
end;

Upvotes: 4

David Heffernan
David Heffernan

Reputation: 612964

The only obvious explanation I have for the change of behaviour is that this code is wrong:

ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;

This code assumes that WS_EX_STATICEDGE is already in the style. But if it is not then you are destroying the window style. That code needs to use bitwise operations:

ProgressBarStyle := ProgressBarStyle and not WS_EX_STATICEDGE;

Note also that this window style will be lost if the window is recreated, something that does happen under the VCL. A better option would be to subclass the progress bar class and set the style directly in an overridden CreateParams.

Upvotes: 4

stevenvh
stevenvh

Reputation: 3139

It works if you remove the lines that take care of the border:

// remove these lines
ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);

The resulting double border doesn't look as nice, so David's solution of calling FillRect in the OnDrawPanel may be the better solution. This has the extra advantage that you finally can get rid of that ugly green :-).

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
var
  R: TRect;
begin
  if Panel = StatusBar.Panels[1] then
  begin
    StatusBar.Canvas.Brush.Color := clBtnFace;
    StatusBar.Canvas.FillRect(Rect);
    R := Rect;
    R.Right := Round(R.Left + (R.Right - R.Left) * FProgress {0..1});
    StatusBar.Canvas.Brush.Color := clGrayText;
    StatusBar.Canvas.FillRect(R);
  end;
end;

Note: you'll have to call the StatusBar's Invalidate method so that the ONDrawPanel event handler gets executed.

Upvotes: 2

Related Questions