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.
Related
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!
Could you please help me to understand what is going on with FPU Control Word in my Delphi application, on Win32 platform.
When we create a new VCL application, the control word is set up to 1372h. This is the first thing I don't understand, why it is 1372h instead of 1332h which is the Default8087CW defined in System unit.
The difference between these two:
1001101110010 //1372h
1001100110010 //1332h
is the 6th bit which according to documentation is reserved or not used.
The second question regards CreateOleObject.
function CreateOleObject(const ClassName: string): IDispatch;
var
ClassID: TCLSID;
begin
try
ClassID := ProgIDToClassID(ClassName);
{$IFDEF CPUX86}
try
Set8087CW( Default8087CW or $08);
{$ENDIF CPUX86}
OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IDispatch, Result));
{$IFDEF CPUX86}
finally
Reset8087CW;
end;
{$ENDIF CPUX86}
except
on E: EOleSysError do
raise EOleSysError.Create(Format('%s, ProgID: "%s"',[E.Message, ClassName]),E.ErrorCode,0) { Do not localize }
end;
end;
The above function is changing control word to 137Ah, so it is turning on the 3rd bit (Overflow Mask). I don't understand why it is calling Reset8087CW after, instead of restoring the state of the word which was before entering into the function?
The 6th bit is reserved and ignored. Those two control words are in fact equal in the sense that the FPU behaves the same. The system just happens to set the reserved bit. Even if you attempt to set the value to $1332, the system will set it to $1372. No matter what value you ask the 6th bit to have, it will always be set. So, when comparing these values you have to ignore that bit. Nothing to worry about here.
As for CreateOleObject the authors decided that if you are going to use that function then you are also going to mask overflow when using the COM object, and indeed beyond. Who knows why they did so, and for 32 bit code only? Probably they found a bunch of COM objects that routinely overflowed, and so added this sticking plaster. It wasn't enough to mask overflow on creation, it also need to be done when using the object so The RTL designers chose to unmask overflow henceforth.
Or perhaps it was a bug. They decided not to fix it for 32 bit code because people relied on the behaviour, but they did fix for 64 bit code.
In any case this function does nothing very special. You don't need to use it. You can write your own that does what you want it to do.
Floating point control is a problem when working with interop. Delphi code expects unmasked exceptions. Code built with other tools typically masks them. Ideally you would mask exceptions when you call out of your Delphi code and unmask them on return. Expect other libraries to arbitrarily change the control word. Also be aware that Set8087CW is not thread safe which is a massive problem that Embarcadero have refused to address for many years.
There's no easy way forward. If you aren't using floating point in your program then you could simply mask exceptions and probably be fine. Otherwise you need to make sure that the control word is set appropriately at all points in all threads. In general that is close to impossible using the standard Delphi RTL. I personally handle this by replacing the key parts of the RTL with threadsafe versions. I have documented how to do so in this QC report: QC#107411.
Disclaimer: I debugged the questions in Delphi XE.
First, the second question.
If you look at the code of Set8087CW you will see that it stores the new FPU CW value in Default8087CW variable, and Reset8087CW restores FPU CW from Default8087CW; so the Reset8087CW call after Set8087CW does nothing at all, which is demonstrated by
Memo1.Lines.Clear;
Memo1.Lines.Add(IntToHex(Get8087CW, 4)); // 1372
Set8087CW( Default8087CW or $08);
Memo1.Lines.Add(IntToHex(Get8087CW, 4)); // 137A
Reset8087CW;
Memo1.Lines.Add(IntToHex(Get8087CW, 4)); // 137A
Evidently a bug.
Now the first question - it was interesting debugging exercise.
The Default8087CW value of Delphi VCL application is changed from hex 1332 to 1372 by Windows.CreateWindowEx function, called from Classes.AllocateHWnd, called from TApplication.Create, called from initialization section of Controls.pas unit.
Have a look at CreateWindowEx code - it explains what happens. I don't really want to discuss it further - the FPU support in Delphi is too messy and buggy.
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.
Good evening guys.
I'm currently designing a social networking client for Twitter and Facebook in Firemonkey FM2 (delphi) and I'm experiencing a frustrating issue. At present, I've only got the Twitter code in process, but the issue is related to the [re]drawing of visual objects.
I've created a custom-styled TListboxItem layout in a stylebook consisting of multiple child components such as TText, TButton, and TImage. I've already dealt with connecting to Twitter and retrieving feed details. Each item retrieved is added to a TListbox and styled using my custom ListboxItem style layout.
Now, the issue is related to updating information on items in the list that aren't visible. For example, the items that are visible in the list without scrolling show their information correctly. Those that aren't visible besides the final item in the list have several of their details not set/visible. When I scroll the list downwards, and then back up, there's often 1 of the items that was originally visible will now be missing it's information.
To explain this a little more, i've got a TImage (known as photo) which is used to show the photo of the person who posted the 'tweet'. I've got the standard TText (known as text) used to show the contents/text of the tweet itself. I've got 2 buttons (known as Like and Share) used to perform their respective functions. I've then finally got another TText (known as NameDate) used to show the name of the tweeter and the date the tweet was posted.
I'm using this code to create the object and modify the data it shows;
for i := 0 to TwitObj.Statuses.Count-1 do
begin
FeedItem := TListBoxItem.Create(LBFeed);
FeedItem.Parent := LBFeed;
FeedItem.StyleLookup := 'FeedItem';
FeedItem.WordWrap := True;
FeedItem.StyledSettings := [TStyledSetting.ssFamily, TStyledSetting.ssSize, TStyledSetting.ssStyle, TStyledSetting.ssFontColor, TStyledSetting.ssOther];
NameDate := Feeditem.FindStyleResource('txtnamedate') as TText;
Photo := FeedItem.FindStyleResource('photo') as TImage;
Like := FeedItem.FindStyleResource('btnlike') as TButton;
Share := FeedItem.FindStyleResource('btnshare') as TButton;
Share.Text := 'Retweet';
Like.Text := 'Favorite';
NameDate.Text := Twitobj.Statuses.Items[i].User.Name +
'(#'+TwitObj.Statuses.Items[i].User.ScreenName+
') - '+DateTimeToStr(TwitObj.Statuses.Items[i].CreatedAt);
FeedItem.Text := TwitObj.Statuses.Items[i].Text;
begin
if DirectoryExists('imagecache\') = false then CreateDir('imagecache\');
if FileExists('imagecache\'+TwitObj.Statuses.Items[i].User.ScreenName+'.jpg') = False then
begin
try
rcv := TMemoryStream.Create;
GtPhoto.URL := TwitObj.Statuses.Items[i].User.ImageURL;
GtPhoto.RcvdStream := rcv;
GtPhoto.Get;
rcv.SaveToFile('imagecache\'+TwitObj.Statuses.Items[i].User.ScreenName+'.jpg');
finally
Rcv.Free;
end;
end;
end;
Photo.Bitmap.LoadFromFile('imagecache\'+TwitObj.Statuses.Items[i].User.ScreenName+'.jpg');
GTPhoto is a standard ICS HTTP Client component, while TwitObj is my Twitter component. You can see that I'm saving the photo to a directory instead of streaming it. This was merely to check whether it was an issue with streams, but it's probably advisable to used a cache of some sort anyway.
The images download correctly, and the information for the relevant StyleResources in the custom ListBoxItem layout is updated as expected, but only for items that are visible without scrolling. If I scroll down the list, only the Text of each item is correct, while the other resources which were set at runtime have returned to the way they're designed in the stylebook (i.e. blank text, image, etc).
Am I missing something here? I understand the design intents of Bitmaps were changed in XE3 for the sake of performance, but surely Embarcadero wouldn't have overlooked something like this. Surely it's not expected for us to create each item inside the parent at runtime (and thus dealing with alignments and such) instead of using a stylebook resource, is it?
Any assistance or insight would be greatly appreciated.
FireMonkey can load and unload the style for a control at any moment. It was rather lax with this in FM1, but under FM2, styling elements are removed when a control is not visible and reapplied when it becomes visible again (in order to conserve memory, mainly in preparation for Mobile Studio).
What you need to do is override the ApplyStyle method. In it look up and set data in your style elements. This will probably mean that your control(s) need to cache what will be passed to the style.
Also note that if you are caching references to style elements (i.e. what you get back from FindStyleResource) then these will be freed when the style is unloaded and your pointers will be invalid. If so, you need to override FreeStyle and nil any pointers you may have cached.
When a Delphi Form is declared and instantiated inside a DLL and the DLL loaded by the host application, Arrow and Tab keys are not passed across the Host/DLL boundary. This means that TEdit boxes and TMemo controls that may be used on the form will not respond to these key strokes. Is there anyway to ensure that these key strokes are passed from the main application form to the form in the dll? Note there may be multiple DLLs, each containing a form. KeyPreview makes no difference.
Looking at this question, and your previous one, I would say that your basic problem is that you are not using runtime packages.
If you were using runtime packages then you would have a single instance of the VCL and module boundaries would not matter.
Without runtime packages you have separate VCL instances. For the VCL form navigation to work correctly you need each control to be recognised as a VCL control. This is not possible when you have multiple VCL instances.
Forms in DLL's miss this support, as well as support of menu shortcuts (actions). You can write some code to simulate this behaviour.
////////////////////////////////////////////////////////////////
// If you display a form from inside a DLL/COM server, you will miss
// the automatic navigation between the controls with the "TAB" key.
// The "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
bShift: Boolean;
begin
// Check for tab key and switch focus to next or previous control.
// Handle this in the KeyPress event, to avoid a messagebeep.
if (Ord(Key) = VK_TAB) then
begin
bShift := Hi(GetKeyState(VK_SHIFT)) <> 0;
SelectNext(ActiveControl, not(bShift), True);
Key := #0; // mark as handled
end;
end;