how get results back from a low level task?

[jus 0]

Hi,

  i'm using Delphi 2007 and I want to put some graphics stuff into background tasks. The result of that function is a TBitmap. On higher Delphi versions there is seems a Async method with OnTerminate. But how can I retrieve the TBitmap result from a lowlevel task after finishing in the main thread?

 

Thank you in advance!

 

jus

Edited November 20, 2019 by jus

[jus 0]

ok, maybe it would be clearer with code. 

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
  private
    procedure ListFileDir(Path: string; FileList: TStrings);
  public
    { Public-Deklarationen }
  end;

const
  PrintPreviewPixelSize = 100;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses jpeg;

procedure CreateThumbnailFromFile(const FileName: String; var OutBmp: TBitmap);
var
  Picture: TPicture;
  InBmp: TBitmap;
begin
  OutBmp.Assign(nil);
  Picture := TPicture.Create;
  try
    Picture.LoadFromFile(FileName);
    InBmp:=Tbitmap.Create;
    try
      InBmp.Width := Picture.Width;
      InBmp.Height := Picture.Height;
      InBmp.Canvas.Draw(0, 0, Picture.Graphic);

      OutBmp.Width  := PrintPreviewPixelSize;
      OutBmp.Height := PrintPreviewPixelSize;

      SetStretchBltMode(OutBmp.Canvas.Handle, HALFTONE);
      StretchBlt(OutBmp.Canvas.Handle, 0, 0, PrintPreviewPixelSize, PrintPreviewPixelSize,
                 InBmp.Canvas.Handle , 0, 0, InBmp.Width         , InBmp.Height         , SRCCOPY);
    finally
      InBmp.Free;
    end;
  finally
    Picture.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  ListItem: TListItem;
  FileList: TStringList;
  BmpOut: TBitmap;
