How to update GUI from Thread using Delphi - multithreading

I am using Delphi anonymous thread to execute code.
In the middle of the thread, a couple of GUI updates have to take place, a couple of labels changing etc.
If I do this from inside the thread, the changes take place, but as soon as the thread stops. they disappear, and then the application gives me the old window handler error...(Which is to be expected)
System Error. Code:1400. Invalid window handle
I tried using the Syncronize(updateui); method to execute the changes(moved them to a separate function), but I get an error on the syncronize E2066 Missing operator or semicolon which does not make sense to me at all...
I have searched through page after page, and they all seem to call it this way, but when I do, I get the above error...
Am I calling it wrong?
Code:
TThread.CreateAnonymousThread(
procedure
begin
main.Enabled:=false;
Loading.show;
label52.caption:=getfieldvalue(datalive.users,'users','credit_amount','user_id',user_id );
CoInitialize(nil);
if (length(maskedit1.Text)=maskedit1.MaxLength) and (pingip(serverip)=true) then
begin
if (strtofloat(label52.caption)>0) then
begin
....do some work....
Synchronize(updateui);
end
else Showmessage('Insufficient Funds. Please add funds to continue.');
end
else if (length(maskedit1.Text)<>maskedit1.MaxLength) then
begin
Showmessage('ID Number not long enough.');
end
else
begin
Showmessage('Could not connect to the server. Please check your internet connection and try again.');
end;
CoUnInitialize;
loading.close;
main.Enabled:=true;
end).start;
UpdateUI:
procedure TMain.updateui;
var
birthdate,deathdate:TDate;
begin
Panel3.Show;
Label57.Caption := 'Change 1';
Label59.Caption := 'Change 2';
Label58.Caption := 'Change 3';
Label60.Caption := 'Change 4';
Label62.Caption := 'Change 5';
Label70.Caption := 'Change 6';
ScrollBox1.Color := clwhite;
end;

