I have a project with alot of paint stuff, like components (grids, coloring, shapes), images and so on.
I decided to start the use of GPU acceleration to make the entire solution smoother and faster so a gradual migration from normal GDI (TCanvas) to GPU accelered (TDirect2DCanas) will be planned over the components that makes sense (migrate all rendering components or only those that can really benefit of?).
I started to research around to make initial tests, because I don’t even know if TDirect2DCanvas is what I exactly need. But well I found this post by François (ICS owner) that is basically the same as the Embarcadero doc here.
They both helped me alot to understand, at least the basic. To do a test I builded a component just like the Fraçois post (link above) which is a custom panel with overrided paint events and canvas just like the documentation (another link above).
I also made some changes to have a closer as possible of a TPanel (copy paste from TCustomPanel class and adapted to use TDirect2DCanvas), just with a hardware accelerate with a plus, the code is:
unit CustomPanel;
interface
uses
Winapi.Messages,
Winapi.D2D1,
Winapi.Windows,
System.Classes,
System.SysUtils,
Vcl.Graphics,
Vcl.ExtCtrls,
Vcl.Direct2D,
Vcl.Controls,
Vcl.Themes;
type
CustomD2DPanel = class(TPanel)
private
FD2DCanvas : TDirect2DCanvas;
FPrevRenderTarget : IntPtr;
FOnPaint : TNotifyEvent;
FOnCreateRenderTarget : TNotifyEvent;
function CreateD2DCanvas: Boolean;
procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
// Bevels?
procedure D2DFrame3D(ACanvas: TDirect2DCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer);
protected
procedure CreateWnd; override;
function GetRenderTarget : ID2D1HwndRenderTarget;
procedure TriggerCreateRenderTarget; virtual;
public
destructor Destroy; override;
procedure Paint; override;
property D2DCanvas : TDirect2DCanvas
read FD2DCanvas;
property RenderTarget : ID2D1HwndRenderTarget
read GetRenderTarget;
property OnPaint : TNotifyEvent
read FOnPaint
write FOnPaint;
property OnCreateRenderTarget : TNotifyEvent
read FOnCreateRenderTarget
write FOnCreateRenderTarget;
end;
D2DPanel = class(CustomD2DPanel)
published
property Align;
property Anchors;
property Canvas;
property Color;
property D2DCanvas;
property RenderTarget;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind;
property BevelWidth;
property BorderWidth;
property Ctl3D;
property ParentBackground;
property ParentCtl3D;
property OnAlignInsertBefore;
property OnAlignPosition;
property OnDockDrop;
property OnDockOver;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnUnDock;
property DragCursor;
property DragMode;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnPaint;
end;
implementation
{ CustomD2DPanel }
destructor CustomD2DPanel.Destroy;
begin
FreeAndNil(FD2DCanvas);
inherited Destroy;
end;
function CustomD2DPanel.CreateD2DCanvas: Boolean;
begin
try
FD2DCanvas := TDirect2DCanvas.Create(Handle);
Result := TRUE;
except
Result := FALSE;
end;
TriggerCreateRenderTarget;
end;
procedure CustomD2DPanel.CreateWnd;
begin
inherited;
if (Win32MajorVersion < 6) or (Win32Platform <> VER_PLATFORM_WIN32_NT) then
raise Exception.Create('Your Windows version do not support Direct2D');
if not CreateD2DCanvas then
raise Exception.Create('Unable to create Direct2D canvas');
end;
function CustomD2DPanel.GetRenderTarget: ID2D1HwndRenderTarget;
begin
if FD2DCanvas <> nil then begin
Result := FD2DCanvas.RenderTarget as ID2D1HwndRenderTarget;
if FPrevRenderTarget <> IntPtr(Result) then begin
FPrevRenderTarget := IntPtr(Result);
TriggerCreateRenderTarget;
end;
end
else
Result := nil;
end;
procedure CustomD2DPanel.TriggerCreateRenderTarget;
begin
if Assigned(FOnCreateRenderTarget) then
FOnCreateRenderTarget(Self);
end;
procedure CustomD2DPanel.Paint;
const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
VerticalAlignments: array[TVerticalAlignment] of Longint = (DT_TOP, DT_BOTTOM, DT_VCENTER);
var
Rect: TRect;
LColor: TColor;
LStyle: TCustomStyleServices;
LDetails: TThemedElementDetails;
TopColor, BottomColor: TColor;
BaseColor, BaseTopColor, BaseBottomColor: TColor;
Flags: Longint;
procedure AdjustColors(Bevel: TPanelBevel);
begin
TopColor := BaseTopColor;
if Bevel = bvLowered then
TopColor := BaseBottomColor;
BottomColor := BaseBottomColor;
if Bevel = bvLowered then
BottomColor := BaseTopColor;
end;
function CheckParentBackground(AParent: TWinControl): Boolean;
begin
if (AParent <> nil) and (AParent is TCustomPanel) then
begin
Result := TCustomPanel(AParent).ParentBackground;
if Result then
Result := CheckParentBackground(AParent.Parent);
end
else
Result := False;
end;
begin
Rect := GetClientRect;
BaseColor := Color;
BaseTopColor := clBtnHighlight;
BaseBottomColor := clBtnShadow;
LStyle := StyleServices(Self);
if LStyle.Enabled and (seClient in StyleElements) then
begin
LDetails := LStyle.GetElementDetails(tpPanelBackground);
if LStyle.GetElementColor(LDetails, ecFillColor, LColor) and (LColor <> clNone) then
BaseColor := LColor;
LDetails := LStyle.GetElementDetails(tpPanelBevel);
if LStyle.GetElementColor(LDetails, ecEdgeHighLightColor, LColor) and (LColor <> clNone) then
BaseTopColor := LColor;
if LStyle.GetElementColor(LDetails, ecEdgeShadowColor, LColor) and (LColor <> clNone) then
BaseBottomColor := LColor;
end;
if BevelOuter <> bvNone then
begin
AdjustColors(BevelOuter);
D2DFrame3D(D2DCanvas, Rect, TopColor, BottomColor, BevelWidth);
end;
if not (LStyle.Enabled and (csParentBackground in ControlStyle)) then
D2DFrame3D(D2DCanvas, Rect, BaseColor, BaseColor, BorderWidth)
else
InflateRect(Rect, -Integer(BorderWidth), -Integer(BorderWidth));
if BevelInner <> bvNone then
begin
AdjustColors(BevelInner);
D2DFrame3D(D2DCanvas, Rect, TopColor, BottomColor, BevelWidth);
end;
with FD2DCanvas do
begin
if not LStyle.Enabled or not ParentBackground or not (seClient in StyleElements) or
(not LStyle.IsSystemStyle and (Parent <> nil) and (Parent is TCustomPanel) and
TCustomPanel(Parent).DoubleBuffered and not CheckParentBackground(Parent))
then
begin
Brush.Color := BaseColor;
FillRect(Rect);
end;
if ShowCaption and (Caption <> '') then
begin
Brush.Style := bsClear;
Font.Assign(Self.Font);
Flags := DT_EXPANDTABS or DT_SINGLELINE or
VerticalAlignments[VerticalAlignment] or Alignments[Alignment];
Flags := DrawTextBiDiModeFlags(Flags);
if LStyle.Enabled and (seFont in StyleElements) then
begin
LDetails := LStyle.GetElementDetails(tpPanelBackground);
if not LStyle.GetElementColor(LDetails, ecTextColor, LColor) or (LColor = clNone) then
LColor := Font.Color;
LStyle.DrawText(Handle, LDetails, Caption, Rect, TTextFormatFlags(Flags), LColor)
end
else
DrawText(Handle, Caption, -1, Rect, Flags);
end;
end;
end;
procedure CustomD2DPanel.WMEraseBkGnd(var Msg: TMessage);
begin
Msg.Result := 1;
end;
procedure CustomD2DPanel.WMPaint(var Msg: TWMPaint);
var
PaintStruct: TPaintStruct;
begin
BeginPaint(Handle, PaintStruct);
try
FD2DCanvas.BeginDraw;
try
Paint;
finally
FD2DCanvas.EndDraw;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
procedure CustomD2DPanel.WMSize(var Msg: TWMSize);
var
Size: D2D1_SIZE_U;
begin
if FD2DCanvas <> nil then begin
Size := D2D1SizeU(Width, Height);
ID2D1HwndRenderTarget(FD2DCanvas.RenderTarget).Resize(Size);
end;
inherited;
end;
procedure CustomD2DPanel.D2DFrame3D(ACanvas: TDirect2DCanvas;
var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer);
procedure DoRect;
var
TopRight, BottomLeft: TPoint;
begin
with ACanvas, Rect do
begin
TopRight.X := Right;
TopRight.Y := Top;
BottomLeft.X := Left;
BottomLeft.Y := Bottom;
Pen.Color := TopColor;
PolyLine([BottomLeft, TopLeft, TopRight]);
Pen.Color := BottomColor;
Dec(BottomLeft.X);
PolyLine([TopRight, BottomRight, BottomLeft]);
end;
end;
begin
ACanvas.Pen.Width := 1;
Dec(Rect.Bottom); Dec(Rect.Right);
while Width > 0 do
begin
Dec(Width);
DoRect;
InflateRect(Rect, -1, -1);
end;
Inc(Rect.Bottom); Inc(Rect.Right);
end;
end.
Apparently it paints over the GPU as suppose to be (don’t made intense tests), but in design time when I drag the custom panel into the Form I have a black panel at design time, which don’t change even changing the Color property, but at run time respects the theme settings (StyleElements.seClient) and Color property (when seClient style disabled of course)… but as I said, at design time what I see is a completely black component… why? Also don’t draw the caption of the component for no reason, I just copied all TCustomPanel.Paint event…
I not see a clearly problem with above code that can give this problems, somente can help?
Also I on the right way? Someone with those developing skill to advise?