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
![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
