如何自定义滚动条颜色?

时间:2013-02-06 16:51:06

标签: delphi scrollbar

我在下面找到了一些示例代码,用于尝试自定义滚动条颜色:

HBRUSH CMainFrame::OnCtlColor(CDC* pDC, CWnd* pWnd, UINT nCtlColor)       
{ 
   HBRUSH hbr = CFrameWnd::OnCtlColor(pDC, pWnd, nCtlColor); 

   if(nCtlColor==CTLCOLOR_SCROLLBAR) 
      return m_brColor; 

   return hbr; 
}

我发现以下代码不起作用:

procedure TForm1.WMCTLColor(var msg: TWMCTLCOLOR); message WM_CTLCOLOR;

如何在Delphi中完成?

2 个答案:

答案 0 :(得分:2)

原生api中没有WM_CTLCOLOR消息。相反,您可以使用CN_CTLCOLORSCROLLBAR控件通知,该通知由VCL发送给子控件以响应API的WM_CTLCOLORSCROLLBAR

type
  TScrollBar = class(TScrollBar)
  protected
    procedure WMCtlColor(var Message: TWMCtlColorScrollbar); message CN_CTLCOLORSCROLLBAR;
  end;

procedure TScrollBar.WMCtlColor(var Message: TWMCtlColor);
begin
  Message.Result := CreateSolidBrush(RGB(255, 255, 0));
end;


或者,如果您不想派生新控件,只要滚动条放在表单上:

  TForm1 = class(TForm)
    ...
  protected
    procedure WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar);
      message WM_CTLCOLORSCROLLBAR;
    ...
  end;

procedure TForm1.WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar);
begin
  if Message.ChildWnd = ScrollBar1.Handle then
    Message.Result := CreateSolidBrush(RGB(255, 255, 0));
end;

答案 1 :(得分:1)

这种改进避免了重复调用CreateSolidBrush()

导致的内存泄漏
{ TMyScrollBar }
//******************************************************************************
constructor TMyScrollBar.Create(AOwner: TComponent);
begin
  inherited;
  FHBrush := CreateSolidBrush(ColorToRGB(FBackColor));
end;

//******************************************************************************
destructor TMyScrollBar.Destroy;
begin
  DeleteObject(FHBrush);
  inherited;
end;

//******************************************************************************
procedure TMyScrollBar.SetBackColor(const Value: Tcolor);
begin
  FBackColor := Value;
  DeleteObject(FHBrush);
  FHBrush := CreateSolidBrush(ColorToRGB(FBackColor));
end;

//******************************************************************************
procedure TMyScrollBar.WMCtlColor(var Message: TWMCtlColorScrollbar);
begin
  Message.Result := FHBrush;
end;