我发现像下面一些示例代码,试图定义一个滚动条颜色:
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;
我怎样才能做到这一点在德尔福?
有没有WM_CTLCOLOR
在原生API消息。 相反,你可以使用CN_CTLCOLORSCROLLBAR
控制通知,这是在应对API的发送给子控件由VCL 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;
这一改进避免了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;