begin
  ImageList1.Height := PrintPreviewPixelSize;
  ImageList1.Width := PrintPreviewPixelSize;

  FileList := TStringList.Create;
  try
    ListFileDir('d:\a\2010.10\', FileList);
    BmpOut := TBitmap.Create;
    try
      for I := 0 to Pred(FileList.Count) do
      begin
        CreateThumbnailFromFile(FileList.Strings[i], BmpOut);
        ImageList1.Add(BmpOut, nil);
      end;
    finally
      BmpOut.Free;
    end;
  finally
    FileList.Free;
  end;

  ListView1.LargeImages := ImageList1;
  for I := 0 to ImageList1.Count - 1 do
    begin
      ListItem := ListView1.Items.Add;
      Listitem.Caption := 'Image' + IntToStr(I);
      ListItem.ImageIndex := I;
    end;
end;

procedure TForm1.ListFileDir(Path: string; FileList: TStrings);
var
  SR: TSearchRec;
begin
  if FindFirst(Path + '*.jpg', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        FileList.Add(Path+SR.Name);
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

end.

 

Currently I have a method called "CreateThumbnailFromFile" (see above) which convert a jpeg file into a bitmap for adding to an TImageList. In my original method it does a little bit more, but it doesn't matter. My intention is to put the CreateThumbnailFromFile method to a background task something like

 for I := 0 to Pred(FileList.Count) do
 begin
   CreateTask(CreateThumbnailFromFile(FileList.Strings[i], BmpOut));
 end;

and in the OnTerminate I can add the BmpOut (TBitmap) to the TImageList. The thing I don't know is how can I retrieve the BmpOut (TBitmap) in an OnTerminate method in OmniThreadLibrary?

 

Could anyone can give me a hint?

 

 

ListViewMini.zip

Edited November 20, 2019 by jus

[Guest]

25 minutes ago, jus said:

Could anyone can give me a hint?

Not my code but i am sure it will help you, go to this link and download that attached file in this post:

https://www.sql.ru/forum/1259828/chernye-kvadraty-vmesto-fotok-v-listview-gdi?mid=20475538#20475538

 

Good luck.

 

[Lars Fosdal 1793]

My preferred way of dealing with sub-tasks is to provide a "mailbox" i.e. some sort of container, like a queue, array or list, for them to insert their results in. 

The main thread can either poll the mailbox periodically, or you could use a message or signal to initiate the polling whenever the container has content added.

[Fr0sT.Brutal 900]

PostMessage from bg thread to main form with LParam=your-generated-bitmap

[Guest]

It worth to suggest another way when you deal with GUI, like this case background thread will do the heavy lefting while the UI will update accordingly, so to try to make the GUI most smooth, do this:

Thread works on images like you example then it will enter protected section with TCriticalSection, there will push it in a list and get out, that is it for the thread.

GUI ( your form here) will use timer that you can adjust and tweak as you see fit will enter the same CriticalSection and remove the images from that list and get out of that section, here don't draw anything from inside just extract the images, here you call call invalidate ,redraw or whatever you want.

with this logic you can set the timer to 50ms so you will have ability to update the UI 20 times per second, this will give you the ability to adjust how many times you want to update the UI with locking it when the thread is generating too many images per second.

[jus 0]

ok, thank you for your help. Finally I decided to use the sending object concept from the \OmniThreadLibrary\tests\23_BackgroundFileSearch. It seems to work in my Delphi 2007. Here is my implementation for the case if someone has a similiar topic:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, OtlCommon, OtlTask, OtlTaskControl,
  OtlEventMonitor, OtlComm, OtlThreadPool;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    OmniEventMonitor1: TOmniEventMonitor;
    procedure FormCreate(Sender: TObject);
    procedure OmniEventMonitor1TaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
  private
    fStarttime: DWORD;
    FilesCount: Integer;
    FMessageDispatch: TOmniEventMonitor;
    procedure HandleTaskTerminated(const task: IOmniTaskControl);
    procedure ListFileDir(Path: string; FileList: TStrings);
  public
    { Public-Deklarationen }
  end;

const
  PrintPreviewPixelSize = 100;
  MSG_THUMB_CREATED  = 1;

var
  Form1: TForm1;

procedure CreateThumbnailFromFileOTL(const task: IOmniTask);
procedure DoCreateThumbnailFromFileOTL(const task: IOmniTask; const FileName: String);

implementation

{$R *.dfm}

uses Jpeg;

type
  TCustomMessageObject = class
    BmpFile: TMemoryStream;
    FileName: String;
  public
    constructor Create;
    destructor Destroy; override;
  end;

procedure CreateThumbnailFromFileOTL(const task: IOmniTask);
var
  FileName: String;
begin
  FileName := task.Param['FileName'];
  DoCreateThumbnailFromFileOTL(task, FileName);
end;

procedure DoCreateThumbnailFromFileOTL(const task: IOmniTask; const FileName: String);
var
  InBmp: TBitmap;
  OutBmp: TBitmap;
  CustomMessageObject: TCustomMessageObject;
  Picture: TPicture;
begin
  CustomMessageObject := TCustomMessageObject.Create;
  InBmp:=TBitmap.Create;
  OutBmp := TBitmap.Create;
  Picture := TPicture.Create;
  try
    InBmp.Canvas.Lock;
    OutBMP.Canvas.Lock;
    CustomMessageObject.FileName := FileName;
    Picture.LoadFromFile(FileName);
    InBmp.Width := Picture.Width;
    InBmp.Height := Picture.Height;
    InBmp.Canvas.Draw(0, 0, Picture.Graphic);
    InBmp.PixelFormat:=pf24bit;
    OutBMP.PixelFormat:=pf24bit;
    OutBmp.Width  := PrintPreviewPixelSize;
    OutBmp.Height := PrintPreviewPixelSize;
    SetStretchBltMode(OutBMP.Canvas.Handle, HALFTONE);
    StretchBlt(OutBmp.Canvas.Handle, 0, 0, PrintPreviewPixelSize, PrintPreviewPixelSize,
               InBmp.Canvas.Handle , 0, 0, InBmp.Width         , InBmp.Height         , SRCCOPY);
    OutBmp.SaveToStream(CustomMessageObject.BmpFile);
  finally
    Picture.Free;
    InBmp.Canvas.UnLock;
    OutBmp.Canvas.UnLock;
    InBmp.Free;
    OutBmp.Free;
  end;
  task.Comm.Send(MSG_THUMB_CREATED, CustomMessageObject);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  ListItem: TListItem;
  FileList: TStringList;
  FScanTask: IOmniTaskControl;
begin
  FStarttime:=gettickcount;
  ImageList1.Height := PrintPreviewPixelSize;
  ImageList1.Width := PrintPreviewPixelSize;
  ListView1.LargeImages := ImageList1;
  FileList := TStringList.Create;
  try
    ListFileDir('d:\a\2010.10\70\', FileList);
    FilesCount := FileList.Count;
    for I := 0 to Pred(FileList.Count) do
    begin
      FScanTask := CreateTask(CreateThumbnailFromFileOTL, 'CreateThumbnailFromFileOTL')
        .MonitorWith(OmniEventMonitor1)
        .SetParameter('FileName', FileList.Strings[i])
        .Schedule;
    end;
  finally
    FileList.Free;
  end;
end;

procedure TForm1.HandleTaskTerminated(const task: IOmniTaskControl);
begin

end;

procedure TForm1.ListFileDir(Path: string; FileList: TStrings);
var
  SR: TSearchRec;
begin
  if FindFirst(Path + '*.jpg', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        FileList.Add(Path + SR.Name);
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

procedure TForm1.OmniEventMonitor1TaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
var
  CustomMessageObject : TCustomMessageObject;
  ResultBMP: TBitmap;
  ListItem: TListItem;
  ItmIndex: Integer;
begin
  if msg.MsgID =  MSG_THUMB_CREATED then
  begin
    CustomMessageObject := TCustomMessageObject(msg.MsgData.AsObject);
    ResultBMP := TBitmap.Create;
    try
      CustomMessageObject.BmpFile.Position := 0;
      ResultBMP.LoadFromStream(CustomMessageObject.BmpFile);
      ImageList1.Add(ResultBmp, nil);
      ListItem := ListView1.Items.Add;
      ListItem.ImageIndex := ImageList1.Count-1;
    finally
      ResultBMP.Free;
      CustomMessageObject.Free;
    end;
    Caption := IntToStr(ImageList1.Count)+' / ' + IntToStr(FilesCount);
    if ImageList1.Count = FilesCount then
    begin
      Caption := IntToStr(ImageList1.Count)+' / ' + IntToStr(FilesCount) + ' total time '+ IntToStr(Gettickcount - fStartTime)+' ms';
    end;
  end;
end;


{ TCustomMessageObject }

constructor TCustomMessageObject.Create;
begin
  inherited;
  BmpFile := TMemoryStream.Create;
end;

destructor TCustomMessageObject.Destroy;
begin
  BmpFile.Free;
  inherited;
end;

end.

There is one thing I didn't solved. If I close the App during creating the thumbnails there would be some access violations. How would you extend the program to terminate the tasks and delete the threadpool queue?

 

jus

ListViewMiniThread.zip

Edited November 21, 2019 by jus

[Rollo62 539]

Nice, thanks for sharing.

I see another thing, but maybe I had too fast overlooked the code ( TL;DR; ).

 

I would assume that the files are not listed in the normal, sorted order, as they seems to pop-up at any time.
So if the original order of the FileList is important, maybe you need to add a position indicator in the message ?