我认为我可以直接问这个问题:我见过在视觉效果方面完美无瑕的 Delphi 控件。意思是:没有闪烁,分段更新(只重绘标记为脏的控件部分)和平滑滚动。
多年来,我编写了许多图形控件,因此我了解双缓冲、DIB、BitBlt 和所有“常见”的东西(如果可能,我总是使用 DIB 来绘制所有内容,但存在开销)。我也知道 InvalidateRect 并检查 TCanvas.ClipRect 获取实际需要更新的矩形。尽管有所有这些典型的解决方案,但我发现很难创建与 Developer Express 或 Razed Components 等组件相同质量的控件。如果图形平滑,你可以打赌滚动条(本地)会闪烁,如果滚动条和框架平滑,你可以发誓背景在滚动期间闪烁。
是否有标准的代码设置来处理这个问题?一种最佳实践,确保整个控件的平滑重绘 - 包括控件的非客户端区域?
例如,这里是一个“裸骨”控件,可以根据需要进行分段更新(仅重新绘制所需内容)。如果在窗体上创建它,请尝试将窗口移动到其上,并观察它用颜色替换部分的方式(请参见 paint 方法)。
是否有类似的基类可以处理非客户端区域重绘而不会闪烁?
type
TMyControl = Class(TCustomControl)
private
(* TWinControl: Erase background prior to client-area paint *)
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd);message WM_ERASEBKGND;
Protected
(* TCustomControl: Overrides client-area paint mechanism *)
Procedure Paint;Override;
(* TWinControl: Adjust Win32 parameters for CreateWindow *)
procedure CreateParams(var Params: TCreateParams);override;
public
Constructor Create(AOwner:TComponent);override;
End;
{ TMyControl }
Constructor TMyControl.Create(AOwner:TComponent);
Begin
inherited Create(Aowner);
ControlStyle:=ControlStyle - [csOpaque];
end;
procedure TMyControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
(* When a window has this style set, any areas that its
child windows occupy are excluded from the update region. *)
params.ExStyle:=params.ExStyle + WS_CLIPCHILDREN;
(* Exclude VREDRAW & HREDRAW *)
with Params.WindowClass do
Begin
(* When a window class has either of these two styles set,
the window contents will be completely redrawn every time it is
resized either vertically or horizontally (or both) *)
style:=style - CS_VREDRAW;
style:=style - CS_HREDRAW;
end;
end;
procedure TMyControl.Paint;
(* Inline proc: check if a rectangle is "empty" *)
function isEmptyRect(const aRect:TRect):Boolean;
Begin
result:=(arect.Right=aRect.Left) and (aRect.Bottom=aRect.Top);
end;
(* Inline proc: Compare two rectangles *)
function isSameRect(const aFirstRect:TRect;const aSecondRect:TRect):Boolean;
Begin
result:=sysutils.CompareMem(@aFirstRect,@aSecondRect,SizeOf(TRect))
end;
(* Inline proc: This fills the background completely *)
Procedure FullRepaint;
var
mRect:TRect;
Begin
mRect:=getClientRect;
AdjustClientRect(mRect);
Canvas.Brush.Color:=clWhite;
Canvas.Brush.Style:=bsSolid;
Canvas.FillRect(mRect);
end;
begin
(* A full redraw is only issed if:
1. the cliprect is empty
2. the cliprect = clientrect *)
if isEmptyRect(Canvas.ClipRect)
or isSameRect(Canvas.ClipRect,Clientrect) then
FullRepaint else
Begin
(* Randomize a color *)
Randomize;
Canvas.Brush.Color:=RGB(random(255),random(255),random(255));
(* fill "dirty rectangle" *)
Canvas.Brush.Style:=bsSolid;
Canvas.FillRect(canvas.ClipRect);
end;
end;
procedure TMyControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
message.Result:=-1;
end;
更新
我只想补充一下,这个方法的关键在于:
- 在绘制非客户区时使用ExcludeClipRect(),以便不会与客户区的图形重叠。
捕获WMNCCalcSize消息而非仅使用边框大小进行测量。我还必须考虑边缘大小的高度:
每当您的滚动条移动或调整大小时,使用以下标志调用 RedrawWindow():
mRect:=ClientRect; mFlags:=rdw_Invalidate or RDW_NOERASE or RDW_FRAME or RDW_INTERNALPAINT or RDW_NOCHILDREN; RedrawWindow(windowhandle,@mRect,0,mFlags);
在Paint()方法中更新背景时,避免绘制到可能存在的子对象上,像这样做(参见上面提到的RDW_NOCHILDREN):
XEdge := GetSystemMetrics(SM_CXEDGE);
YEdge := GetSystemMetrics(SM_CYEDGE);
for x := 1 to ControlCount do
begin
mCtrl:=Controls[x-1];
if mCtrl.Visible then
Begin
mRect:=mCtrl.BoundsRect;
ExcludeClipRect(Canvas.Handle,
mRect.Left,mRect.Top,
mRect.Right,mRect.Bottom);
end;
end;
谢谢大家的帮助!
WM_ERASEBKGND
消息,甚至可能希望手动处理双缓冲,通过绘制到TBitmap
,然后在适当的时候使用BitBlt
。 - Andreas Rejbrand