Use TThread.Synchronize and pass another anonymous function to it. Then you can call updateui in the anonymous function:
TThread.CreateAnonymousThread(
procedure
begin
// do whatever you want
TThread.Synchronize(nil,
procedure
begin
updateui();
end);
// do something more if you want
end
).Start();
Synchronizations are generally expensive (regarding performance). Only do them when they are really neccessary. You can increase the performance if you extend the updateui-method to reduce paint-operations.
This is possible to a call to SendMessage with WM_SETREDRAW:
procedure StopDrawing(const Handle: HWND);
const
cnStopDrawing = 0;
begin
SendMessage(Handle, WM_SETREDRAW, cnStopDrawing, 0);
end;
procedure ContinueDrawing(const Handle: HWND);
const
cnStartDrawing = 1;
begin
SendMessage(Handle, WM_SETREDRAW, cnStartDrawing, 0);
// manually trigger the first draw of the window
RedrawWindow(Handle, nil, 0,
RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;
Add a call to StopDrawing() at the top of updateui() and a call to ContinueDrawing() at the end of updateui(). The call to ContinueDrawing() should be in a finally-block. This will ensure that the window will be painted even after an exception has occured during the execution of updateui.
Example:
procedure TMain.updateui;
begin
try
StopDrawing(Handle);
Panel3.Show;
Label57.Caption := 'Change 1';
Label59.Caption := 'Change 2';
// ...
finally
// Code under finally gets executed even if there was an error
ContinueDrawing(Handle);
end;
end;

Related

Correct usage of AtomicCmpExchange?

After struggling to avoid deadlocks using Synchronize() with DirectShow I decided to switch to an optimistic lock pattern. This is my first time using AtomicCmpExchange() and I found very few Delphi examples online. I don't see any downside and don't know why more thread locking isn't done this way.
What are the pitfalls of the following code? The lack of examples make me concerned that there is a fundamental flaw with this approach.
procedure TCueRunner.Lock(Desc: String);
begin
// cs.Enter;
var StopWatch := TStopwatch.StartNew;
while (AtomicCmpExchange(LockAtomic, 1, 0) = 1) do
begin
Sleep(1);
if StopWatch.ElapsedMilliseconds > MUTEX_TIMEOUT then
begin
LockAtomic := 0;
LogMsg('CRITICAL! TCueRunner lock timed out in function '+Desc);
break;
end;
end;
end;
procedure TCueRunner.Unlock;
begin
LockAtomic := 0; // This should be an atomic operation
// cs.Leave;
end;
First, your lock cannot be recursively used. It's not always an issue, but it's usually worth it to make it work recursively as it's pain to always make sure it's not used in this fashion.
Second, as commented by Dalija, it's not really an expected behavior that a lock attempt that timeout would cause the lock to be automatically unlocked.
Third, if locking fails, your method should raise an exception, otherwise, the calling code will proceed as if the lock had succeeded. Alternately, you could change your method to a function returning a boolean indicating if the lock succeeded or not.
If I adapt your code, that would give something like this (Untested) :
procedure TCueRunner.Lock(Desc: String);
begin
var StopWatch := TStopwatch.StartNew;
repeat
var PrevLockValue := AtomicCmpExchange(LockAtomic, TThread.CurrentThread.ThreadID, 0);
if PrevLockValue = 0 then //wasn't locked
FLockCount := 1
else if PrevLockValue = TThread.CurrentThread.ThreadID then //Was locked previously, but by the current thread.
Inc(FLockCount)
else
begin //Is locked by another thread
Sleep(1);
if StopWatch.ElapsedMilliseconds > MUTEX_TIMEOUT then
raise Exception.Create('CRITICAL! TCueRunner lock timed out in function '+Desc);
CONTINUE;
end;
BREAK;
until False;
end;
procedure TCueRunner.Unlock;
begin
if LockAtomic = TThread.CurrentThread.ThreadID then
begin
Dec(FLockCount);
if FLockCount = 0 then
LockAtomic := 0;
end else
LogMsg('Unlocking from the wrong thread!!!!');//Or not locked...
end;
Note : This should work properly on WIN32/64, I'm unsure about other platforms.

Threading on Android Tablet causing freezes

I'm working on a Firemonkey application in Delphi Tokyo and decided to add a loader screen that does some animation. I have a form with a list animation that is run within one thread, and then my calls to the datasnap server runs within another thread. I'm doing it like this because I couldn't get the animation to work if both calls wasn't within a thread.
Now running this on the windows version works fine. Running it on both my Huawei phone and another samsung tablet works 70% of the time. The other 30% of the time it freezes and I have to kill the app. When the datasnap load is done the loader form is supposed to be freed and closed and the main panels opacity is set to 1 and I enable the panel again. I'm not sure 100% if the app freezes and if the code is not run successfully thats supposed to enable the panel again. I was able to debug it one time while not working which produced an out of memory error, but I'm unable to recreate the issue while debugging on the phone.
The idea was that when the logging button is pressed a loader screen shows some animation while the data is retrieved and then hides it again. Am I doing something wrong in the below code?
ShowLoader;
fThread := TTask.Create
(
procedure ()
begin
try
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(edtEmail.Text, edtPassword.Text);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
begin
Toolbarheader.Visible := True;
lblLoginInfo.Visible := false;
lblWelcome.Text := 'Welcome ' + fmxDataModule.LoggedInUser.FirstName.Value + ', ' + fmxDataModule.LoggedInUser.LastName.Value;
GoToProfilesTab.Execute;
GenerateProfiles;
pnlButtons.Visible := True;
fLoggedIn := True;
FormResize(nil);
end else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
);
fThread.Start;
Here is the code for ShowLoader:
procedure TfrmLogin.CreateLoaderForm;
begin
if Assigned(fLoader) then
FreeAndNil(fLoader);
fLoader := TfrmLoader.Create(Self);
floader.Parent := Self;
fLoader.Left := Self.Left + (Self.Width div 2) - (fLoader.Width div 2);
fLoader.Top := Self.Top + (Self.Height div 2) - (fLoader.Height div 2);
fLoader.Show;
end;
procedure TfrmLogin.ShowLoader;
begin
pnlMain.Enabled := false;
pnlMain.Opacity := 0.4;
TTask.Create (
procedure ()
begin
TThread.Queue(TThread.CurrentThread,
procedure()
begin
CreateLoaderForm
end);
end
).Start;
end;
Hiding the loader:
procedure TfrmLogin.HideLoader;
begin
pnlMain.Enabled := True;
pnlMain.Opacity := 1;
// pnlMain.Repaint;
fLoader.Visible := False;
end;
Am I missing something in the code above?
Another question is why does my form not open in the middle of the screen? I've tried different things, setting the position in the form properties, and manually calculating it. It always opens up top left corner on the device, but works on windows.
After trying a different approach like #nolaspeaker suggested, and syncronising the username and passwords fields like #RemyLebeau suggested, I removed the form loader that was in a different thread, and the problem still persisted. Doing that became obvious that there must be a problem in the below piece of code I posted initially, only a bit refactored:
TThread.CreateAnonymousThread
(
procedure
var
LsUsername,LsPassword:String;
begin
try
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
LsUsername := edtEmail.Text;
LsPassword := edtPassword.Text;
end
);
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(LsUsername, LsPassword);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
GoToProfilesTab.Execute
else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
).Start;
Trying a couple more times to debug the scenario I ended up in TTabControl.SetActiveTabWithTransition.
The issue occurs on this line
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
in this block of code:
procedure TTabControl.SetActiveTabWithTransition(const ATab: TTabItem; ATransition: TTabTransition;
const ADirection: TTabTransitionDirection = TTabTransitionDirection.Normal);
...
begin
case ATransition of
TTabTransition.Slide:
begin
FTransitionRunning := True;
ClipChildren := True;
try
...
if ADirection = TTabTransitionDirection.Normal then
begin
P...
end
else
begin
...
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
end;
finally
SetLength(FTransitionTabs, 0);
ClipChildren := False;
FTransitionRunning := False;
Realign;
end;
// Force repaint
Application.ProcessMessages;
end
else
ActiveTab := ATab;
end;
end;
So I remove the tab transitioning for that one click and it finally works as expected. The moment I put the transitioning back to Slide, it freezes again on that line. I'll be sure to report this issue.

