Вылечил отрисовку (не прорисовывались докнутые формы на этих панелях).
Также снизил интенсивность мерцания при изменении размеров формы.
Delphi 10.2 Tokyo
1. Реализовал helper для TCategoryPanel, который достает прозрачную панель, на которой рисуются брошенные на панель компоненты.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
THackCP = class helper for TCategoryPanel
private
function GetSurface: ExtCtrls.TCategoryPanelSurface;
public
Property Surface: ExtCtrls.TCategoryPanelSurface read GetSurface;
end;
function THackCP.GetSurface: ExtCtrls.TCategoryPanelSurface;
begin
Result := Self.FPanelSurface;
end;
2. Хакнул эту прозрачную панель TCategoryPanelSurface и переписал ее WMEraseBkgnd
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
TCategoryPanelSurfaceFix = class (ExtCtrls.TCategoryPanelSurface)
protected
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
end;
procedure TCategoryPanelSurfaceFix.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
if not FDoubleBuffered or
(TMessage(Message).wParam = WPARAM(TMessage(Message).lParam)) then
FillRect(Message.DC, ClientRect, NULL_BRUSH);
Message.Result := 1;
end;
3. Написал процедуру осуществляющую накат хака
1.
2.
3.
4.
5.
6.
7.
procedure PatchCategoryPanelSurface(surface: TCategoryPanelSurface);
type
pClass = ^TClass;
begin
if surface.ClassType = TCategoryPanelSurface then
pClass(surface)^ := TCategoryPanelSurfaceFix;
end;
4. Далее в FormCreate или FormShow остается пройтись по всем CategoryPanel и пофиксить их свойства
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
for Index:=0 to FForm.ComponentCOunt - 1 do begin
if FForm.Components[index] is TCategoryPanel then
UpdateCategoryPanel(FForm.Components[index] as TCategoryPanel);
end;
где UpdateCategoryPanel нечто такое
panel.ParentBackground := True;
panel.DoubleBuffered := True;
panel.Surface.DoubleBuffered := True;
panel.Surface.ParentDoubleBuffered := true;
PatchCategoryPanelSurface(panel.Surface); // хакаем навязывая свой WMERASEBckgnd.
Результатом доволен. Полный код тут, но там есть специфичные вещи для моих задач.
unit _ClassCategoryPatch;
interface
Uses Windows, Classes, SysUtils, Forms, Controls, ExtCtrls,
_ClassIObject, messages;
Type
TCategoryPanelPatch = class (IObject)
Strict Private
FForm: TCustomForm;
FLastCategoryPanel: TCategoryPanel;
FCategoryPanelCount: Integer;
procedure OnCollapse(Sender: TObject);
procedure UpdateLastCategoryPanel();
procedure UpdateCategoryPanel (panel : TCategoryPanel);
procedure UpdateCategoryPanelGroup(group: TCategoryPanelGroup);
Public
Constructor Create(Form: TCustomForm); Reintroduce;
Procedure Attach;
End;
TCategoryPanelSurfaceFix = class (ExtCtrls.TCategoryPanelSurface)
protected
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
end;
THackCP = class helper for TCategoryPanel
private
function GetSurface: ExtCtrls.TCategoryPanelSurface;
public
Property Surface: ExtCtrls.TCategoryPanelSurface read GetSurface;
end;
procedure PatchCategoryPanelSurface(surface: TCategoryPanelSurface);
implementation
uses Graphics, cxPC;
{ TCategoryPanelPatch }
constructor TCategoryPanelPatch.Create(Form: TCustomForm);
begin
inherited Create();
FForm := Form;
Attach();
end;
procedure TCategoryPanelPatch.OnCollapse(Sender: TObject);
begin
TCategoryPanel(Sender).Expand()
end;
procedure TCategoryPanelPatch.UpdateCategoryPanel(panel: TCategoryPanel);
begin
panel.ParentBackground := True;
panel.DoubleBuffered := True;
panel.Surface.DoubleBuffered := True;
panel.Surface.ParentDoubleBuffered := true;
PatchCategoryPanelSurface(panel.Surface);
end;
procedure TCategoryPanelPatch.UpdateCategoryPanelGroup(
group: TCategoryPanelGroup);
begin
// group.GradientBaseColor := $00FF8306;
// group.GradientColor := $00FF8306;
group.HeaderFont.Style := [TFontStyle.fsBold];
group.HeaderFont.Size := 8;
// group.HeaderFont.Color := clWhite;
//group.DoubleBuffered := True;
end;
procedure TCategoryPanelPatch.UpdateLastCategoryPanel;
begin
if FCategoryPanelCount = 1 then begin
FLastCategoryPanel.Align := alClient;
FLastCategoryPanel.OnCollapse := OnCollapse;
end;
end;
procedure TCategoryPanelPatch.Attach;
var index: integer;
begin
FLastCategoryPanel := nil;
FCategoryPanelCount:= 0;
for Index:=0 to FForm.ComponentCOunt - 1 do begin
if FForm.Components[index] is TCategoryPanel then begin
if FCategoryPanelCount < 1 then
FLastCategoryPanel := FForm.Components[index] as TCategoryPanel;
Inc(FCategoryPanelCount);
UpdateCategoryPanel(FForm.Components[index] as TCategoryPanel);
end;
if FForm.Components[index] is TCategoryPanelGroup then
UpdateCategoryPanelGroup(FForm.Components[index] as TCategoryPanelGroup);
if FForm.Components[index] is TcxPageControl then begin
TcxPageControl(FForm.Components[index]).LookAndFeel.NativeStyle := True;
TcxPageControl(FForm.Components[index]).LookAndFeel.SkinName := 'Office11'; TcxPageControl(FForm.Components[index]).DoubleBuffered := True;
end;
end;
UpdateLastCategoryPanel;
end;
{ THackCP }
function THackCP.GetSurface: ExtCtrls.TCategoryPanelSurface;
begin
Result := Self.FPanelSurface;
end;
{ TCategoryPanelSurfaceFix }
procedure TCategoryPanelSurfaceFix.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
if not FDoubleBuffered or
(TMessage(Message).wParam = WPARAM(TMessage(Message).lParam)) then
FillRect(Message.DC, ClientRect, NULL_BRUSH);
Message.Result := 1;
end;
procedure PatchCategoryPanelSurface(surface: TCategoryPanelSurface);
type
pClass = ^TClass;
begin
if surface.ClassType = TCategoryPanelSurface then
pClass(surface)^ := TCategoryPanelSurfaceFix;
end;
end.
