While looking for alternatives to replace GDI, I was trying to test Delphi's 2010 TDirect2DCanvas performance in Windows 7.
I tested it by drawing a huge polyline using Direct2D and the result was absurdly slow, even with 500 times less data than the amount I've ran the same test using GDI (and I didn't even use a bitmap as backbuffer in GDI, I just drew to the form canvas directly).
So I guess either:
a) Direct2D is slower than GDI;
b) TDirect2DCanvas is slow;
c) I'm doing something wrong
and hopefully it's c).
The test code I wrote is:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Direct2D, D2D1;
type
TForm2 = class(TForm)
private
{ Private declarations }
FD2DCanvas: TDirect2DCanvas;
FData: array[0..50000] of TPoint;
public
procedure CreateWnd; override;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses utils;
{$R *.dfm}
procedure TForm2.CreateWnd;
var
i: Integer;
begin
inherited;
FD2DCanvas := TDirect2DCanvas.Create(Handle);
for i := 0 to High(FData) do begin
FData[i].X := Random(Self.ClientWidth div 2);
FData[i].Y := Random(Self.ClientHeight);
end;
end;
procedure TForm2.WMPaint(var Message: TWMPaint);
var
PaintStruct: TPaintStruct;
begin
BeginPaint(Handle, PaintStruct);
try
FD2DCanvas.BeginDraw;
try
FD2DCanvas.Polyline(FData);
finally
FD2DCanvas.EndDraw;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
procedure TForm2.WMSize(var Message: TWMSize);
begin
if Assigned(FD2DCanvas) then begin
ID2D1HwndRenderTarget(FD2DCanvas.RenderTarget).Resize(D2D1SizeU(ClientWidth, ClientHeight));
end;
end;
end.
Also, I'm really willing to draw long polylines in real code, as a system I'm working on need to draw plenty of ~2500 points polylines (at least 10K of them).
Updated (2010-11-06)
I've found out earlier that Direct2D doesn't seem to like polylines, it draws faster if you use a lot of single lines (2 points polylines).
Thanks to Chris Bensen I found out the slowness was with large polylines while using anti-aliasing. So I disabled anti-aliasing as Chris suggested and performance went from ~6000ms to ~3500ms for drawing 50k lines.
Things could still be improved because Direct2D just doesn't handle well polylines while using anti-aliasing. With anti-aliasing disabled it's just the opposite.
Now the time for drawing with Direct2D the 50k lines, if I draw the large polyline without anti-aliasing, is ~50ms. Nice, eh!
The thing is that GDI is still faster than Direct2D if I draw to a bitmap and after it's done I BitBlt the result back to the form, it paints at ~35ms, and with the same graphics quality. And, Direct2D also seems to be using a backbuffer already (it just draws when EndDraw() is called).
So, can this be improved somehow to make using Direct2D worth speed-wise?
Here's the updated code:
type
TArray = array[0..1] of TPoint;
PArray = ^TArray;
procedure TForm2.WMPaint(var Message: TWMPaint);
var
PaintStruct: TPaintStruct;
begin
FD2DCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_ALIASED);
BeginPaint(Handle, PaintStruct);
try
FD2DCanvas.BeginDraw;
try
FD2DCanvas.Pen.Color := clRed;
FD2DCanvas.Polyline(FData);
finally
FD2DCanvas.EndDraw;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
By the way, even if I use Chris' suggestion of creating the geometry beforehand the speed is about the same speed as GDI, but still not faster.
My computer is running Direct3D and OpenGL apps normally and here's dxDiag output: http://mydxdiag.pastebin.com/mfagLWnZ
I'll be glad if anyone can explain me why is this slowness. Sample code is much appreciated.
The problem is antialiasing is turned on. Disable antialiasing and the performance of Direct2D will be on par or faster than GDI. To do that after TDirect2DCanvas is created, make this call:
FD2DCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_ALIASED);
TDirect2DCanvas is interface compatible where possible with TCanvas so it can be a drop in replacement with TCanvas, so some of the drawing routines are are a bit inefficient. For example, Polyline creates a geometry each time it is called and throws it away. To increase performance keeping the geometry around.
Take a look at the implementation for TDirect2DCanvas.Polyline and hoist that out into your application for something like this:
procedure TForm2.CreateWnd;
var
i: Integer;
HR: HRESULT;
Sink: ID2D1GeometrySink;
begin
...
D2DFactory.CreatePathGeometry(FGeometry);
HR := FGeometry.Open(Sink);
try
Sink.BeginFigure(D2D1PointF(FData[0].X + 0.5, FData[0].Y + 0.5),
D2D1_FIGURE_BEGIN_HOLLOW);
try
for I := Low(FData) + 1 to High(FData) - 1 do
Sink.AddLine(D2D1PointF(FData[I].X + 0.5, FData[I].Y + 0.5));
finally
Sink.EndFigure(D2D1_FIGURE_END_OPEN);
end;
finally
hr := Sink.Close;
end;
And then draw it like so:
procedure TForm2.WMPaint(var Message: TWMPaint);
begin
FD2DCanvas.BeginDraw;
FD2DCanvas.Pen.Color := clRed;
FD2DCanvas.RenderTarget.DrawGeometry(FGeometry, FD2DCanvas.Pen.Brush.Handle);
FD2DCanvas.EndDraw;
end;
Direct2D relies on the driver and hardware implementation, so you're bound to have performance oddities depending on the hardware and driver you're running on (same bag of issues as 3D rendering engines face).
For instance on the issue of rendering lines, you'll likely face some (hidden) underlying hardware buffer issues: on a given hardware+driver, when drawing a polyline, if the underlying datasize is below a certain threshold, the performance could be high, with full hardware acceleration. Above that threshold, you could be falling back to a partially software or unoptimized path, and performance will plummet. The threshold will depend on hardware, driver and brush/drawing options, can be there, or not.
These are the same issues as when rendering 2D or 3D via OpenGL or regular DirectX, if you stray outside of well trodden rendering paths, things aren't so rosy.
As far as rendering non-antialiased graphics goes, my advice would be to stick with GDI, the implementations are solid with widespread hardware support.
For antialiased graphics, GDI+, Graphics32, AGG, and by and large, software-only solutions are preferable IME whenever you have no control over the end-user hardware. Otherwise, prepare yourself for customer support issues.
In all my benchmark tests OpenGL (with and without MSAA antialiasing) is faster than GDI, GDI+ or Direct2D, for the particular case of drawing 2D elements like polygons, lines, rectangles, etc.
What about GDI+ speed, in comparison?
We wrote a free/open source unit, able to render any VCL TCanvas content (using a TMetaFile) using the GDI+ engine.
In practice, performance is very good, and anti-aliaising was on...
We use this in several projects, drawing regular components content into a bitmap, then using this bitmap for drawing the form content on screen (this will avoid any flicker problem).
And with anti-aliaising, marketing people were happy about the result, and other programmers (using C# or WPF) were wondering how it was working: the drawing is very fast and the applications are reactive (like well built Delphi apps), use very little memory, and the result on screen looks modern (especially if you use Calibri or such fonts if available on your system).
See http://synopse.info/forum/viewtopic.php?id=10
It will work with any version of Delphi (from Delphi 6 up to Delphi XE), and will work on any version of Windows (XP, Vista, Seven - need to deploy the standard gdiplus.dll with previous OS).
Our unit uses pascal code for the GDI to GDI+ conversion on XP, and native Microsoft hidden API under Vista, Seven or if Office 2003/2007 is installed on the PC.
Related
I have projects developed in Delphi 10 on a laptop with a screen resolution of 96. I am now using Delphi 10.4 Community Edition on a Microsoft Surface with a screen resolution of 201. Is there a function or a settings that automatically converts numerically defined coordinates when scaling an application? To show what I mean I add this code snippet.
procedure TForm1.Button1Click(Sender: TObject);
begin
with Canvas do
begin
MoveTo(0,0);
LineTo(400,250);
MoveTo(0,0);
LineTo(ClientWidth,ClientHeight);
end;
end;
The first line drawn does not scale, the second one obviously does.
May I add:
If I compile the same code on my old laptop with a screen resolution of 96 and then run the exe file on my Surface Laptop with a screen resolution of 201 it scales ok, I was hoping there was a facility somewhere to compile my old programmes on my new computer without having to manually change all the code referring to coordinates x and y.
There's no built-in scaling of coordinates in a TCanvas. You can use this CLASS HELPER:
TYPE
TFormHelper = CLASS HELPER FOR TForm
FUNCTION Scale(Value : INTEGER) : INTEGER;
END;
FUNCTION TFormHelper.Scale(Value : INTEGER) : INTEGER;
BEGIN
Result:=MulDiv(Value,CurrentPPI,Screen.DefaultPixelsPerInch)
END;
Use it as in:
procedure TForm1.Button1Click(Sender: TObject);
begin
with Canvas do
begin
MoveTo(Scale(0),Scale(0)); // Not needed, as 0 scaled is always 0, but... //
LineTo(Scale(400),Scale(250));
MoveTo(0,0);
LineTo(ClientWidth,ClientHeight);
end;
end;
To run my projects developed with Delphi 10 on my new computer with a higher screen resolution, using Delphi 10.4 Community Edition I change the setting
Project Options -> Application -> Manifest -> DPI Awareness to GDI Scaling and it all works like a charm.
I have a form of my app that can have up to 1000 visual components, in which I draw each one once using Canvas of a bitmap, and save this bitmap of each component (a kind of double buffered), because each operation takes 20 ms.
I'm using threads to paint the bitmaps and send notifications with this bitmap to the MainThread, to refresh the visual components, the UI.
Theoretically, it would have to have a fluid form opening with the components being displayed as their bitmaps were painted in the threads, but in practice it was not fluid. I decided to take a look at the delphi's TCanvas and I noticed something staggering:
class var // <<<<<<<<<<<<<<<<<<<<<<<<<<<< class var
FLock: TObject;
function TCanvas.BeginScene(AClipRects: PClipRects = nil; AContextHandle: THandle = 0): Boolean;
begin
Lock;
...
end;
procedure TCanvas.EndScene;
begin
...
Unlock;
end;
class procedure TCanvas.Lock;
begin
TMonitor.Enter(FLock);
end;
class procedure TCanvas.Unlock;
begin
TMonitor.Exit(FLock);
end;
This definitely does not seem right. Why does the embarcadero make it impossible to work with TCanvas simultaneously in different threads? It's no use creating 10 threads to be doing bitmap drawings since everything will be processed 1 at a time...
Why does this exist?
Is there any workaround? What can happen if I make my version of
FMX.Graphics with only local monitors for each TCanvas?
Is there any third party lib with it own TCanvas?
I know that many will advise me to use native classes, JCanvas in android and CGContextRef in iOS, but I wanted a solution with TCanvas, because its job is to be a wrapper for drawing functions of all platforms, and to be easy to use.
============= #EDIT =============
I changed the Lock and Unlock of the TCanvas in the FMX.Graphics unit to use local instead of global monitors, as well as the BeginScene and EndScene of TContext3D in the FMX.Types3D unit.
I'm very apprehensive about this change but apparently the app is working normal, the biggest job was recompile the entire FMX.
Tbitmap is not really multithread. It's was made as multithread in Delphi Tokyo but with a very poor design (their is still many bug when you use Tbitmap in background thread, for example Tbitmap still use messaging notification that are not multithread at all and thus can result in random exception). What was done not bad in tokyo is to make the OpenGL context multithread (under android/ios), and that work quite well (but not the TTexture that are still bounds to Messaging, but you can easily update the source code of ttexture to correct it (You can look the source code of Alcinoe to know how to do it).
The only workaround for what you want to achieve is :
Don't use TBitmap but use instead Texture (because openGL Fully multithread without any lock)
Build the texture in background thread with native OS function (JCanvas in android and CGContextRef in iOS)
Avoid to use so many controls, but instead paint yourself all the texture that are ready and visible from the main thread (so in an onpaint event) at the right place
Yes I know it's a pain!
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
Have some problem. I have a form with a canvas, I need access to this canvas from dll by its handle. I do this in this way:
from dll
canvas := TCanvas.Create;
try
canvas.Handle := handle;
// do some painting on this canvas
finally
canvas.free;
end;
It works well, I paint what I need from dll. But this trick has side effect. After painting from dll, form loses font settings (btw I did not use fonts when painted from dll, just few rects) and when I paint on same canvas from main form, even if I do directly canvas.font.size := ...; canvas.font.name := ...; before canvas.TextOut, the font does not change. Lines, filling and other paintings are ok. But fonts become corrupted (sometimes not, but mostly).
Is there a way to reset/reinit TCanvas object of the form?
Canvas does not have any reset functionality but you can ask the api to save the state of the device context of the canvas, and restore it after your drawing.
var
SavedDC: Integer;
...
SavedDC := SaveDC(handle);
try
canvas := TCanvas.Create;
try
canvas.Handle := handle;
// do some painting on this canvas
finally
canvas.free;
end;
finally
RestoreDC(handle, SavedDC);
end;
Remy's answer explains how you lose the sate of the device context. Why it doesn't always happen should depend on timing I believe. If the form has entered a new paint cycle at the time its canvas uses its font, all should be well since it operates on a newly acquired and setup device context.
The reason your Form's Canvas gets "corrupted" is because the DLL's TCanvas object is replacing the original HFONT, HBRUSH and/or HPEN objects that were already assigned to the HDC, but is then assigning stock GDI objects (from GetStockObject()) during its destruction, instead of re-assigning the original GDI objects that were previously assigned. This happens in the TCanvas.DeselectHandles() method when the TCanvas.Handle property changes value (which includes during destruction):
var
...
StockPen: HPEN;
StockBrush: HBRUSH;
StockFont: HFONT;
...
procedure TCanvas.DeselectHandles;
begin
if (FHandle <> 0) and (State - [csPenValid, csBrushValid, csFontValid] <> State) then
begin
SelectObject(FHandle, StockPen); // <-- STOCK PEN!
SelectObject(FHandle, StockBrush); // <-- STOCK BRUSH!
SelectObject(FHandle, StockFont); // <-- STOCK FONT!
State := State - [csPenValid, csBrushValid, csFontValid];
end;
end;
...
initialization
...
StockPen := GetStockObject(BLACK_PEN);
StockBrush := GetStockObject(HOLLOW_BRUSH);
StockFont := GetStockObject(SYSTEM_FONT);
...
To make the Form "reset" its Canvas after the DLL function exits, you will have to trick the Canvas into knowing its GDI objects are not longer assigned to the HDC so it can clear the relevant flags from its internal State member and reassign its GDI objects as needed. You can either:
manually trigger the OnChange event handlers of the Canvas.Font, Canvas.Brush and Canvas.Pen properties:
procedure TMyForm.FormPaint(Sender: TObject);
begin
try
CallDllFunc(Canvas.Handle);
finally
Canvas.Font.OnChange(nil);
Canvas.Brush.OnChange(nil);
Canvas.Pen.OnChange(nil);
end;
end;
Or:
type
TGraphicObjectAccess = class(TGraphicObject)
end;
procedure TMyForm.FormPaint(Sender: TObject);
begin
try
CallDllFunc(Canvas.Handle);
finally
TGraphicObjectAccess(Canvas.Font).Changed;
TGraphicObjectAccess(Canvas.Brush).Changed;
TGraphicObjectAccess(Canvas.Pen).Changed;
end;
end;
you can temporarily remove and then re-assign the original HDC, which has a similar effect on the State flags:
procedure TMyForm.FormPaint(Sender: TObject);
var
DC: HDC;
begin
try
CallDllFunc(Canvas.Handle);
finally
DC := Canvas.Handle;
Canvas.Handle := 0;
Canvas.Handle := DC;
end;
end;
Use SaveDC() and RestoreDC(), as shown in Sertac's answer.
The standard TCanvas class is not really suited for painting on "borrowed" canvasses. That is, taking a device context (e.g. from some other canvas object) and using it within another, separate TCanvas due to the way it manages GDI objects (relying on "owning" the HDC and the state of GDI objects in that DC that it is working with).
It can work, in simple cases, but otherwise the problems you are experiencing are not uncommon. In particular with a DLL, there could be problems arising from the fact that there are mechanisms within a TCanvas that rely on a "global" list of canvases (CanvasList) that need to be managed and kept in sync in response to system changes.
i.e. In a DLL there will be a CanvasList which is list of canvases in the DLL, separate to the CanvasList in the host application process. The application CanvasList will not include any TCanvas instances in the DLL, and vice versa. If a DLL has a TCanvas which is in fact a "duplicate" of a TCanvas in the application (using the same HDC) then it should be obvious how problems could arise.
I see two ways forward in your case which could be used separately or together.
You haven't provided details of all your painting code so it's difficult to say which is likely to be the source of your problem. However, you can identify this yourself quite easily by commenting out all of your painting code (between the try and finally in your painting routine). This should fix your font problem. If you then re-enable your painting code incrementally (line by line or section by section) you can identify precisely which painting operations are causing the problem and from there (potentially) identify a solution.
If your painting operations are very simple (just painting a few rectangles as you say) then you could use simple GDI calls to do your painting in the problem cases (or all of them), rather than using a canvas. In this case I would suggest that you pass a window handle to your DLL, rather than a device context. Your DLL should then obtain it's own device context via GetDC() and release it via ReleaseDC() when finished. You will need to manage the GDI objects when painting on the device context yourself but can then be sure that whatever you do you are not interfering with the GDI objects being managed by a TCanvas drawing on the same window.
Another possibility is to use SaveDC() and RestoreDC(), as shown in Sertac's answer.
I've been Googling up and down, searching on the Free Pascal Wiki and even on some (obscure) mailing lists and have come completely empty on how to use ioctl() or fpioctl() on Free Pascal.
I have this bug report from Free Pascal's Bugtrack with code that enumerates the network interfaces.
The code does not compile since the libc unit has been deprecated.
A lot of similar questions about libc point to this wiki entry that talks about it's demise.
It does not give you any indication on where the SIOC*IF* stuff has gone.
Does that mean that most of ioctl functionality has gone?
Using find and grep, under /usr/share/fpcsrc/<fpc-version>/, I've been able to track some usage of fpioctl() in relation to terminals with the termios unit. Other stuff uses it but it looks like it's under other OSs.
Apart from that I'm unable to find anything of any use if you want to do something like:
if ioctl(sock, SIOCGIFCONF, #ifc)= 0 then begin
{...}
end;
So, can anyone from the Free Pascal Community give me a pointer to what's the current situation if one wants to do ioctl calls under Linux?
Does BaseUnix.FpIOCtl meet your use case? Have a look at the BaseUnix documentation. I found an example of using it here (reposted below).
program testrpi;
{$mode objfpc}{$H+}
uses
baseUnix,
classes,
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
sysutils;
const
I2C_SLAVE = 1795;
var
buf : packed array [0..1] of char;
c : char;
devPath : string = '/dev/i2c-1';
handle : Cint;
iDevAddr : Cint = $04;
begin
try
handle := fpopen(devPath,O_RDWR);
fpIOCtl(handle, I2C_SLAVE, pointer(iDevAddr));
except
writeln('Error initalizing i2c');
halt;
end;
while true do begin
write('Enter digit 1-9:');
readln(c);
if (not(c in ['1'..'9'])) then begin
writeln('oops - try again');
continue;
end;
buf[0] := chr(ord(c) - ord('0'));
try
fpwrite(handle, buf, 1);
except
writeln('Error writing');
halt;
end; //try
buf[0] := #99;
sleep(10);
try
fpread(handle, buf, 1);
except
writeln('Error reading');
halt;
end; //try
writeln('buf=', ord(buf[0]));
end; //while
fpclose(handle);
end.
The fpioctl bit has been answer by Mick and the FAQs. As for the constants, as the libc unit faq explains there is no clear cut solution, and thus for the more specialized constants there are no replacements.
OS specific constants should go in OS specific units (linux), and (somewhat) portable ones are usually grouped with the calls of the functionality they are for.
The old libc header was an rough header translation that was cleaned up somewhat, which was manageable for 32-bit Linux only, but unusable for a nix abstraction or even "just" multiplatform Linux. It was therefore abandoned.
In short it is best to either make a simple unit that abstracts the relevant parts or to just define the constants locally.
How can I get the screen resolution in Firemonkey 2 (Delphi XE3)?
It's all changed in XE3. The platform support has been completely overhauled. See Pawel Glowacki's article for more.
var
ScreenSvc: IFMXScreenService;
Size: TPointF;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, IInterface(ScreenSvc)) then
begin
Size := ScreenSvc.GetScreenSize;
....
end;
end;
In spite of the overhaul, this is still not much use if you have multiple monitors. Perhaps there is some multimon support in FMX2, but it's clearly not available in IFMXScreenService.