Blocking Canvas - delphi

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!

Related

Delphi TCanvas object become corrupted after using from dll, how to restore? [closed]

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.

Delphi Form Restored State Position and Size

In a maximized delphi form, how to get form's restored state position and size? I know in .NET we use RestoreBounds and DesktopBound.
This is not exposed by the VCL framework. Instead you need to dip into the Win32 API. The function you need is GetWindowPlacement.
var
WindowPlacement: TWindowPlacement;
....
WindowPlacement.length := SizeOf(WindowPlacement);
Win32Check(GetWindowPlacement(Form.Handle, WindowPlacement));
The information you need can be found in the WindowPlacement struct. Do beware that the coordinates are reported with respect to the work area rather than the screen.
Generally you want this information so that you can restore it at a later date. Use SetWindowPlacement to do that.

Method in Delphi to set database connections to disconnected upon compile

Is there a method or compiler directive or some way of assuring certain components, such as queries or database connections get set to active=false or disconnected when you run a build/compile? Seems so often these are turned on by something else and you don't notice it until its too late.
My particular install is Delphi 7
The Set Component Properties feature of GExperts is able to do that.
i think the best option would be to subclass stock connection component and in your own one override .Loaded method like that
if not csDesigning in Self.ComponentState then
if not Self.ActiveInDFM {new boolean published property} then
if Self.Active then Self.Active := false;
inherited;
http://docwiki.embarcadero.com/Libraries/XE3/en/System.Classes.TComponentState
http://docwiki.embarcadero.com/Libraries/XE3/en/System.Classes.TComponent.Loaded
By (ab)using Delphi Form Designer stupidness you can use it even without actually installing your new component into IDE Palette - just give it the same name as to the stock component class, then put your own method as last in the form's interface-uses list: thus in design-time you would have stock component and when compiling it would be transparently substituted with your own one.
Or you can sub-class it right above the very form declaration like (for another component):
type
TPanel = class(ExtCtrls.TPanel)
private
...
TForm1 = class(TForm) ....
I guess this approach might be seen as analogue to aspect-oriented programming, using limitations of IDE in developer-benefitting way.
Another approach might be some script, that cleans .Active properties in DFM on save or before build, but this way is complex for
i may be harder to integrate with stand-alone build severs (new script for each different CI framework tried)
it would reset Active property for design-time as well. This is a proper thing to do, from rigorous point of view. Yet this might be not very convenient.
You may just use similar code in your Form's and DataModule's .Loaded method (you would have to override it instead connection's method then).
You can copy-paste the same code into every Form's Loaded method.
procedure TMyForm.Loaded; // override
var c: TComponent; i: integer;
begin
try
for i := 0 to Self.ComponentsCount - 1 do begin
c := Self.Components[i];
if c is TCustomConnection then
with TCustomConnection(c) do // Hate those redundant typecasts!
if Connected then Connected := false;
if c is TDataSet then
with TDataSet(c) do // Delphi could took a lesson from Component Pascal
if Active then Active := false;
if c is ... // transactions, stored procedures, custom libriaries...
end;
finally
inherited;
end;
end;
This seems to be less sly way - thus most reliable. Yet that is a lot if copy-paste, and if you would later add some new component or library, that may ask for modifying copy-pasted code in all the forms.
You may centralize this code in some MyDBUtils unit into global procedure like Disconnect(const owner: TComponent); and then
procedure TMyForm.Loaded; // override
var c: TComponent; i: integer;
begin
try
MyDBUtils.Disconnect(Self);
finally
inherited;
end;
end;
This approach also has drawbacks though:
This would make MyDBUtils unit tightly coupled with all and every the database-related libs and components you might use. For large inherited projects, consisting of different binary modules, historically based on different db-access libraries and in process of migration, thus pulling all the access libraries into every binary module.
It can be overcome by ad hoc DI framework, but then the opposite can happen: you risk under-delivering, you may just forget to inject some library or component handler into the project that actually use it or got modified to use it.
If your form would have some components, whose connectivity should NOT be reset (object arrays as datasets, in-memory tables, in-memory NexusDB or SQLite databases, etc), you'd have to come up with ad hoc non-obvious convention to opt them out.
In my applications, I set my connection's Tag property to 1 at design time. In the OnBeforeConnect event, I check Tag, and if it is equal to 1, I abort the connection and set it to 0.

Do I need to call TCanvas.Refresh after RestoreDC?

I am maintaining some code that contains the following:
Canvas.Refresh;
SavedDC := SaveDC(Canvas.Handle);
try
// Paint Stuff to the Canvas
finally
RestoreDC(Canvas.Handle, SavedDC);
Canvas.Refresh;
end;
I have learned that TCanvas.Refresh is nothing like a component refresh. It does not cause anything to paint, it just invalidates the Font, Pen, and Brush of the canvas.
I don't understand why you would call .Refresh before Saving the DC and then after restoring it back. That seems to kind of defeat the purpose of the SaveDC/RestoreDC calls.
A more reasonable order for these calls seems to be:
SaveDC(Canvas.Handle)
Canvas.Refresh
try
// Do my painting
finally
RestoreDC(Canvas.Handle, SavedDC);
end;
Since I have never seen or used the TCanvas.Refresh method I wanted to check and make sure I understood this correctly.
Here is an explanation - http://edn.embarcadero.com/article/27786
Calling Refresh after RestoreDC guarantees synchronization between TCanvas state and underlying device context.
Not sure that calling Refresh before SaveDC is necessary in modern Windows versions, but where is nothing wrong in it.
I would recommend to leave the code as is.

Delphi/GDI+: When is a Device Context created/destroyed?

Normally using GDI+ in Delphi you can use a TPaintBox, and paint during the OnPaint event:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
g: TGPGraphics;
begin
g := TGPGraphics.Create(PaintBox1.Canvas.Handle);
try
g.DrawImage(FSomeImage, 0, 0);
finally
g.Free;
end;
end;
The problem with this paradigm is that creating a destroying a Graphics object each time is wasteful and poorly performing. Additionally, there are a few constructs availabe in GDI+ you can only use when you have a persistent Graphics object.
The problem, of course, is when can i create that Graphics object? i need to know when the handle becomes available, and then when it is no longer valid. i need this information so i can create and destroy my Graphics object.
Solution Attempt NÂș1
i can solve the creation problem by creating it when it is really needed - on the first time the paint cycle is called:
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
if FGraphics = nil then
FGraphics := TGPGraphics.Create(PaintBox1.Canvas.Handle);
FGraphics.DrawImage(FSomeImage, 0, 0);
end;
But i have to know when the device context is no longer valid, so i can destroy my FGraphcis object, so that it is re-created the next time it's needed. If for some reason the TPaintBox's device context gets recreated, i would be drawing on an invalid device context the next time OnPaint is called.
What is the intended mechanism in Delphi for me to know when the device context handle of a TPaintBox is created, destroyed, or re-created?
You can't with the standard TPaintBox because the TPaintBox has a Canvas of type TControlCanvas, for which members relevant to this issue are these:
TControlCanvas = class(TCanvas)
private
...
procedure SetControl(AControl: TControl);
protected
procedure CreateHandle; override;
public
procedure FreeHandle;
...
property Control: TControl read FControl write SetControl;
end;
The problem is that FreeHandle and SetControl are not virtual.
But: the TControlCanvas is created and assigned here:
constructor TGraphicControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
So what you could do is create a descending TMyControlCanvas that does have virtual methods, and a TMyPaintBox that assigns the Canvas like this:
constructor TMyPaintBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas.Free;
FCanvas := TMyControlCanvas.Create;
TMyControlCanvas(FCanvas).Control := Self;
end;
Then you can use the methods in TMyControlCanvas to dynamically create and destroy your TGPGraphics.
That should get you going.
--jeroen
Detecting creation is easy. Just override CreateHandle in a descendant TControlCanvas and put yours in place of the default one as Jeroen's answer demonstrates. Detecting destruction is harder.
One way to avoid the issue is to check whether the TGpGraphics handle is equal to the paint-box's handle, so, rather than detect the moment when the device context is freed, you simply check before you need to know.
if not Assigned(FGraphics)
or (FGraphics.GetHDC <> PaintBox1.Canvas.Handle) then begin
FGraphics.Free;
FGraphics := TGpGraphics.Create(PaintBox1.Canvas.Handle);
end;
This probably isn't reliable, though; handle values are liable to be re-used, so although the HDC value might be the same between two checks, there's no guarantee that it still refers to the same OS device-context object.
The TCanvas base class never clears its own Handle property, so anything that invalidates the canvas must occur externally. TControlCanvas clears its Handle property when its Control property gets re-assigned, but that usually only happens when the control is created since TControlCanvas instances are rarely shared. However, TControlCanvas instances work from a pool of device-context handles kept in CanvasList. Whenever one of them needs a DC (in TControlCanvas.CreateHandle), it calls FreeDeviceContext to make room in the canvas cache for the handle it's about to create. That function calls the (non-virtual) FreeHandle method. The cache size is 4 (see CanvasListCacheSize), so if you have several descendants of TCustomControl or TGraphicControl in your program, chances are high that you'll get cache misses whenever more than four of them need to be repainted at once.
TControlCanvas.FreeHandle is not virtual, and it doesn't call any virtual methods. Although you could make a descendant of that class and give it virtual methods, the rest of the VCL is going to continue calling the non-virtual methods, oblivious to any of your additions.
Instead of trying to detect when a device context is released, you might be better off using a different TGpGraphics constructor. Use the one that takes a window handle instead of a DC handle, for instance. Window-handle destruction is much easier to detect. For a one-off solution, assign your own method to the TPaintBox.WindowProc property and watch for wm_Destroy messages. If you're doing this often, then make a descendant class and override DestroyWnd.
The performance hit you take for creating/destroying the graphics object is minimal. It's far outweighed by the performance hit of using gdi+'s drawing commands in the first place. Neither of which, imo, are worth worrying about when it comes to drawing user interfaces because the user wont notice anyways. And frankly, it can be very inconvenient to try to carry around a graphics object and track changes to the DC handle (especially if you're encapsulating graphics routines inside your own set of classes).
If you need to cache bitmaps, what you may consider doing is creating the bitmap you want to cache with GDI+ (make it the right size & w/ whatever antialias settings you want), saving it to a tmemorystream, and then when you need it, load it from a stream and draw it using good ol' bitblt. It'll be much, much faster than using Graphics.DrawImage. I'm talking orders of magnitude faster.
procedure TGraphicControl.WMPaint(var Message: TWMPaint);
begin
if Message.DC <> 0 then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint;
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
end;
end;
Canvas.Handle := Message.DC;

Resources