Shrinavat
-
Content Count
60 -
Joined
-
Last visited
-
Days Won
3
Posts posted by Shrinavat
-
-
@Schokohase Thank you, it's works! I wonder if there is another solution? Without creating an extra class?
-
@Schokohase Sorry, I'm afraid I don't know what you're talking about. What method what class i shoud use? The pipeline does not have an Initialize method.
-
I have a pipeline for downloading files to a specific database.
FFileDownloader := Parallel.Pipeline .Stage(Asy_URLBuilder) .Stage(Asy_URLRetriever) .Stage(Asy_DBInserter, Parallel.TaskConfig.OnMessage(Self)) .Run; procedure Asy_URLBuilder(const input, output: IOmniBlockingCollection); var ovIN, ovOUT: TOmniValue; begin for ovIN in input do begin // ... compose url for downloading output.TryAdd(ovOUT); // url is in ovOUT end; end; procedure Asy_URLRetriever(const input, output: IOmniBlockingCollection); var ovIN, ovOUT: TOmniValue; begin for ovIN in input do begin // ... downloading output.TryAdd(ovOUT); // downloaded file is in ovOUT end; end; procedure Asy_DBInserter(const input, output: IOmniBlockingCollection; const task: IOmniTask); var ovIN: TOmniValue; DB: TxxxDatabase; begin DB := TxxxDatabase.Create(nil); DB.DatabaseName := ??? ; DB.Open; for ovIN in input do begin // ... insert downloaded file in specific database end; DB.Commit; task.Comm.Send(WM_TASK_COMPLETED); end;
I run a pipeline for various databases. I need to pass DatabaseName to the third stage of the pipeline. How can I do that?
Can I use the SetParameter method of Task controller when creating a pipeline? And if so, how?
Any help will be appreciated!
-
Here is description (on a russian website) of IDEFont - http://www.proghouse.ru/programming/143-idefont
-
-
@dummzeuch I saw these links. The libraries are very old, seems more than 15 years old and for very early versions of libpng. Unfortunately, they cannot be used for current versions of libpng.
-
I hope this is the right place to ask this... Is there a Delphi wrapper for libpng?
I would very much like to use it, but I couldn't find it anywhere. Please share if you know anything. If someone got working wrapper for libpng and wants to share it at here would be cool.
Thanks!
-
On 1/31/2019 at 1:58 PM, Primož Gabrijelčič said:`workItem.Result` is a record property. Because of that, this code:
workItem.Result.AsOwnedObject := TBitmap32.Create(256,256);
is equivalent to running:
var tmp: TOmniValue; tmp := workItem.Result; tmp.AsOwnedObject := TBitmap32.Create(256,256);
And that fails. You should change the code to:
var tmp: TOmniValue; tmp.AsOwnedObject := TBitmap32.Create(256,256); workItem.Result := tmp;
I'll see if I can change the implementation of `IOmniWorkitem` to prevent such problems.
@Primož Gabrijelčič Do you have any progress for this issue fix? There are no new commits on github. Current workaround with using extra variable is not very elegant, although it works.
-
Yes, indeed.
- 1
-
Ooops! I completely forgot about that... Thanks!
-
Here is the simplest code:
unit Unit1;
interface
uses
System.SysUtils,
System.Classes,
Vcl.Graphics,
Vcl.Imaging.jpeg,
Vcl.Controls,
Vcl.Forms,
Vcl.StdCtrls,
OtlParallel,
OtlTask;
type
TForm1 = class(TForm)
btnReadInOTL: TButton;
btnReadInGUI: TButton;
procedure btnReadInGUIClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnReadInOTLClick(Sender: TObject);
private
FMS: TMemoryStream;
FTestWorker: IOmniBackgroundWorker;
procedure Asy_Test(const workItem: IOmniWorkItem);
procedure HandleRequestDone(const Sender: IOmniBackgroundWorker; const
workItem: IOmniWorkItem);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FMS := TMemoryStream.Create;
FMS.LoadFromFile('test.jpg');
FTestWorker := Parallel.BackgroundWorker
.Execute(Asy_Test)
.OnRequestDone(HandleRequestDone);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMS.Free;
FTestWorker.CancelAll;
FTestWorker.Terminate(INFINITE);
FTestWorker := nil;
end;
procedure TForm1.Asy_Test(const workItem: IOmniWorkItem);
var
wic: TWICImage;
jpg: TJPEGImage;
bs: TBytesStream;
begin
bs := TBytesStream.Create;
try
bs.Write(FMS.Memory^, FMS.Size);
bs.Position := 0;
wic := TWICImage.Create;
// jpg := TJPEGImage.Create;
try
wic.LoadFromStream(bs);
// jpg.LoadFromStream(bs);
// jpg.SaveToFile('TJPEGImage.jpg');
finally
FreeAndNil(wic);
// FreeAndNil(jpg);
end;
finally
FreeAndNil(bs);
end;
end;
procedure TForm1.HandleRequestDone(const Sender: IOmniBackgroundWorker; const
workItem: IOmniWorkItem);
begin
if workItem.IsExceptional then
Application.MessageBox(PChar(workItem.FatalException.Message), '')
end;
procedure TForm1.btnReadInGUIClick(Sender: TObject);
var
wic: TWICImage;
bs: TBytesStream;
begin
bs := TBytesStream.Create;
try
bs.Write(FMS.Memory^, FMS.Size);
bs.Position := 0;
wic := TWICImage.Create;
try
wic.LoadFromStream(bs);
Application.MessageBox('All is OK', '');
finally
FreeAndNil(wic);
end;
finally
FreeAndNil(bs);
end;
end;
procedure TForm1.btnReadInOTLClick(Sender: TObject);
begin
FTestWorker.Schedule(FTestWorker.CreateWorkItem(0));
end;
end.When I click on the button "Read Image in GUI Thread", then everything is fine. TWICImage loads the image from the stream.
However, the same code does not work in the thread (click on the button "Read Image in OTL Thread"), I get AV "Access violation at address 0050316F in module 'Project1.exe'. Read of address 00000000".
If you use TJPEGImage instead of TWICImage, then everything works fine in both cases.
I don't get what the problem is. Can someone explain to me in simple terms what should I do in order for TWICImage to work in the thread? I want to use TWICImage because it allows you to download a wide variety of image formats, not just jpeg.
Delphi 10.2.3, Win7SP1 x64. Project full source is in attachment
-
42 minutes ago, Primož Gabrijelčič said:You should change the code to:
Thank, @Primož Gabrijelčič. That works.
And what about my question #1 (numTasks)?
-
@Anders Melander I have latest Graphics32 with fixed TBitmap32 constructor access violation
AV occurs when executing a line of code Image32.Bitmap.Assign(workItem.Result.AsObject as TBitmap32); - FBackend is nil:
This is in case when workItem.Result.Ownsobjects: = True
If I comment out workItem.Result.OwnsObject := True line in Asy_Factory procedure and uncomment workItem.Result.AsObject.Free; line in HandleRequestDone procedure, FBackend is not nil.
It's a bug. But whose? Mine, GR32 or OTL?
-
Questions from my last post are still relevant 10+ days later. Dear @Primož Gabrijelčič, please reply!
PS If this OTL subforum is not intended for questions, I am sorry for the time I have wasted. Is there another forum that I can ask specific OTL question and get an answer from the developer?
-
I carefully read the "3.9 Background worker" chapter from the "Parallel Programming with OmniThreadLibrary" book, and - hallelujah!
I was able to solve my problem with the help of Parallel.BackgroundWorker and Parallel.ParallelTask. Well, at least I think so... Again, project full source is in attachment, here is the main unit part:
unit UBackgroundWorkerImageFactory;
interface
uses
Winapi.Windows,
System.SysUtils,
System.Classes,
Vcl.Controls,
Vcl.Forms,
Vcl.StdCtrls,
GR32,
GR32_Image,
GR32_Resamplers,
OtlCommon,
OtlCollections,
OtlParallel,
OtlSync,
OtlTask;
type
TfrmBackgroundWorkerImageFactory = class(TForm)
Image32: TImage32;
memLog: TMemo;
btnStartTask1: TButton;
btnCreateImageFactory: TButton;
btnStartTask2: TButton;
btnStartTask3: TButton;
btnStartTask4: TButton;
btnStartTask5: TButton;
procedure FormDestroy(Sender: TObject);
procedure btnCreateImageFactoryClick(Sender: TObject);
procedure btnStartTask1Click(Sender: TObject);
procedure btnStartTask2Click(Sender: TObject);
procedure btnStartTask3Click(Sender: TObject);
procedure btnStartTask4Click(Sender: TObject);
procedure btnStartTask5Click(Sender: TObject);
private
FLogger: IOmniBackgroundWorker;
FBackgroundWorkerImageFactory: IOmniBackgroundWorker;
// asynchronous workers
procedure Asy_Factory(const workItem: IOmniWorkItem);
procedure HandleRequestDone(const Sender: IOmniBackgroundWorker;
const workItem: IOmniWorkItem);
end;
var
frmBackgroundWorkerImageFactory: TfrmBackgroundWorkerImageFactory;
implementation
{$R *.dfm}
procedure TfrmBackgroundWorkerImageFactory.FormDestroy(Sender: TObject);
begin
if Assigned(FBackgroundWorkerImageFactory) then begin
FBackgroundWorkerImageFactory.CancelAll;
FBackgroundWorkerImageFactory.Terminate(INFINITE);
FBackgroundWorkerImageFactory := nil;
end;
if Assigned(FLogger) then begin
FLogger.Terminate(INFINITE);
FLogger := nil;
end;
end;
procedure TfrmBackgroundWorkerImageFactory.btnCreateImageFactoryClick(Sender: TObject);
begin
FLogger := Parallel.BackgroundWorker.NumTasks(1)
.Execute(
procedure(const workItem: IOmniWorkItem)
begin
memLog.Lines.Add(workItem.Data.AsString);
end);
FBackgroundWorkerImageFactory := Parallel.BackgroundWorker
.Execute(Asy_Factory)
.OnRequestDone(HandleRequestDone);
btnCreateImageFactory.Enabled := False;
btnStartTask1.Enabled := True;
btnStartTask2.Enabled := True;
btnStartTask3.Enabled := True;
btnStartTask4.Enabled := True;
btnStartTask5.Enabled := True;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory created!'));
end;
//******************************************************************************
// ImageFactory
//******************************************************************************
procedure TfrmBackgroundWorkerImageFactory.Asy_Factory(const workItem: IOmniWorkItem);
var
Left, Top, Right, Bottom: integer;
TileSource: TFileName;
iTask: integer;
numTasks: integer;
RenderQueue: IOmniBlockingCollection;
Renderer: IOmniParallelTask;
TaskResults: array of TBitmap32;
ResultBitmap: TBitmap32;
begin
RenderQueue := TOmniBlockingCollection.Create;
numTasks := workItem.Data['LayersCount'].AsInteger + 1;
Left := workItem.Data['Left'].AsInteger;
Top := workItem.Data['Top'].AsInteger;
Right := workItem.Data['Right'].AsInteger;
Bottom := workItem.Data['Bottom'].AsInteger;
// create multiple TBitmap32, one per child task
SetLength(TaskResults, numTasks);
for iTask := Low(TaskResults) to High(TaskResults) do
TaskResults[iTask] := TBitmap32.Create(2*256, 2*256); // Large image is 2x2 tiles
// start child tasks
Renderer := Parallel.ParallelTask.NumTasks(numTasks).NoWait
.Execute(
procedure
var
workItem: TOmniValue;
x,y, bx,by: integer;
tile: TBitmap32;
begin
workItem := RenderQueue.Next;
tile := TBitmap32.Create();
try
tile.Font.Size := 24;
{ loop of drawing tiles to a large bitmap }
by := 0; // bx,by - coordinates on the bitmap where the tile is drawn (in tiles)
for y := Top to Bottom do begin
bx := 0;
for x := Left to Right do begin
tile.LoadFromFile(workItem[1].AsString); // TileSource - for test only! In reality it will be like this: tile := GetTileFromDB(x, y)
tile.RenderText(10,10, Format('x=%d, y=%d', [x,y]), 0, clTrWhite32); // for info
TaskResults[workItem[0].AsInteger].Draw(bx*256, by*256, tile); // render tile to a large bitmap (output: index of Bitmap32 in taskResults array)
inc(bx);
FLogger.Schedule(FLogger.CreateWorkItem(
Format('processed %s: x=%d, y=%d (thread=%d)', [workItem[1].AsString,x,y,GetCurrentThreadID])));
//Sleep(500); // simulate workload
end;
inc(by);
end;
finally
tile.Free;
end;
end
);
// provide input to child tasks
for iTask := 0 to numTasks-1 do begin
TileSource := workItem.Data['TileSource' + iTask.ToString];
RenderQueue.Add(TOmniValue.Create([iTask, TileSource]));
end;
// process output
Renderer.WaitFor(INFINITE);
if not workItem.CancellationToken.IsSignalled then begin
FLogger.Schedule(FLogger.CreateWorkItem(Format('Merging (thread=%d)', [GetCurrentThreadID])));
ResultBitmap := TBitmap32.Create();
ResultBitmap.Assign(TaskResults[0]); // base image only
// if layers exists
for iTask := 1 to High(TaskResults) do begin // merge all Layers over base image (with alpha channel)
BlockTransfer(
ResultBitmap,
0, 0,
ResultBitmap.ClipRect,
TaskResults[iTask],
TaskResults[iTask].ClipRect,
dmBlend);
end;
workItem.Result := ResultBitmap;
// workItem.Result.OwnsObject := True;
end;
for iTask := Low(TaskResults) to High(TaskResults) do
TaskResults[iTask].Free;
end;
procedure TfrmBackgroundWorkerImageFactory.HandleRequestDone(
const Sender: IOmniBackgroundWorker; const workItem: IOmniWorkItem);
begin
Image32.Bitmap.Assign(workItem.Result.AsObject as TBitmap32);
workItem.Result.AsObject.Free;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task completed!'));
end;
//******************************************************************************
//******************************************************************************
procedure TfrmBackgroundWorkerImageFactory.btnStartTask1Click(Sender: TObject);
var
ov: TOmniValue;
begin // create a single image in parallel
ov := TOmniValue.CreateNamed(
['Left', 0,
'Top', 0,
'Right', 1,
'Bottom', 1,
'LayersCount', 0,
'TileSource0', 'base.bmp'
]);
FBackgroundWorkerImageFactory.Schedule(FBackgroundWorkerImageFactory.CreateWorkItem(ov));
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #1 started - build one image, no merging'));
end;
procedure TfrmBackgroundWorkerImageFactory.btnStartTask2Click(Sender: TObject);
var
ov: TOmniValue;
begin // create and merge TWO images in parallel
ov := TOmniValue.CreateNamed(
['Left', 0,
'Top', 0,
'Right', 1,
'Bottom', 1,
'LayersCount', 1,
'TileSource0', 'base.bmp',
'TileSource1', 'overlay_1.bmp'
]);
FBackgroundWorkerImageFactory.Schedule(FBackgroundWorkerImageFactory.CreateWorkItem(ov));
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #2 started - build 2 images with merging'));
end;
procedure TfrmBackgroundWorkerImageFactory.btnStartTask3Click(Sender: TObject);
var
ov: TOmniValue;
begin // create and merge THREE images in parallel
ov := TOmniValue.CreateNamed(
['Left', 0,
'Top', 0,
'Right', 1,
'Bottom', 1,
'LayersCount', 2,
'TileSource0', 'base.bmp',
'TileSource1', 'overlay_1.bmp',
'TileSource2', 'overlay_2.bmp'
]);
FBackgroundWorkerImageFactory.Schedule(FBackgroundWorkerImageFactory.CreateWorkItem(ov));
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #3 started - build 3 images with merging'));
end;
procedure TfrmBackgroundWorkerImageFactory.btnStartTask4Click(Sender: TObject);
var
ov: TOmniValue;
begin // create and merge FOUR images in parallel
ov := TOmniValue.CreateNamed(
['Left', 0,
'Top', 0,
'Right', 1,
'Bottom', 1,
'LayersCount', 3,
'TileSource0', 'base.bmp',
'TileSource1', 'overlay_1.bmp',
'TileSource2', 'overlay_2.bmp',
'TileSource3', 'overlay_3.bmp'
]);
FBackgroundWorkerImageFactory.Schedule(FBackgroundWorkerImageFactory.CreateWorkItem(ov));
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #4 started - build 4 images with merging'));
end;
procedure TfrmBackgroundWorkerImageFactory.btnStartTask5Click(Sender: TObject);
var
ov: TOmniValue;
begin // create and merge FOUR images in parallel (reversed layers order of Task #4)
ov := TOmniValue.CreateNamed(
['Left', 0,
'Top', 0,
'Right', 1,
'Bottom', 1,
'LayersCount', 3,
'TileSource0', 'base.bmp',
'TileSource1', 'overlay_3.bmp',
'TileSource2', 'overlay_2.bmp',
'TileSource3', 'overlay_1.bmp'
]);
FBackgroundWorkerImageFactory.Schedule(FBackgroundWorkerImageFactory.CreateWorkItem(ov));
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #5 started - reversed Task #4'));
end;
end.Everything running like clockwork. But I have a few questions again:
1) If I change numTasks value in Renderer := Parallel.ParallelTask.NumTasks(numTasks).NoWait line to Environment.Process.Affinity.Count - 1, the application starts to work incorrectly. The code after Renderer.WaitFor(INFINITE); line is never executed and my app remains hanging in task Manager after closing. Is this my bug or OTL bug?
2) If I uncomment workItem.Result.OwnsObject := True; line in Asy_Factory procedure and comment out workItem.Result.AsObject.Free; line in HandleRequestDone procedure, I obtain the following AV:
"Access violation at address 00604CBF in module 'ImageFactory_BackgroundWorker.exe'. Read of address 00000000."
Why? After all, TOmniValue is the owner of TObject-type data! When a object-owning TOmniValue goes out of scope, the owned object is automatically destroyed. But this is not so in my case, so I would like to know why it happens. Is this OTL bug?
Dear @Primož Gabrijelčič, please could you answer these questions? Also, your opinion on my ImageFactory code is very important to me! Especially the asynchronous part of the code. Maybe is there a better/easier/rather way to do this?
-
-
-
Hello,
Is it posible add "spoiler" button in editor toolbar? Of course I can use [ spoiler ][/ spoiler ] tags but without code formatting: Spoiler testIt would be nice to be able to hide large chunks of code.
Thanks.
-
So, I decided to abandon the idea of parallel building a large image from tiles. I coded a small test application for testing my "image factory". Project full source is in attachment, here is the main unit part:
unit Unit1;
interface
uses
System.SysUtils,
System.Classes,
Vcl.Controls,
Vcl.Forms,
Vcl.StdCtrls,
GR32,
GR32_Image,
GR32_Resamplers,
OtlCommon,
OtlCollections,
OtlParallel;
type
TForm1 = class(TForm)
Image32: TImage32;
memLog: TMemo;
btnStartTask1: TButton;
btnCreateImageFactory: TButton;
btnStartTask2: TButton;
btnStartTask3: TButton;
procedure FormDestroy(Sender: TObject);
procedure btnCreateImageFactoryClick(Sender: TObject);
procedure btnStartTask1Click(Sender: TObject);
procedure btnStartTask2Click(Sender: TObject);
procedure btnStartTask3Click(Sender: TObject);
private
FResultBitmap: TBitmap32;
FLogger: IOmniBackgroundWorker;
FPipelineImageFactory: IOmniPipeline;
strict protected //asynchronous workers
procedure Asy_Renderer(const input: TOmniValue; var output: TOmniValue);
procedure Asy_Merger(const input, output: IOmniBlockingCollection);
end;
TTaskRec = record
Left, Top, Right, Bottom: integer;
TileSource: TFileName;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormDestroy(Sender: TObject);
begin
FResultBitmap.Free;
if Assigned(FPipelineImageFactory) then begin
FPipelineImageFactory.Input.CompleteAdding;
FPipelineImageFactory.WaitFor(INFINITE);
FPipelineImageFactory := nil;
end;
if Assigned(FLogger) then begin
FLogger.Terminate(INFINITE);
FLogger := nil;
end;
end;
procedure TForm1.btnCreateImageFactoryClick(Sender: TObject);
begin
FLogger := Parallel.BackgroundWorker.NumTasks(1)
.Execute(
procedure(const workItem: IOmniWorkItem)
begin
memLog.Lines.Add(workItem.Data.AsString);
end);
FPipelineImageFactory := Parallel.Pipeline
.Stage(Asy_Renderer)
.Stage(Asy_Merger)
.OnStopInvoke(
procedure
begin
Image32.Bitmap.Assign(FResultBitmap);
end)
.Run;
FResultBitmap := TBitmap32.Create(); // buffer
FResultBitmap.SetSize(2*256, 2*256);
btnCreateImageFactory.Enabled := False;
btnStartTask1.Enabled := True;
btnStartTask2.Enabled := True;
btnStartTask3.Enabled := True;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory created!'));
end;
//******************************************************************************
// ImageFactory
//******************************************************************************
procedure TForm1.Asy_Renderer(const input: TOmniValue; var output: TOmniValue);
var
x,y, bx,by: integer;
Rec: TTaskRec;
tile: TBitmap32;
LargeBitmap: TBitmap32;
begin // stage I
FLogger.Schedule(FLogger.CreateWorkItem('stage I'));
Rec := input.ToRecord<TTaskRec>;
LargeBitmap := TBitmap32.Create();
LargeBitmap.SetSize(2*256, 2*256); // Large image is 2x2 tiles
tile := TBitmap32.Create();
try
tile.Font.Size := 24;
{ loop of drawing tiles to a large bitmap }
by := 0; // bx,by - coordinates on the bitmap where the tile is drawn (in tiles)
for y := Rec.Top to Rec.Bottom do begin
bx := 0;
for x := Rec.Left to Rec.Right do begin
tile.LoadFromFile(Rec.TileSource); // for test only! In reality it will be like this: tile := GetTileFromDB(x, y)
tile.RenderText(10,10, Format('x=%d, y=%d', [x,y]), 0, clTrWhite32); // for info
LargeBitmap.Draw(bx*256, by*256, tile); // render the tile to a large image
inc(bx);
end;
inc(by);
end;
output := LargeBitmap;
output.OwnsObject := True;
//sleep(Random(2000));
finally
tile.Free;
end;
end;
procedure TForm1.Asy_Merger(const input, output: IOmniBlockingCollection);
var
LargeBitmap: TOmniValue;
begin // stage II
FLogger.Schedule(FLogger.CreateWorkItem('stage II'));
for LargeBitmap in input do begin // merge all LargeBitmaps into one (with alpha channel)
BlockTransfer(
FResultBitmap,
0, 0,
FResultBitmap.ClipRect,
TBitmap32(LargeBitmap.AsObject),
TBitmap32(LargeBitmap.AsObject).ClipRect,
dmBlend);
end;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task completed!'));
end;
//******************************************************************************
//******************************************************************************
procedure TForm1.btnStartTask1Click(Sender: TObject);
var
Rec1: TTaskRec;
begin
Rec1.Left := 0; // Large image is 2x2 tiles
Rec1.Top := 0;
Rec1.Right := 1;
Rec1.Bottom := 1;
Rec1.TileSource := 'base.bmp';
FPipelineImageFactory.NumTasks(1); // to create a single image in parallel
// Provide input
with FPipelineImageFactory.Input do begin
Add(TOmniValue.FromRecord<TTaskRec>(Rec1));
CompleteAdding;
end;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #1 started - build one image, no merging'));
end;
procedure TForm1.btnStartTask2Click(Sender: TObject);
var
Rec1, Rec2: TTaskRec;
begin
Rec1.Left := 0; // base Large image is 2x2 tiles
Rec1.Top := 0;
Rec1.Right := 1;
Rec1.Bottom := 1;
Rec1.TileSource := 'base.bmp';
Rec2.Left := 0; // overlay #1 Large image
Rec2.Top := 0;
Rec2.Right := 1;
Rec2.Bottom := 1;
Rec2.TileSource := 'overlay_1.bmp';
FPipelineImageFactory.NumTasks(2); // to create TWO images in parallel
// Provide input
with FPipelineImageFactory.Input do begin
Add(TOmniValue.FromRecord<TTaskRec>(Rec1));
Add(TOmniValue.FromRecord<TTaskRec>(Rec2));
CompleteAdding;
end;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #2 started - build 2 images with merging'));
end;
procedure TForm1.btnStartTask3Click(Sender: TObject);
var
Rec1, Rec2, Rec3: TTaskRec;
begin
Rec1.Left := 0; // base Large image is 2x2 tiles
Rec1.Top := 0;
Rec1.Right := 1;
Rec1.Bottom := 1;
Rec1.TileSource := 'base.bmp';
Rec2.Left := 0; // overlay #1 for base Large image
Rec2.Top := 0;
Rec2.Right := 1;
Rec2.Bottom := 1;
Rec2.TileSource := 'overlay_1.bmp';
Rec3.Left := 0; // overlay #2 for base Large image
Rec3.Top := 0;
Rec3.Right := 1;
Rec3.Bottom := 1;
Rec3.TileSource := 'overlay_2.bmp';
FPipelineImageFactory.NumTasks(3); // to create THREE images in parallel
// Provide input
with FPipelineImageFactory.Input do begin
Add(TOmniValue.FromRecord<TTaskRec>(Rec1));
Add(TOmniValue.FromRecord<TTaskRec>(Rec2));
Add(TOmniValue.FromRecord<TTaskRec>(Rec3));
CompleteAdding;
end;
FLogger.Schedule(FLogger.CreateWorkItem('ImageFactory task #3 started - build 3 images with merging'));
end;
end.Screenshots:
The result of task #1:
The result of task #2:
The result of task #3:I'm not sure I did it right. And now I have a bunch of questions, mostly trivial. If you can answer any, please do.
1) Why does stage II start before the creation of ImageFactory pipeline? (see log)
2) Why can't I restart any task? I get "Adding to complete collection" error.
3) How to terminate the pipeline correctly? Sometimes my app remains hanging in task Manager after closing.
4) Are LargeBitmaps created in parallel when there are several (for task #2/#3)? Despite the increase in FPipelineImageFactory.NumTasks for task #2/#3, the number of threads has not changed in the debugger. Also it is noticeable in the log - the line "stage I" appears sequentially.
5) Getting the result - Image32.Bitmap.Assign(FResultBitmap) in OnStopInvoke method - is that right way? If not, how do I get this correctly?
6) Is the overlay order always preserved? That is, for task #3 the overlay_2 over overlay_1 which on base image? with this code:
with FPipelineImageFactory.Input do begin Add(TOmniValue.FromRecord<TTaskRec>(Rec1)); Add(TOmniValue.FromRecord<TTaskRec>(Rec2)); Add(TOmniValue.FromRecord<TTaskRec>(Rec3)); CompleteAdding; end;
Thanks in advance!
-
Thank you for the helpful tips! I will experiment more with these techniques.
-
Dear Primož, please could you give me some advice on how to implement my "image factory"? With a variable number of parallel tasks and constantly working in the background. Everything is as I described above. Please!!!
-
2 hours ago, Schokohase said:How can you speed it up?
Ok, I get it. That answers my original question, but now I'm curious about my next question.
How to implement some kind of "image factory", which is constantly running in the background? It must have a variable number of parallel subtasks to create each image. In my opinion, the "pipeline" abstraction is not suitable for this, since it is a sequential conveyor.
-
2 hours ago, Schokohase said:Again, use BlockingCollection from OTL and build a pipeline
Why should I use a pipeline? And what about ForkJoin abstraction? Here is a quote from the "Parallel Programming with OmniThreadLibrary" book:
QuoteA typical fork/join usage pattern is:
• Execute multiple subtasks.
• Wait for subtasks to terminate.
• Collect subtask results.
• Use results to compute higher-level result.Isn't that for my case (to create multiple different LargeImages in parallel and then merge them into one resulting image)?
-
14 hours ago, Cristian Peța said:I think it will be no gain or even worse because LargeImage will not execute anything in parallel.
After more thinking I agree with you. I will do without multithreading when creating a single LargeImage.
But I have another question. Put my previous code in the BuildLargeBitmap function:
function BuildLargeBitmap(some parameters): TBitmap32; begin // creating a large image from tiles end;
I need to create multiple different LargeImages in parallel and then merge them into one resulting image. Schematically, as in the attached image. The number of LargeImages is not constant (!) and can be from 1 to 5. Each LargeImage is created from unrelated databases (there are no problems with competing DB connections). If the number of LargeImage is 1, then ResultImage = LargeImage1. Moreover, this operation of building LargeImages and merging them is repeated many times during the application life cycle. That is, I need to have a some "image factory" that is constantly running in the background. I do not understand how to do this using OmniThreadLibrary abstractions.
I would be very grateful if someone could help me create a sketch of the code for this task!
Saving a large project takes soooo Loooonnnnggg..
in General Help
Posted · Edited by Daniel
Attachment removed.
The latest version is in the attachment. It supports the latest version of RAD Studio.