How to terminate anonymous threads in Delphi on application close?

I have a Delphi application which spawns 6 anonymous threads upon some TTimer.OnTimer event.
If I close the application from the X button in titlebar Access Violation at address $C0000005 is raised and FastMM reports leaked TAnonymousThread objects.
Which is the best way to free anonymous threads in Delphi created within OnTimer event with TThread.CreateAnonymousThread() method?
SOLUTION which worked for me:
Created a wrapper of the anonymous threads which terminates them upon being Free-ed.
type
TAnonumousThreadPool = class sealed(TObject)
strict private
FThreadList: TThreadList;
procedure TerminateRunningThreads;
procedure AnonumousThreadTerminate(Sender: TObject);
public
destructor Destroy; override; final;
procedure Start(const Procs: array of TProc);
end;
{ TAnonumousThreadPool }
procedure TAnonumousThreadPool.Start(const Procs: array of TProc);
var
T: TThread;
n: Integer;
begin
TerminateRunningThreads;
FThreadList := TThreadList.Create;
FThreadList.Duplicates := TDuplicates.dupError;
for n := Low(Procs) to High(Procs) do
begin
T := TThread.CreateAnonymousThread(Procs[n]);
TThread.NameThreadForDebugging(AnsiString('Test thread N:' + IntToStr(n) + ' TID:'), T.ThreadID);
T.OnTerminate := AnonumousThreadTerminate;
T.FreeOnTerminate := true;
FThreadList.LockList;
try
FThreadList.Add(T);
finally
FThreadList.UnlockList;
end;
T.Start;
end;
end;
procedure TAnonumousThreadPool.AnonumousThreadTerminate(Sender: TObject);
begin
FThreadList.LockList;
try
FThreadList.Remove((Sender as TThread));
finally
FThreadList.UnlockList;
end;
end;
procedure TAnonumousThreadPool.TerminateRunningThreads;
var
L: TList;
T: TThread;
begin
if not Assigned(FThreadList) then
Exit;
L := FThreadList.LockList;
try
while L.Count > 0 do
begin
T := TThread(L[0]);
T.OnTerminate := nil;
L.Remove(L[0]);
T.FreeOnTerminate := False;
T.Terminate;
T.Free;
end;
finally
FThreadList.UnlockList;
end;
FThreadList.Free;
end;
destructor TAnonumousThreadPool.Destroy;
begin
TerminateRunningThreads;
inherited;
end;
End here is how you can call it:
procedure TForm1.Button1Click(Sender: TObject);
begin
FAnonymousThreadPool.Start([ // array of procedures to execute
procedure{anonymous1}()
var
Http: THttpClient;
begin
Http := THttpClient.Create;
try
Http.CancelledCallback := function: Boolean
begin
Result := TThread.CurrentThread.CheckTerminated;
end;
Http.GetFile('http://mtgstudio.com/Screenshots/shot1.png', 'c:\1.jpg');
finally
Http.Free;
end;
end,
procedure{anonymous2}()
var
Http: THttpClient;
begin
Http := THttpClient.Create;
try
Http.CancelledCallback := function: Boolean
begin
Result := TThread.CurrentThread.CheckTerminated;
end;
Http.GetFile('http://mtgstudio.com/Screenshots/shot2.png', 'c:\2.jpg');
finally
Http.Free;
end;
end
]);
end;
No memory leaks, proper shutdown and easy to use.
If you want to maintain and exert control over a thread's lifetimes then it must have FreeOnTerminate set to False. Otherwise it is an error to refer to the thread after it has started executing. That's because once it starts executing, you've no ready way to know whether or not it has been freed.
The call to CreateAnonymousThread creates a thread with FreeOnTerminate set to True.
The thread is also marked as FreeOnTerminate, so you should not touch the returned instance after calling Start.
And so, but default, you are in no position to exert control over the thread's lifetime. However, you could set FreeOnTerminate to False immediately before calling Start. Like this:
MyThread := TThread.CreateAnonymousThread(MyProc);
MyThread.FreeOnTerminate := False;
MyThread.Start;
However, I'm not sure I would do that. The design of CreateAnonymousThread is that the thread is automatically freed upon termination. I think I personally would either follow the intended design, or derive my own TThread descendent.
To avoid errors using CreateAnonymousThread just set FreeOnTerminate to False before starting it.
This way you can work with the thread as you usually do without any workaround.
You can read the documentation that says that CreateAnonymousThread automatically sets FreeOnTerminate to True and this is what is causing the errors when you reference the thread.
Make your threads watch for some kind of notification from the outside. This could be an event that gets signaled, a message sent to a window owned by the thread, a command sent over a socket that your thread listens to, or whatever other form of communication you find.
If you determine that this problem is because your threads are so-called "anonymous" threads, then a simple workaround is for you to make them be non-anonymous threads. Put the body of the anonymous function into the Execute method, and pass any captured variables to the thread class via its constructor.

