For quite some time I tried to improve the speed of my painting program. Unfortunately I just achieved some small improvements by using the OmnithreadLibrary and also by parallelizing the painting process and the loading process of Objects.
My Task in detail:
I stored >1.000.000 Objects in my Database ( Polygons, Rectangles and also Circles). The user should be able to select and paint elements by Type/Position ... .
The selected number of Elements from the user varies from 1 to the max Number of Elements stored in the Database.
Painting a big number of Polygons (>100000) is time consuming. Currently I achieved with my code an improvement of 25%.
How would you speed up the painting process? Where is the mistake?
I would be very grateful for any advice. :)
My Code in detail
Start loading Objects from SQL DB into an ElementArray. This is done by several loading threads. After loading the first Object, the painting thread begins to transform the Data into an Array of TPoints. Converting Data and also Painting Data is done in several Threads. All processes with one exception (Merging Bitmaps) runs parallel.
procedure TbmpthreadForm.StartPaintingPolygons(Sender: TObject);
var
elementsPerThread: Integer;
begin
// 1. Load Data from Database by multithreaded sql queries
// EVery single thread loads the same number of elements
For begin CreateTask(loadTask, IntToStr(i)).MonitorWith(otlMonitor1)
.SetParameter('SQL', sqlStr[i]).Run;
end;
// Save all Array indices in queue
dynamicQueue := TOmniBaseQueue.Create(655365, 4);
// CREATE QUERIES WITH SAME INSTANCE COUNT And Start load DB Objects
for
begin
CreateTask(loadTask, IntToStr(i)).MonitorWith(otlMonitor1)
.SetParameter('SQL', sqlStr).Run;
end;
// START MULTITHREADED PAINT PROCESS
// Single Thread -> Single BMP -> Merge BMPs
Parallel.ParallelTask.NumTasks(4).OnStop(
procedure
begin
masterBitmap.SaveToFile('c:\temp\myimage.bmp');
end).Execute(
procedure
var
value: TOmniValue;
k: Integer;
threadBitMap: TBITMAP;
begin
threadNum.value := threadNum.value + 1;
threadBitMap := TBITMAP.Create;
repeat
// ELEMENT IN QUEUE???? YES-> Paint ELEMENT
if dynamicQueue.TryDequeue(value) then
begin
k := value.AsInteger;
PaintSingleObject(elementList[k], threadBitMap);
end;
until (flag and dynamicQueue.IsEmpty);
// Merge all Bitmaps, after painting all objects
canvas.lock;
BitBlt(masterBitmap.canvas.Handle, 0, 0, masterBitmap.Width,
masterBitmap.Height, threadBitMap.canvas.Handle, 0, 0, SRCAND);
canvas.unlock;
threadBitMap.Free;
end);
end;
LOADING THE Database is done in a few seconds. Painting Process is the bottle neck!
procedure TbmpthreadForm.PaintSingleObject(DS: TObjectTableRecord;
threadBMP: TBITMAP);
var
i, j: Integer;
MyPoly: TPolygon;
aTFPolygon: TFPolygon;
OldPen, NewPen: HPen;
begin
SetPenParameters(threadBMP.canvas, DS, line_pixel, NewPen, OldPen);
...
// Convert a Polygon from string
StringToPolygon(AnsiString(DS.ObjectOutLineString), aTFPolygon);
// Convert Real Position Value to Pixel Value
... MyPoly[j] := TransformLengthToPixel(P2RWMatrix, aTFPolygon[i])
// now Select BrushSetting ...
threadBMP.Canvas.Polygon(aPoly);
end;
Paint_ObjectLabels(threadBMP.canvas, DS, aUnit);
end;
Best,
Michael
Related
I am new to parallel programming and am trying to find out why I occasionally get an EmonitorLockException:Object lock not owned when I increase the number of parrallel tasks to run. Is the case that the Threads become tangled the more tasks I run. Or is my code code not correct?
{$APPTYPE CONSOLE}
uses
System.SysUtils, System.Threading, System.Classes, System.SyncObjs, System.StrUtils;
const
WorkerCount = 10000; // this is the number of tasks to run in parallel note:when this number is increased by repeated factors of 10
// it takes longer to produce the result and sometimes the program crashes
// with an EmonitorLockException:Object lock not owned . Is it that my program is not written correctly or efficiently to run
// a large number of parallel taks and the Threads become entagled.
// Eventually I would like to optimeize the program to find the optimal number of tasks to run in parallel so as to find the result in the shortest time.
// This becomes important when the word sequence is increased to six or more letters.
sequencetofind='help'; // letter sequence to find randomly
sequencelengthplus1=5; // the ength of the letter sequence plus 1 extra letter for a check to see if it is working
var
Ticks: Cardinal;
i,k,m: Integer;
sequencenum: Integer;
alphabetarray:array[1..26] of string;
v:char;
copyarray,letters:array[1..sequencelengthplus1] of string;
tasks: array of ITask;
LTask: ITask;
Event1:TEvent;
sequencesection:TCriticalSection;
function findsequencex(index: Integer): TProc;
begin
Result := procedure
var
counter,m:integer;
r:integer;
z:string;
lettersx:array[1..sequencelengthplus1] of string;
begin
for m:=1 to sequencelengthplus1-1 do
lettersx[m]:=letters[m];
randomize;
counter:=1;
repeat
r:=random(26)+1;
z:=alphabetarray[r]; //randomly find letters until matched with the sequence
if z=letters[counter] then
begin
copyarray[counter]:=z;
counter:=counter+1; // increase counter when successfully found a match
end
else
counter:=1; // if match fails start again and look for the first letter
if (counter=sequencelengthplus1) then
begin // if all letters found in correct order find one more letter as a check
sequencesection.Acquire; //critical section start
r:=random(26)+1;
z:=alphabetarray[r];
TInterlocked.CompareExchange(sequencenum,r,0);
copyarray[sequencelengthplus1]:=z;
Event1.SetEvent; // set in motion the process to stop all other tasks
sequencesection.release; // critical section end
end;
until (Event1.WaitFor(0)=wrSignaled); // check to see if all letters of the sequence has been found
end;
end;
procedure Parallel2;
var
i,sequencevalue,j: Integer;
begin
Event1:=TEvent.Create(nil,true,false,'noname'); // sequence checker
Event1.resetevent;
sequencenum := 0;
Ticks := TThread.GetTickCount;
SetLength(Tasks, WorkerCount); // number of parallel tasks to undertake
for i := 0 to WorkerCount-1 do
Tasks[i]:=TTask.Run(findsequencex(i));
TTask.WaitForAny(Tasks); // wait for the first one to successfully finish
TThread.Synchronize(nil,
procedure
begin
for LTask in Tasks do
LTask.Cancel; // kill the remaining tasks
TInterlocked.Add (sequencevalue, sequencenum); // note the random letter check
end);
Ticks := TThread.GetTickCount - Ticks;
writeln('Parallel time ' + Ticks.ToString + ' ms, last random alphabet sequence number: ' + sequencenum.ToString+' random letter is = '+alphabetarray[sequencevalue]);
end;
begin
sequencesection:=TCriticalSection.Create;
for m:=1 to (sequencelengthplus1-1) do
begin
letters[m]:=copy(sequencetofind,m,1);
writeln(letters[m]);
end;
i:=0;
for v:='a' to 'z' do
begin
i:=i+1;
alphabetarray[i]:=v;
end;
try
begin
Parallel2; // call the parrallel procedure
writeln('finished');
for m:=1 to sequencelengthplus1 do
writeln(copyarray[m]);
if (Event1.WaitFor(0)=wrSignaled) then
begin
writeln('event signaled');
if (sequencenum=0) then writeln('sequence is null');
end;
Event1.Free;
sequencesection.free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
You've got masses of shared global variables that you access without any synchronization. For instance:
if z = letters[counter] then
begin
copyarray[counter] := z;
counter := counter + 1;
// increase counter when successfully found a match
end
Here copyarray is a global that is shared between all the tasks. This data race alone could result in the error you see. There are other similar races. And I am sure that there are many many more problems. The entire code cannot be salvaged. You need to throw it away and start again.
Here are some tips:
Pick a simpler task to begin learning about parallel programming.
Find a good book or tutorial on the subject. Start small and work up to your actual problem.
Stop using global variables. Sharing data with globals can only lead to pain. Sharing is your enemy. Keep it to a minimum.
If you need to share data do so in an explicit manner rather than using globals. And make sure the access to shared data is synchronized.
Don't call Randomize from inside your thread. It's not threadsafe. Call it once at startup.
Random is not threadsafe. Find a thread safe PRNG, or synchronise calls to Random. The former option is to be preferred.
Don't call TThread.Synchronize from the main thread.
Manage lifetime the standard way. When you create an object, use try and finally to protect its lifetime. Don't create objects in one function and destroy them in some other function.
Format your code so that it is readable. If you cannot read your code, how will you ever understand it?
With the greatest of respect, it's clear that you've not mastered serial programming yet. You should aim to be proficient at serial programming before moving to parallel programming. Parallel programming is at least an order of magnitude harder.
With that in mind, try to write a good, clean version of your program in serial form. Then think about how to transform it to a parallel version.
I want to be able to make multiple threads do work on a single TStringList. This is my current Thread code for using a single thread to do the work;
type
TFilterThread = class(TThread)
protected
procedure Execute; override;
public
lCombos : TStringList;
//Public Vars
end;
procedure TFilterThread.Execute;
var
I: integer;
HTML: String;
frm1 : TForm1;
splitLogin: TStringList;
validCount: Integer;
begin
validCount := 0;
for I := 0 to lCombos.Count - 1 do
begin
if Terminated then Exit();
Unit1.Form1.ListBox1.ItemIndex := i;
try
HTML := Unit1.Form1.IdHTTP1.Get(EmailCheckURL + lCombos[i]);
if AnsiPos('You indicated you', HTML) > 0 then
begin
//Do stuff
end;
except
Continue;
end;
end;
Showmessage('Finished!');
Unit1.Form1.Button1.Caption := 'Start';
end;
To Start the thread I use;
lComboLsit := TStringList.Create;
for I := 0 to listBox1.Items.Count -1 do
lComboLsit.Add(listBox1.Items[i]);`
iTFilterThread := TFilterThread.Create(True);
iTFilterThread.FreeOnTerminate := True;
iTFilterThread.lCombos := lComboLsit;
iTFilterThread.Start;
How would I introduce another thread to also do work on the lCombos list so that the operation would complete quicker?
The answer is that it depends. If the string list is not modified, then there's nothing to do. If the string list is modified then what is best depends critically on your specific usage.
Looking at your code, your program may not be CPU bound and so adding more threads may not help. Your program's bottleneck will the HTTP communication. However, despite not being CPU bound it is plausible that running multiple threads will reduce the impact HTTP latency. You can benchmark to find out. You don't appear to be modifying the string list so there's no race problems to be concerned with there.
However, here's a problem:
Unit1.Form1.IdHTTP1.Get(EmailCheckURL + lCombos[i]);
That will work, and is thread safe so long as TIdHTTP is thread safe. But it's pretty ugly to allow a thread to access a component on a form like that. And I don't see any real sense or need to share the TIdHTTP instance between threads. It would be far cleaner to let each thread instantiate and use their own TIdHTTP component.
Of course, you will need to decide on a policy for dividing the work between all your threads. You could have a shared index that keeps track of the next item to process. Have each thread increment it atomically each time they take an item. A parallel for loop would be a good fit here. That's available in the latest version of Delphi, or in any decent third party parallel library.
You do have some problems with your code. In the thread procedure you do this:
Unit1.Form1.ListBox1.ItemIndex := i;
....
Unit1.Form1.Button1.Caption := 'Start';
You cannot access VCL components from a thread.
And then you do this
ShowMessage('Finished!');
Don't show UI from a thread.
A point of idiom. Instead of looping over the items in your list box you can simply do this:
lComboLsit.Assign(listBox1.Items);
I have a time consuming routine which I'd like to process in parallel using Delphi XE7's new parallel library.
Here is the single threaded version:
procedure TTerritoryList.SetUpdating(const Value: boolean);
var
i, n: Integer;
begin
if (fUpdating <> Value) or not Value then
begin
fUpdating := Value;
for i := 0 to Count - 1 do
begin
Territory[i].Updating := Value; // <<<<<< Time consuming routine
if assigned(fOnCreateShapesProgress) then
fOnCreateShapesProgress(Self, 'Reconfiguring ' + Territory[i].Name, i / (Count - 1));
end;
end;
end;
There is really nothing complex going on. If the territory list variable is changed or set to false then the routine loops around all the sales territories and recreates the territory border (which is the time consuming task).
So here is my attempt to make it parallel:
procedure TTerritoryList.SetUpdating(const Value: boolean);
var
i, n: Integer;
begin
if (fUpdating <> Value) or not Value then
begin
fUpdating := Value;
n := Count;
i := 0;
TParallel.For(0, Count - 1,
procedure(Index: integer)
begin
Territory[Index].Updating := fUpdating; // <<<<<< Time consuming routine
TInterlocked.Increment(i);
TThread.Queue(TThread.CurrentThread,
procedure
begin
if assigned(fOnCreateShapesProgress) then
fOnCreateShapesProgress(nil, 'Reconfiguring ', i / n);
end);
end
);
end;
end;
I've replaced the for-loop with a parallel for-loop. The counter, 'i' is locked as it is incremented to show progress. I then wrap the OnCreateShapeProgress event in a TThread.Queue, which will be handled by the main thread. The OnCreateShapeProgress event is handled by a routine which updates the progress bar and label describing the task.
The routine works if I exclude the call to the OnCreateShapeProgress event. It crashes with an EAurgumentOutOfRange error.
So my question is simple:
Am I doing anything anything stupid?
How to do you call an event handler from within a TParallel.For loop or TTask?
The most obvious problem that I can see is that you queue to the worker thread.
Your call to TThread.Queue passes TThread.CurrentThread. That is the very thread on which you are calling TThread.Queue. I think it is safe to say that you should never pass TThread.CurrentThread to TThread.Queue.
Instead, remove that parameter. Use the one parameter overload that just accepts a thread procedure.
Otherwise I'd note that the incrementing of the progress counter i is not really handled correctly. Well, the incrementing is fine, but you then read it later and that's a race. You can report progress out of order if thread 1 increments before thread 2 but thread 2 queues progress before thread 1. Solve that by moving the counter increment code to the main thread. Simply increment it inside the queued anonymous method. Added bonus to that is you no longer need to use an atomic increment since all modifications are on the main thread.
Beyond that, this QC report seems rather similar to what you report: http://qc.embarcadero.com/wc/qcmain.aspx?d=128392
Finally, AtomicIncrement is the idiomatic way to perform lock free incrementing in the latest versions of Delphi.
I want to speed up painting a bitmap, therefore I designed a class like BITMAP THREAD CLASS. Once the individual painting of a partial image is finished I want to merge all image in the Thread.done procedure
My code goes like this
type
TbmpthreadForm = class(TForm)
.....
THreadImage: TImage;
procedure Button_threadstartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private-Deklarationen }
procedure ThreadDone(Sender: TObject);
public
{ Public-Deklarationen }
fserver, fdatabasename, ftablename: String;
global_thread_counter: Integer;
XPixel, YPixel: Integer;
Masterbitmap: TBitmap;
end;
var
bmpthreadForm: TbmpthreadForm;
implementation
{$R *.dfm}
procedure TbmpthreadForm.ThreadDone(Sender: TObject);
begin
dec(global_thread_counter);
MyStatusBar.SimpleText := 'Thread Count ->' + IntToStr(global_thread_counter);
Masterbitmap.Canvas.Lock;
with (Sender as TPaintBitmapThread) do
begin
bitblt(Masterbitmap.Canvas.handle, 0, 0, XPixel, YPixel,
bitmap.Canvas.handle, 0, 0, srcand);
THreadImage.Picture.Bitmap.Assign(Masterbitmap);
// lets see local tthread intermediate results and save it to HD
THreadImage.Picture.Bitmap.SaveToFile('c:\temp\myimage' + IntToStr(Index)
+ '.bmp');
end;
Masterbitmap.Canvas.UnLock;
if (global_thread_counter = 0) then
begin
...
end;
end;
procedure TbmpthreadForm.Button_threadstartClick(Sender: TObject);
var
.....
begin
index_max := 2000000;
threadCounter := 10;
Indexdelta := round(index_max / threadCounter);
///
///
....
Masterbitmap.Width := XPixel;
Masterbitmap.Height := YPixel;
for i := 0 to threadCounter - 1 do
begin
n := i * Indexdelta;
m := (i + 1) * Indexdelta;
// just a test sql string ....
sqlstr := 'select * from Mytable where objectindex <' + IntToStr(m) +
' and Objectindex >' + IntToStr(n);
aPaintBitmapThread := TPaintBitmapThread.Create(XPixel, YPixel, ...... , fserver, fdatabasename, ftablename,
sqlstr, i);
aPaintBitmapThread.OnTerminate := ThreadDone;
Memo1.Lines.Add('start thread->' + IntToStr(i));
inc(global_thread_counter);
end;
end;
The Thread.done design follows a previous topic here on SO ( reference question
As the resulting image/Masterbitmap looks a bit different from run to run , I guess my approach is not thread safe design for copy Thread bmp content into the masterbitmap in the VCL mainform,
I can not see any error in my code, what is wrong ????
additional question
Q1 : fbitmap inside TPaintBitmapThread is created inside the Thread.create procedure, for TAdoconnection I found the comment, it should be created inside the thread.execute. Must this also be done the the bitmap ?
Q2 : the attached image shows the expected result of an image(Bitmap) by an Thread and the actual image results (as seen by the THreadImage.Picture.Bitmap.SaveToFile command)
bitblt(Masterbitmap.Canvas.handle, 0, 0, XPixel, YPixel,
bitmap.Canvas.handle, 0, 0, srcand);
you explicitly called Masterbitmap.Canvas.Lock, however you didn't call bitmap.Canvas.Lock (so you can loose the canvas handle anytime within this call...)
Additionally, you need to consider thread safety within GDI itself: Sharing of any GDI objects between different threads should be avoided at all cost. For example if you select a bitmap into two different device contexts at the same time (but in different threads) you may run into problems within GDI itself...
Please note that older versions of delphi don't protect against sharing of cached handles (Font, Brush and Pen handles are cached within a global list. This was fixed in an XE3 service pack if I remember correctly).
In short: I'd consider to avoid TCanvas and TBitmap completely if you really need multi-threading. (It's much easier to be multi-threading safe that way)
Delphi used: 2007
Hello everyone,
I have a TListView with ViewStyle set to vsReport. When I click on a button, I launch about 50 threads. Each thread has a TListItem component. Each TListItem has a SubItem that is a timer. It starts at 250 and goes all the way down to 0. The user is able to see each timer decreasing in the TListView.
I have written the following code:
procedure TThreadWorker.DeleteTickets;
begin
ListItem.Delete;
end;
procedure TThreadWorker.UpdateTimer;
begin
ListItem.SubItems[1] := IntToStr(Timer);
end;
procedure TThreadWorker.TimerCounter;
begin
Timer := 300;
repeat
Sleep(1000);
Dec(Timer);
Synchronize(UpdateTimer);
until (Timer = 0);
Synchronize(DeleteTickets);
end;
And... it works! But here's the thing: all these synchronizations seem to unnecessarily overload the CPU. Obviously, it's a bigger problem when I launch more threads (100, 200 or 300) or when I use a weaker computer. At first, I wasn't sure it was the synchronizations; but if I deactivate them, the CPU is no more overloaded.
To be frank, it's not that much of an issue. However, I have the feeling that decrementing timers shouldn't cause any sort of CPU overload: my code is probably not right. I tried calling UpdateTimer less often, and while it softens the CPU overload, it doesn't fix it in the end. Furthermore, I'd like the user to see the timer updated each second. The timer also needs to be as precise as possible.
Thank you.
I think you have placed the cart ahead of the horse here. Having all your threads synchronize into the main thread, each with their own timer and message queue, will place a heavy burden on the system. What's more, often times you don't want to burden your threads with running a message loop.
A better approach in my view is to place a single timer in the main thread. When it ticks, have it retrieve progress from each thread or task that it needs to report on. You'll need to serialize access to that progress, but that's not expensive.
I think threads are more expensive to the CPU than you might think. From what I remember, the CPU has overhead to swap each thread in and out of the cache. With the CPU swapping out 50 different threads, I'm not surprised its overloading
One solution might be to extend the TTimer component then dynamically create 50 of those rather than 50 threads. TTimer uses the windows api instead of threads. (The code below is untested, but should at least give you the idead)
TMyTimer = class(TTimer)
begin
public
Timer: integer;
ListItem: TListItem;
end;
...
procedure ButtonClick(Sender: TObject)
begin
for i := 0 to 50 do
begin
ltimer = TMyTimer.Create;
ltimer.Timer := 300;
ltimer.ListItem := TListItem.Create;
//initialize list item here
ltimer.OnTimer := DecTimer;
end;
end;
procedure DecTimer(Sender: TObject)
begin
dec(TMytimer(Sender).Timer);
TMyTimer(Sender).ListItem.SubItem[1] := StrToInt(TMytimer(Sender).Timer)
end;
If the threads are all starting at the same time, try doing something like having one thread control up to 25 timer. i.e. For 50 timers you only have two threads. The timer event would then just loop through its 25 counters and decrement them. You'd still need to use synchronize for this.
The answer to this question might be of interest:
How expensive are threads?
Here is example using TThread.Queue and a TSimpleEvent for timing the counter instead of a Sleep().
Type
TThreadWorker = Class(TThread)
private
FTimer : Integer;
FListItem : TListItem;
procedure Execute; override;
procedure UpdateTimer;
procedure DeleteTicket;
public
constructor Create( aListItem : TListItem);
End;
constructor TThreadWorker.Create(aListItem : TListItem);
begin
Inherited Create(false);
FListItem := aListItem;
Self.FreeOnTerminate := true;
end;
procedure TThreadWorker.Execute;
var
anEvent : TSimpleEvent;
begin
anEvent := TSimpleEvent.Create(nil,true,false,'');
try
FTimer := 300;
repeat
anEvent.WaitFor(1000);
Queue(UpdateTimer);
Dec(FTimer);
until (FTimer = 0);
Self.Synchronize( DeleteTicket); // <-- Do not Queue this !
finally
anEvent.Free;
end;
end;
procedure TThreadWorker.UpdateTimer;
begin
FListItem.SubItems[1] := IntToStr(FTimer);
end;
procedure TThreadWorker.DeleteTicket;
begin
FListItem.Delete;
end;
Just a note, the DeleteTicket must be synchronized. The thread is terminated when execute is done, and anything on the queue will be left dangling.