将 TProgressBar 放置在 TStatusBar 上的方法不再有效

Question

过去我使用 here 中描述的方法将 TProgressBar 放置在 Delphi 中的 TStatusBar 上：

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;

但是（在最近的 Windows 更新之后？）这不再有效，即旧程序仍然按预期工作，但新编译的程序却不行。我在 Windows 10.

上使用相同的 Delphi 版本 XE8

这是否意味着这种方法不合适？正确的做法是什么？

Answer 1

如果您删除处理边框的线条，它会起作用：

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

生成的双边框看起来不太好，因此 David 在 OnDrawPanel 中调用 FillRect 的解决方案可能是更好的解决方案。这有一个额外的好处，你终于可以摆脱那个丑陋的绿色:-)。

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;

注意：您必须调用 StatusBar 的 Invalidate 方法，以便执行 ONDrawPanel 事件处理程序。

Answer 2

我对行为变化唯一明显的解释是这段代码是错误的：

ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;

此代码假定 WS_EX_STATICEDGE 已在样式中。但如果不是，那么你正在破坏 window 风格。该代码需要使用位运算：

ProgressBarStyle := ProgressBarStyle and not WS_EX_STATICEDGE;

另请注意，如果重新创建 window，此 window 样式将丢失，这在 VCL 下确实会发生。更好的选择是子class 进度条class 并直接在覆盖CreateParams 中设置样式。

Answer 3

正如其他人所解释的那样，您对 TProgressBar 的 window 样式的管理不善是造成问题的原因。

我想补充一点，您根本不需要（也不应该使用）TStatusBar.OnDrawPanel 事件来定位 TProgressBar。它是绘图事件，而不是对象管理事件。如果您不打算在 TStatusBar.Canvas 上手动绘制进度条，那么您应该完全摆脱 OnDrawPanel 处理程序。

您可以在启动时定位 TProgressBar 一次，方法是使用 SB_GETRECT 消息获取面板的坐标和尺寸，然后相应地定位 TProgressBar，例如：

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;

如果您的表单可以调整大小，您可以使用 TStatusBar.OnResize 事件在面板调整大小时重新定位 TProgressBar：

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;

将 TProgressBar 放置在 TStatusBar 上的方法不再有效

Method for placing a TProgressBar on a TStatusBar no longer works

delphi

delphi-xe8