Image browsing program - Why does it randomly crash after making it threaded?

Long story short, I'm very far from a skilled programmer, in fact, my most complicated programs so far were either plain ASCII string manipulating, simple maths and array searching/sorting either in Free Pascal or later, Delphi 7 and Java. This was some years ago, when I learnt programming in high school faculty (that was plain Pascal). Later I went on to become a programmer (meeting with D7 and Java, and some C++), but I had quit my programming studies due to personal reasons, and since then, I didn't wrote a single line of code.
Erm, sorry for the long introduction, so... Recently I decided to revive programming as my hobby, mainly because I didn't found a suitable program for some tasks I would like to accomplish since long. In spite of my faint understanding of such fairly basic things as explicit parameters, pointers, objects, classes, constructors and threads, with the help of a programming book, Delphi help files and the internet, I managed to write a simple program in Delphi 7 that can load and display certain image file formats in a given directory using external libraries, make it possible to arbitrarily switch among them (using the GUI), and log some information (mainly for debug purposes) in text files.
However, I encountered a problem at the current version of the code when I tried to make the image loading and displaying function threaded. First, for better understanding, I'll explain the logic of my program.
First of all, in the main form's FormCreate event, the program looks for supported image files in the current directory (where the exe is). If there is no image files, the current directory is set at the one at the upper level (with the standard Windows file system symbol "..") and is checked for images. Supported image files are determined by file extensions. Anyway, this explorer function stores the found images' filename and a file type identifier (which is a byte) in a dynamic array. Then, using this array as a reference, the first supported image file is loaded by the correct library and displayed in the form. The GUI has buttons and a combobox to change between images, with each control's OnClick or OnSelect (combobox) event setting variables about the supposedly current image file and calling the image loader and displayer function which uses the reference array.
The problem is that some images are so huge that the loading takes noticeable time, so the GUI can't respond until the image is fully loaded and displayed. I tried to make this program threaded by initializing each image loader function as a thread. While the GUI is more responsive now, there are certainly two new bugs with the program.
The first is that the program sometimes randomly crashes when changing images, with appearing messages either referring to "JPEG Error #58" (supposedly meaning "invalid file structure" in Delphi's in-built jpeg library), "EAccessViolation" exception, "EOSError" exception (including "System Error, Code 5"), "unknown software exception", "Runtime error 216", and error messages about memory locations and failed read operations. Before using threads, none of these error messages appeared, but I certainly want to (and must) use threads in the program.
The other, minor bug is that when the interface buttons are clicked in a fast succession, it seems like all loading and displaying takes place, although in a laggy-then-quickly manner. I don't really have an idea on how to "kill" a thread and initiate it "again" to load the now-current file instead of the obsolete one it tried to load a few hundred milliseconds ago.
I start a thread in the following manner:
LoaderThread := CreateThread(nil, 0, Addr(LoadPicture), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
I use this two times in the main form's FormCreate event (although only one of them executes at any start), and in the GUI controls' OnClick or OnSelect event to faciliate the desired function of the control (for example skip to the last image).
Any suggestions? Thank you in advance! :)
UPDATE:
Here is some (well, almost all) of my source code:
procedure TMainForm.FormCreate(Sender: TObject);
begin
MainForm.DoubleBuffered := true;
MainJPEG := TJPEGImage.Create;
MainJPEG.ProgressiveDisplay := true;
MainJPEG.Smoothing := true;
MainJPEG.Performance := jpBestQuality;
MainPNG := TPNGObject.Create;
MainGIF := TGIFImage.Create;
AssignFile(Log, '_NyanLog.txt');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
if CurrentDirHasImages = false then
begin
SetCurrentDir('..');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
end;
if CurrentDirHasImages = true then
begin
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
if Length(ImagesOfCurrentDir) > 1 then
begin
MainForm.NextButton.Enabled := true;
MainForm.EndButton.Enabled := true;
MainForm.SlideshowButton.Enabled := true;
MainForm.SlideshowIntervalUpDown.Enabled := true;
end;
UpdateTitleBar;
end
else UpdateTitleBar;
end;
procedure ExploreCurrentDir;
var
Over: boolean;
begin
CurrentPos := 0;
Over := false;
ReWrite(Log);
Write(Log, 'blablabla');
if FindFirst(CurrentDir+'\*.*', faAnyFile-faDirectory, Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
while Over = false do
begin
if FindNext(Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
end
else
begin
FindClose(Find);
Over := true;
end;
end;
CurrentDirImageCount := Length(ImagesOfCurrentDir);
CurrentDirHasImages := true;
Write(Log, 'blablabla');
end;
if CurrentDirHasImages = false then Write(Log, 'blablabla');
CloseFile(Log);
CurrentPos := 0;
end;
procedure LoadImage; //procedure #1 which should be used in a thread
begin
if CurrentFiletype = BMP then
begin
MainForm.MainImage.Picture := nil;
MainForm.MainImage.Picture.LoadFromFile(CurrentFilename)
end
else
if CurrentFiletype = JPEG then
begin
MainForm.MainImage.Picture := nil;
MainJPEG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainJPEG);
end
else
if CurrentFiletype = PNG then
begin
MainForm.MainImage.Picture := nil;
MainPNG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainPNG);
end
else
if CurrentFiletype = GIF then
begin
MainForm.MainImage.Picture := nil;
MainGIF.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainGIF);
end;
end;
procedure NextImage; //the "NextButton" button from the GUI calls this
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
while MainImageIsEmpty = true do
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
end;
if CurrentPos = CurrentDirImageCount-1 then Break;
end;
end;
if CurrentPos = CurrentDirImageCount-1 then
begin
MainForm.NextButton.Enabled := false;
MainForm.EndButton.Enabled := false;
MainForm.SlideshowButton.Enabled := false;
MainForm.SlideshowIntervalUpDown.Enabled := false;
end;
MainForm.PrevButton.Enabled := true;
MainForm.StartButton.Enabled := true;
end;
procedure PrevImage; //called by "PrevButton"
begin
//some code, calls LoadImage
//almost the same logic as above for a backward step among the images
end;
procedure FirstImage; //called by "StartButton"
begin
//some code, calls LoadImage
end;
procedure LastImage; //called by "EndButton"
begin
//some code, calls LoadImage
end;
procedure Slideshow; //procedure #2 which should be used in a thread
begin
while SlideshowOn = true do
begin
SlideshowInterval := MainForm.SlideshowIntervalUpDown.Position*1000;
Sleep(SlideshowInterval);
NextImage; //NextImage calls LoadImage which should be a thread
if CurrentPos = CurrentDirImageCount-1 then SlideshowOn := false;
end;
end;
function MainImageIsEmpty;
begin
if MainForm.MainImage.Picture = nil then MainImageIsEmpty := true
else MainImageIsEmpty := false;
end;
procedure TMainForm.NextButtonClick(Sender: TObject);
begin
NextImage;
end;
procedure TMainForm.PrevButtonClick(Sender: TObject);
begin
PrevImage;
end;
procedure TMainForm.StartButtonClick(Sender: TObject);
begin
FirstImage;
end;
procedure TMainForm.EndButtonClick(Sender: TObject);
begin
LastImage;
end;
procedure TMainForm.SlideshowButtonClick(Sender: TObject);
begin;
if SlideshowOn = false then
begin
SlideshowOn := true;
SlideshowThread := BeginThread(nil, 0, Addr(Slideshow), nil, 0, SlideshowThreadID);
SlideshowButton.Caption := '||';
SlideshowButton.Hint := 'DIAVETÍTÉS LEÁLLÍTÁSA';
end
else
begin
SlideshowOn := false;
CloseHandle(SlideshowThread);
SlideshowButton.Caption := '|>';
SlideshowButton.Hint := 'DIAVETÍTÉS INDÍTÁSA';
end;
end;
There's a lot of text here, and not much code. Your question would probably be better with more code and less text.
Anyway, I can offer some hints.
Firstly, calling CreateThread directly is a rather laborious way to do threading in Delphi. It's easier to use TThread which wraps up some of the low-level Windows API issues in a manner more native to typical Delphi code style. Of course, you could go further and use a threading library like OmniThreadLibrary, but for now it may be better just to stick to TThread and work out how to do it that way.
Now, that won't be your problem here. Almost certainly your problem will be cause by one of two common issues with threading:
All VCL and GUI code should run in the main thread. Windows controls have affinity with the thread that creates them. Many parts of the VCL are not thread-safe. These issues strongly push you to putting all VCL/GUI code in the main thread.
It's quite possible that you have a race condition due to lack of synchronisation.
The most common way to deal with issue 1 is to call TThread.Synchronize or TThread.Queue from the worker threads in order to force all the VCL/GUI code to run on the main thread. Of course you need to be sure that none of the time-consuming code in your worker thread uses VCL/GUI objects since that is doomed to failure.
Issue 2 can be dealt with by synchronisation objects like critical sections or lock-free methods using the InterlockedXXX family of functions.
Exactly what your problem is I can't say. If you want more detailed help then please post more code, most probably cut down from what you are currently running.
You create a thread and kill it right away without waiting for it to finish loading
LoadImage is not VCL thread safe
Here simple seudo thread in VCL way. Codes is in simple form and you can study further and make enhancement
TYourThread.Create(image file name);
type
TYourThread = class(TThread)
protected
FBitmap: TBitmap;
FImageFileName: string;
procedure BitmapToVCL;
begin
MainForm.MainImage.Picture := FBitmap;
end;
procedure Execute; override;
begin
FBitmap := TBitmap.Create;
try
FBitmap.LoadFromFile(FImageFileName);
Synchronize(BitmapToVCL);
finally
FreeAndNil(FBitmap);
end;
end;
public
constructor Create(const AImageFileName: string);
begin
FImageFileName := AImageFileName;
inherited Create(False);
FreeOnTerminate := True;
end;
end;
Gook luck
Cheer

