jus

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

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

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