I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;
Related
Delphi 11
How to make it so that when you hover the cursor over the resizing of the form, a cross appears with some inscription like: "Do not resize" and it was impossible to resize the form?
I need to block my first form resize when I call my second form. I'm quite new to Delphi, can you help me, please?
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
Form1.Caption:= 'Main';
Form1.BorderStyle:= bsSingle;
//And Form1.OnCanResize() or in some other way?
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Caption:= 'Main Form';
Form1.BorderStyle:= bsSizeable;
Form2.Hide;
end;
The question is settled.
"If you don't like the answer it's doesn't mean that it's not right. But continue to delete my comments :)"
It's so sad when professionals cannot help you but only express arrogance. Carry on, you are so funny)
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
Form1.Caption:= 'Main';
Form1.BorderStyle:= bsSingle;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Caption:= 'Main Form';
Form1.BorderStyle:= bsSizeable;
Form1.Cursor:= crDefault;
Form1.Hint:= '';
Form1.ShowHint:= False;
Form2.Hide;
end;
procedure TForm1.Timer1Timer(Sender: TObject); //Interval = 1
var
pt: TPoint;
Width, Heigth: Integer;
begin
GetCursorPos(pt);
if Form2.Visible then
begin
if (ScreenToClient(pt).X > ClientWidth - 10) or (ScreenToClient(pt).Y > ClientHeight - 10) then
begin
Cursor:= crNo;
Hint:= 'No resize';
ShowHint:= True;
end
else
begin
Cursor:= crDefault;
Hint:= '';
ShowHint:= False;
end;
end;
end;
I have a problem that I don't know how to fix.
I try to start a thread in the OnCreate event, or after creating a TFrame when its Parent is still nil. When creating the thread, I pass it a window handle, but the address of the window changes after e.g. the OnShow event.
procedure Form1.OnCreate(Sender: TObject);
begin
TCustomThread.Create(Self);
Label1.Caption := IntToStr(Self.Handle); //for example 10203040
end;
procedure Form1.ButtonOnClick;
begin
Label1.Caption := IntToStr(Self.Handle); //i give 342545454 not 10203040
end;
procedure Form1.FromThread(var Msg: TMessage); message WM_TheardComplete;
begin
{do something}
end;
constructor TCustomThread.Create(AWinControl: TWinControl);
begin
inherited Create(False);
FWinControl := AWinControl;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWinControl.Handle, WM_TheardComplete, 0, 0); //Handle 10203040
end;
What parameter can I use to start the thread so that it can later send messages to this object?
The TWinControl.Handle property is NOT thread-safe. The VCL can, and does, recreate a control's window dynamically during the control's lifetime, even multiple times. But more importantly, windows have thread affinity, where message retrieval and processing for a given window only works in the thread that creates the window. A worker thread using a control's Handle property causes a race condition that, if you are not careful, can actually cause the worker thread to capture ownership of the control's window, rendering the control completely useless in the main UI thread.
If you need to give a worker thread a window to post/send messages to, give the thread a persistent window that the VCL won't destroy (without you telling it to), for instance by using the main TApplication window, using its OnMessage event to handle posted messages, or its HookMainWindow() method to handle sent messages, eg:
procedure Form1.OnCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
TCustomThread.Create(Application.Handle);
end;
procedure Form1.OnDestroy(Sender: TObject);
begin
Application.OnMessage := nil;
end;
procedure Form1.AppMessage(var Msg: tagMSG; var Handled: Boolean);
begin
if Msg.message = WM_TheardComplete then
begin
Handled := True;
{do something}
end;
end;
constructor TCustomThread.Create(AWnd: HWND);
begin
inherited Create(False);
FWnd := AWnd;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWnd, WM_TheardComplete, 0, 0);
end;
Or better, use a new dedicated window created with the VCL's AllocateHWnd() function, eg:
procedure Form1.OnCreate(Sender: TObject);
begin
ThreadWnd := AllocateHWnd(ThreadWndProc);
TCustomThread.Create(ThreadWnd);
end;
procedure Form1.OnDestroy(Sender: TObject);
begin
DeallocateHWnd(ThreadWnd);
end;
procedure Form1.ThreadWndProc(var Message: TMessage);
begin
if Message.Msg = WM_TheardComplete then
begin
{do something}
end else
Message.Result := DefWindowProc(ThreadWnd, Message.Msg, Message.WParam, Message.LParam);
end;
constructor TCustomThread.Create(AWnd: HWND);
begin
inherited Create(False);
FWnd := AWnd;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWnd, WM_TheardComplete, 0, 0);
end;
However, in the example you have presented, rather than sending a message at the end of the thread's execution, I would suggest a completely different approach - use the TThread.OnTerminate event instead, which is already synced with the main thread, eg:
procedure Form1.OnCreate(Sender: TObject);
var
Thread: TCustomThread;
begin
Thread := TCustomThread.Create;
Thread.OnTerminate := ThreadFinished;
Thread.Start; // or Resume() in older versions
end;
procedure Form1.ThreadFinished(Sender: TObject);
begin
{do something}
end;
constructor TCustomThread.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
end;
Alternatively, in modern versions of Delphi, consider using TThread.CreateAnonymousThread() instead, eg:
procedure Form1.OnCreate(Sender: TObject);
var
Thread: TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
{do something}
end
);
Thread.OnTerminate := ThreadFinished;
Thread.Start;
end;
procedure Form1.ThreadFinished(Sender: TObject);
begin
{do something}
end;
Or even:
procedure Form1.OnCreate(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
try
{do something}
finally
TThread.Queue(nil,
procedure
begin
{do something}
end
);
end;
end
).Start;
end;
I have simple fmx form(Delphi 10.2 Tokyo):
in code I show Button2 for second:
procedure TForm6.FormCreate(Sender: TObject);
begin
Button2.Visible :=false;
end;
procedure TForm6.Button1Click(Sender: TObject);
begin
Button2.Visible := true;
TTask.Create(procedure
begin
Sleep(1000);
TThread.Synchronize(nil, procedure
begin
Button2.Visible := false;
//tries
//Button2.Repaint;
//Layout1.Repaint;
//Self.InvalidateRect(Self.Bounds);
//Application.ProcessMessages;
end);
end).Start;
end;
but after button2 hides, artefact appears. Its gone after manually form resize.
How to force it to refresh?
You need to use
ShadowEfect1.UpdateParentEffects;
I have a mainform (frmMain) with a pagecontrol. The pagecontrol is populated at startup by several forms, let us say Form1, Form2, and Form3
procedure TForm1.FormCreate(Sender: TObject);
begin
ManualDock(frmMain.PageControl1);
show;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
ManualDock(frmMain.PageControl1);
show;
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
ManualDock(frmMain.PageControl1);
show;
end;
That works great.
When I then change activepage, I want the OnActivate method called on the form corresponding to the activepage, so I tried this;
procedure TfrmMain.PageControl1Change(Sender: TObject);
begin
with pagecontrol1 do
begin
lbHeading.Caption := activepage.Caption;
with tform(activepage) do // <= This does
if assigned(onactivate) then // <= not
onactivate(self); // <= work
end;
end;
Activepage is of type TTabsheet
I found a solution:
with pagecontrol1 do
begin
with tform(activepage.controls[0]) do
if assigned(onactivate) then
onactivate(self);
end;
At the moment I'm using additional thread to nicely free memory after thread.
Before you ask. No I can't use FreeOnTerminate:=true because I need .waitfor.
I also need FreeAndNil() because only in this way I can check if thread is running using Assigned(). Example code.
procedure TForm1.Button1Click(Sender: TObject);
begin
SupervisorThread:= TSupervisorThread.Create(True);
SupervisorThread.FreeOnTerminate:=false; //MUST BE FALSE!
SupervisorThread.Priority := tpNormal;
SupervisorThread.Resume;
end;
procedure TSupervisorThread.Execute;
begin
CleaningThread:= TCleaningThread.Create(True);
CleaningThread.FreeOnTerminate:=true;
CleaningThread.Priority := tpNormal;
CleaningThread.Resume;
//some loops here
end;
procedure TCleaningThread.Execute;
begin
if Assigned(SupervisorThread)=true then
begin
SupervisorThread.WaitFor;
FreeAndNil(SupervisorThread);
end;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Assigned(SupervisorThread)=false then CanClose:=true
else
begin
CanClose:=false;
ShowMessage('Cannot close form because SiupervisorThread is still working');
end;
end;
Use the TThread.OnTerminate event:
private
procedure DoTerminateEvent(Sender: TObject);
var
isRunning: Boolean;
procedure TForm2.DoTerminateEvent(Sender: TObject);
begin
isRunning := False;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (isRunning) then
begin
CanClose := false;
ShowMessage('Cannot close form because SupervisorThread is still working')
end else
CanClose := true;
end;
Set the OnTerminate handler when creating the Thread:
SupervisorThread := TSupervisorThread.Create(True);
...
SupervisorThread.OnTerminate := DoTerminateEvent;
SupervisorThread.Resume;
Or, pass it as a parameter to the Thread's constructor:
TSupervisorThread = class(TThread)
public
constructor Create(OnTerminatEvent: TNotifyEvent);
end;
procedure TThreadCustom.Create(OnTerminateEvent: TNotifyEvent);
begin
inherited Create(True);
OnTerminate := OnTerminateEvent;
end;
SupervisorThread := TSupervisorThread.Create(DoTerminateEvent);
You can use the TThread.OnTerminate event to detect when a thread has finished running, eg:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(SupervisorThread) then
begin
SupervisorThread:= TSupervisorThread.Create(True);
SupervisorThread.FreeOnTerminate := False;
SupervisorThread.Priority := tpNormal;
SupervisorThread.OnTerminate := SupervisorThreadTerminated;
SupervisorThread.Resume;
end;
end;
procedure TForm1.SupervisorThreadTerminated(Sender: TObject);
begin
SupervisorThread := nil;
end;
However, this creates some problems. It creates a race condition, since the cleaning thread acts on the SupervisorThread pointer, which could disappear at any time while the cleaning thread is still running. And it creates a memory leak, as you still need to free the SupervisorThread object after it has terminated, but you can't do that in the OnTerminate handler directly.
A better solution would not rely on the SupervisorThread pointer at all.
var
SupervisorTerminated: TEvent;
procedure TForm1.FormCreate(Sender: TObject);
begin
SupervisorTerminated := TEvent.Create(nil, True, True, '');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(SupervisorThread) then
begin
SupervisorThread.Terminate;
while SupervisorTerminated.WaitFor(1000) = wrTimeout do
CheckSynchronize;
end;
SupervisorTerminated.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(SupervisorThread) then
begin
SupervisorThread := TSupervisorThread.Create(True);
SupervisorThread.FreeOnTerminate := True;
SupervisorThread.Priority := tpNormal;
SupervisorThread.OnTerminate := SupervisorThreadTerminated;
SupervisorTerminated.ResetEvent;
SupervisorThread.Resume;
end;
end;
procedure TForm1.SupervisorThreadTerminated(Sender: TObject);
begin
SupervisorThread := nil;
SupervisorTerminated.SetEvent;
end;
procedure TCleaningThread.Execute;
begin
SupervisorTerminated.WaitFor(INFINITE);
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := (SupervisorTerminated.WaitFor(0) = wrSignaled);
if not CanClose then
ShowMessage('Cannot close form because Supervisor Thread is still working');
end;