Raising Exception in TThread Execute?

I just realized that my exceptions are not being shown to the user in my threads!
At first I used this in my thread for raising the exception, which does not work:
except on E:Exception do
begin
raise Exception.Create('Error: ' + E.Message);
end;
The IDE shows me the exceptions, but my app does not!
I have looked around for a solution, this is what I found:
Delphi thread exception mechanism
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_22039681.html
And neither of these worked for me.
Here's my Thread unit:
unit uCheckForUpdateThread;
interface
uses
Windows, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, GlobalFuncs, Classes, HtmlExtractor, SysUtils, Forms;
type
TUpdaterThread = class(TThread)
private
FileGrabber : THtmlExtractor;
HTTP : TIdHttp;
AppMajor,
AppMinor,
AppRelease : Integer;
UpdateText : string;
VersionStr : string;
ExceptionText : string;
FException: Exception;
procedure DoHandleException;
procedure SyncUpdateLbl;
procedure SyncFinalize;
public
constructor Create;
protected
procedure HandleException; virtual;
procedure Execute; override;
end;
implementation
uses
uMain;
{ TUpdaterThread }
constructor TUpdaterThread.Create;
begin
inherited Create(False);
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(nil);
try
try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
except on E: Exception do
begin
UpdateText := 'Error while updating xSky!';
ExceptionText := 'Error: Cannot find remote file! Please restart xSky and try again! Also, make sure you are connected to the Internet, and that your Firewall is not blocking xSky!';
HandleException;
end;
end;
try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
except on E:Exception do
begin
HandleException;
end;
end;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then
begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.SyncFinalize;
begin
DoTransition(frmMain.TransSearcher3, frmMain.gbLogin, True, 500);
end;
procedure TUpdaterThread.SyncUpdateLbl;
begin
frmMain.lblCheckingForUpdates.Caption := UpdateText;
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TUpdaterThread.DoHandleException;
begin
Application.ShowException(FException);
end;
end.
If you need more info just let me know.
Again: The IDE catches all the exceptions, but my program does not show them.
EDIT: It was Cosmin's solution that worked in the end - and the reason it didn't at first, was because I didn't add the ErrMsg variable, instead I just placed whatever the variable would contain into the Synchronize, which would NOT work, however I have NO idea why. I realized it when I had no other ideas, and I just messed around with the solutions.
As always, the joke's on me. =P
Something very important you need to understand about multi-theraded development:
Each thread has its own call-stack, almost as if they're separate programs. This includes the main-thread of your program.
Threads can only interact with each other in specific ways:
They can operate on shared data or objects. This can lead to concurrency issues 'race conditions', and therefore you need to be able to help them 'share data nicely'. Which brings us to the next point.
They can "signal each other" using a variety of OS support routines. These include things like:
Mutexes
Critical Sections
Events
And finally you can send messages to other threads. Provided the thread has in some way been written to be a message receiver.
NB: Note that threads cannot strictly speaking call other threads directly. If for example Thread A tried to call Thread B directly, that would be a step on Thread A's call-stack!
This brings us to the topic of the question: "exceptions are not being raised in my threads"
The reason for this is that all an exception does is:
Record the error
And unwind the call-stack. <-- NB: Your TThread instance can't unwind the main thread's call-stack, and cannot arbitrarily interrupt the main threads execution.
So TThread will not automatically report exceptions to your main application.
You have to make the explicit decision as to how you wish to handle errors in threads, and implement accordingly.
Solution
The first step is the same as within a single threaded application. You need to decide what the error means and how the thread should react.
Should the thread continue processing?
Should the thread abort?
Should the error be logged/reported?
Does the error need a user decision? <-- This is by far the most difficult to implement, so we'll skip it for now.
Once this has been decided, implement the appropriate excpetion handler.
TIP: Make sure the exception doesn't escape the thread. The OS won't like you if it does.
If you need the main program (thread) to report the error to the user, you have a few options.
If the thread was written to return a result object, then it's easy: Make a change so that it can return the error in that object if something went wrong.
Send a message to the main thread to report the error. Note, the main thread already implements a message loop, so your application will report the error as soon as it processes that message.
EDIT: Code Sample for indicated requirement.
If all you want to do is notify the user, then Cosmind Prund's answer
should work perfectly for Delphi 2010. Older versions of Delphi need a little more work. The following is conceptually similar to Jeff's own answer, but without the mistakes:
procedure TUpdaterThread.ShowException;
begin
MessageDlg(FExceptionMessage, mtError, [mbOk], 0);
end;
procedure TUpdaterThread.Execute;
begin
try
raise Exception.Create('Test Exception');
//The code for your thread goes here
//
//
except
//Based on your requirement, the except block should be the outer-most block of your code
on E: Exception do
begin
FExceptionMessage := 'Exception: '+E.ClassName+'. '+E.Message;
Synchronize(ShowException);
end;
end;
end;
Some important corrections on Jeff's own answer, including the implementation shown within his question:
The call to Terminate is only relevant if your thread is implemented within a while not Terminated do ... loop. Take a look at what the Terminate method actually does.
The call to Exit is an unnecessary waste, but you probably did this because of your next mistake.
In your question, you're wrapping each step in its own try...except to handle the exception. This is an absolute no-no! By doing this you pretend that even though an exception occurred, everything is ok. Your thread tries the next step, but is actually guaranteed to fail! This is not the way to handle exceptions!
Here's my very, very short "take" on the issue. It only works on Delphi 2010+ (because that version introduced Anonymous methods). Unlike the more sophisticated methods already posted mine only shows the error message, nothing more, nothing less.
procedure TErrThread.Execute;
var ErrMsg: string;
begin
try
raise Exception.Create('Demonstration purposes exception');
except on E:Exception do
begin
ErrMsg := E.ClassName + ' with message ' + E.Message;
// The following could be all written on a single line to be more copy-paste friendly
Synchronize(
procedure
begin
ShowMessage(ErrMsg);
end
);
end;
end;
end;
Threads don't automatically propagate exceptions into other threads. So you must deal with it yourself.
Rafael has outlined one approach, but there are alternatives. The solution Rafael points to deals with the exception synchronously by marshalling it into the main thread.
In one of my own uses of threading, a thread pool, the threads catch and take over the ownership of the exceptions. This allows the controlling thread to handle them as it pleases.
The code looks like this.
procedure TMyThread.Execute;
begin
Try
DoStuff;
Except
on Exception do begin
FExceptAddr := ExceptAddr;
FException := AcquireExceptionObject;
//FBugReport := GetBugReportCallStackEtcFromMadExceptOrSimilar.
end;
End;
end;
If the controlling thread elects to raise the exception it can do so like this:
raise Thread.FException at Thread.FExceptAddr;
Sometimes you may have code that cannot call Synchronize, e.g. some DLLs and this approach is useful.
Note that if you don't raise the exception that was captured, then it needs to be destroyed otherwise you have a memory leak.
Well,
It is gonna be hard without your source code, but i have tested this:
How to handle exceptions in TThread objects
And it works fine. Perhaps you should take a look at it.
EDIT:
You are not following what the links you point out tell us to do. Check my link and you will see how to do that.
EDIT 2:
Try that and tell me if it worked:
TUpdaterThread= class(TThread)
private
FException: Exception;
procedure DoHandleException;
protected
procedure Execute; override;
procedure HandleException; virtual;
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(Nil);
try
Try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
Except
HandleException;
End;
Try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
Except
HandleException;
End;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TMyThread.DoHandleException;
begin
Application.ShowException(FException);
end;
EDIT 3:
You said you are no able to catch EIdHTTPProtocolException. But it works for me. Try this sample and see it for yourself:
procedure TUpdaterThread.Execute;
begin
Try
raise EIdHTTPProtocolException.Create('test');
Except
HandleException;
End;
end;
I've previously used SendMessge for inter thread communication using the TWMCopyData, so I think the following should work:
Const MyAppThreadError = WM_APP + 1;
constructor TUpdaterThread.Create(ErrorRecieverHandle: THandle);
begin
Inherited Create(False);
FErrorRecieverHandle := Application.Handle;
end;
procedure TUpdaterThread.Execute;
var
cds: TWMCopyData;
begin
try
DoStuff;
except on E:Exception do
begin
cds.dwData := 0;
cds.cbData := Length(E.message) * SizeOf(Char);
cds.lpData := Pointer(#E.message[1]);
SendMessage(FErrorRecieverHandle, MyAppThreadError, LPARAM(#cds), 0);
end;
end;
end;
I've only used it for sending simple data types or strings, but I'm sure it could be adapted send more information through as necessary.
You'll need add Self.Handle to the constructor in form created the thread and Handle the messsage in the form which created it
procedure HandleUpdateError(var Message:TMessage); message MyAppThreadError;
var
StringValue: string;
CopyData : TWMCopyData;
begin
CopyData := TWMCopyData(Msg);
SetLength(StringValue, CopyData.CopyDataStruct.cbData div SizeOf(Char));
Move(CopyData.CopyDataStruct.lpData^, StringValue[1], CopyData.CopyDataStruct.cbData);
Message.Result := 0;
ShowMessage(StringValue);
end;
Strange that everyone answered this question but failed to spot the obvious problem: given that exceptions raised in a background thread are asynchronous, and can occur at any time, this means that showing exceptions from a background thread would pop-up a dialog box at random times to the user, quite possibly showing an exception that has nothing to do with what the user is doing at the moment. I doubt that doing this could possibly enhance the user experience.

Resources