{
   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit UBrowserListView;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, forms,
  FreeBitmap, FreeImage, FreeUtils, ComCtrls, Controls, commctrl, ImgList, ExtCtrls,
  Umyctrls, math;

type
  TBrowserType = (btDirectory,btFile,btStream);
  Timagetype = (itfile,itstream,itBitmapPointer);
  TTextOutStyle = (tosAll,tosNoDesc,tosNoName,tosNoAll);

  PThumbImage = ^TThumbImage;
  TThumbImage = record
    idx:integer;
    bitmap:TBitmap;
    imagetype:Timagetype;
    name:string;
    desc:string;
    changed:boolean;
    time:integer;
    filelistidx:integer;
  end;

  TThreadtimer = class;
  TOnAddList = procedure(Sender: TObject; PThumbImage1:PThumbImage; Fbitmap:TFreeWinBitmap) of object;

  Tmylistview = class(TListView)
  private
  protected
    function GetDragImages: TDragImageList; override;
  end;

  TBrowserThread = class(TThread)
  private
    FBitmap: TFreeWinBitmap;
    PThumbImage1:PThumbImage;
    BrowserType1:TBrowserType;
    FOnAddList:TOnAddList;
    Fthumbsize:integer;

    function isImage(s:string):boolean;
    procedure RescaleToList(filename:string;filelistidx:integer);

    procedure thd_AddList;
  protected
    procedure Execute; override;
  public
    fdirectory:string;
    ffileList:TStringList;
    fstream:TMemoryStream;
    fTransparentcolor: tcolor;
    fTransparent: boolean;
    formhandle:thandle;

    constructor CreateThread(bt:TBrowserType;thumbsize:integer);
    destructor Destroy; override;

  published
    property OnAddList: TOnAddList read FOnAddList write FOnAddList;
  end;

  TOnInsert = procedure(Sender: TObject; Item: TListItem; Fbitmap:TFreeWinBitmap) of object;
  TOnDelete = procedure(Sender: TObject; Item: TListItem) of object;

  TBrowserListView = class
  private
    BrowserThread1:TBrowserThread;
    ListView1:Tlistview;
    Fthumbsize: integer;
    ImageList1: TImageList;
    FOnInsert: TOnInsert;
    FOnDelete: TOnDelete;
    FTextOutStyle: TTextOutStyle;
    FTextNameShort: boolean;
    FTag: integer;
    FTransparentcolor: tcolor;
    FTransparent: boolean;
    FlistWndProc: TWndMethod;
    myhint: Tmyhintwindow;
    Fshowhint:boolean;
    timer2: TThreadtimer;

    procedure ListWndProc(var Message: TMessage);
    procedure timer2OnTimer(sender:tobject);
    procedure SetTextOutStyle(value:TTextOutStyle);
    procedure ListView1OnMouseMove(Sender: TObject;
          Shift: TShiftState; X, Y: Integer);
    procedure listview1OnInfoTip(Sender: TObject; Item: TListItem; var InfoTip: string);
    procedure ListView1OnCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure ListView1OnDeletion(Sender: TObject; Item: TListItem);
    procedure BrowserThread1OnAddList(Sender: TObject; PThumbImage1:PThumbImage; Fbitmap:TFreeWinBitmap);
  public
    ExImageList: TImageList;
    constructor Create(lv:Tlistview;thumbsize:integer);
    destructor Destroy; override;

    procedure Clear;
    procedure ClearThread;    
    procedure BrowserDirectory(s:string);
    procedure BrowserFile(strlist:TStringList;formhandle:thandle);
    procedure BrowserStream(s:string;stream:TMemoryStream);
    procedure BrowserStreamBlock(s:string;stream:TMemoryStream);
    procedure BrowserBitmapPointer(s:string;bitmap:TBitmap);
    procedure UpdateImageStream(idx:integer;stream:TMemoryStream);
    procedure Setthumbspace(value:integer);

  published
    property OnInsert: TOnInsert read FOnInsert write FOnInsert;
    property OnDelete: TOnDelete read FOnDelete write FOnDelete;
    property TextOutStyle: TTextOutStyle read FTextOutStyle write SetTextOutStyle;
    property TextNameShort: boolean read FTextNameShort write FTextNameShort;
    property showhint: boolean read Fshowhint write Fshowhint;
    property Transparentcolor: tcolor read FTransparentcolor write FTransparentcolor;
    property Transparent: boolean read FTransparent write FTransparent;
    property Tag: integer read FTag write FTag;
  end;

  TThreadtimer = class(TThread)
  private
    t:cardinal;
    Fontimer:tnotifyevent;
    Fenabled:boolean;
    procedure proc_ontimer;
  protected
    procedure Execute; override;
  public
    interval:integer;
    constructor CreateThread;
    destructor Destroy; override;
    procedure setenable(v:boolean);
    property ontimer: tnotifyevent read Fontimer write Fontimer;
  end;

  procedure ImageRescale(thumbsize:integer;
     var PThumbImage1:PThumbImage;var FBitmap:TFreeWinBitmap);

  procedure load_strcmplogical;
  function _comparetext(s1,s2:string): Integer;

var
  increment:integer = 0;

implementation
uses Ufunction, Uconfig;

type
  T_StrCmpLogicalW = function(psz1, psz2: PWideChar): Integer; Stdcall;
var
  _StrCmpLogicalW: T_StrCmpLogicalW;

procedure load_strcmplogical;
var
  libhandle: THandle;
begin
  try
    libhandle := LoadLibrary('shlwapi.dll');
    if libhandle>0 then
      _StrCmpLogicalW:=GetProcAddress(libhandle, 'StrCmpLogicalW');
  except
  end;
end;

function _CompareStr(Str1,Str2: string):Integer;
var Num1,Num2:Double;
    pStr1,pStr2:PChar;
    Len1,Len2:Integer;
  Function IsNumber(ch:Char):Boolean;
  begin
     Result:=ch in ['0'..'9'];
  end;
  Function GetNumber(var pch:PChar;var Len:Integer):Double;
    var FoundPeriod:Boolean;
        Count:Integer;
  begin
     FoundPeriod:=False;
     Result:=0;
     While (pch^<>#0) and
        (IsNumber(pch^) or ((not FoundPeriod) and (pch^='.'))) do
     begin
        if pch^='.' then
        begin
          FoundPeriod:=True;
          Count:=0;
        end
        else
        begin
           if FoundPeriod then
           begin
             Inc(Count);
             Result:=Result+(ord(pch^)-ord('0'))*Power(10,-Count);
           end
           else Result:=Result*10+ord(pch^)-ord('0');
        end;
        inc(Len);
        Inc(pch);
     end;
  end;
begin
  if (Str1<>'') and (Str2<>'') then
  begin
    pStr1:=@Str1[1]; pStr2:=@Str2[1];
    Result:=0;
    While not ((pStr1^=#0) or (pStr2^=#0)) do
    begin
       Len1:=0; Len2:=0;
       while (pStr1^=' ') do begin Inc(pStr1); Inc(Len1) end;
       while (pStr2^=' ') do begin Inc(pStr2); Inc(Len2) end;
       if IsNumber(pStr1^) and IsNumber(pStr2^) then
       begin
          Num1:=GetNumber(pStr1,Len1); Num2:=GetNumber(pStr2,Len2);
          if Num1<Num2 then Result:=-1
          else if Num1>Num2 then Result:=1
          else begin
             if Len1<Len2 then Result:=-1
             else if Len1>Len2 then Result:=1;
          end;
          Dec(pStr1);Dec(pStr2);
       end
       else if pStr1^<>pStr2^ then
       begin
          if pStr1^<pStr2^ then Result:=-1 else Result:=1;
       end;
       if Result<>0 then Break;
       Inc(pStr1); Inc(pStr2);
    end;
  end;
  Num1:=length(Str1); Num2:= length(Str2);
  if (Result=0) and (Num1<>Num2) then
  begin
       if Num1<Num2 then Result:=-1 else Result:=1;
  end;
end;

function _comparetext(s1,s2:string): Integer;
begin
  if @_StrCmpLogicalW<>nil then
    result:=_StrCmpLogicalW(PWideChar(WideString(s1)),PWideChar(WideString(s2)))
  else
    result:=_CompareStr(s1,s2);
end;

function Tmylistview.GetDragImages: TDragImageList;
begin
  result:=nil;
end;

{TThreadtimer}
constructor TThreadtimer.CreateThread;
begin
  FreeOnTerminate:=false;
  inherited Create(true);
end;

destructor TThreadtimer.Destroy;
begin
  inherited Destroy;
end;

procedure TThreadtimer.Execute;
begin
  t:=gettickcount;
  while self.Terminated=false do begin
    if Fenabled=false then begin
      sleep(10);
      continue;
    end;
    if gettickcount-t>=interval then begin
      Synchronize(proc_ontimer);
    end;
  end;
end;

procedure TThreadtimer.setenable(v:boolean);
begin
  t:=gettickcount;
  Fenabled:=v;  
end;

procedure TThreadtimer.proc_ontimer;
begin
  if assigned(Fontimer) then
    Fontimer(self);
end;

function filetimetostring(time:integer):string;
var
  dt: TDateTime;
  y, d, m, h, min, sec, msec: word;
  y1, d1, m1: word;
begin
  dt:=fileDateToDateTime(time);
  decodeDate( dt, y, m, d );
  decodeDate( now, y1, m1, d1 );
  if (y=y1) and (m=m1) and (d=d1) then begin
    decodeTime( dt, h, min, sec, msec);
    result:=format('%d시 %d분 %d초',[h, min, sec]);
  end else begin
    result:=format('%d년 %d월 %d일',[y,m,d]);
  end;
end;

{TBrowserListView}
constructor TBrowserListView.Create(lv:Tlistview;thumbsize:integer);
begin
  ListView1:=lv;
//  ListView1.DoubleBuffered:=true;
  ListView1.OnCustomDrawItem:=ListView1OnCustomDrawItem;
  ListView1.OnDeletion:=ListView1OnDeletion;
  ListView1.OnMouseMove:=ListView1OnMouseMove;
  listview1.OnInfoTip:=listview1OnInfoTip;
  listview1.ShowHint:=true;

  FlistWndProc := ListView1.WindowProc;
  ListView1.WindowProc := ListWndProc;
  myhint:=Tmyhintwindow.Create(lv);

  ImageList1:=TImageList.Create(nil);
  Fthumbsize:=thumbsize;
  TextOutStyle:=tosAll;
  TextNameShort:=false;
  Transparent:=false;
  TransparentColor:=clblack;
  showhint:=true;

  timer2:=TThreadtimer.CreateThread;
  timer2.setenable(false);
  timer2.Interval:=200;
  timer2.OnTimer:=timer2OnTimer;
  timer2.Resume;
end;

destructor TBrowserListView.Destroy;
begin
  ClearThread;
  Clear;
  ImageList1.Free;
  ListView1.WindowProc:=FlistWndProc;
  myhint.free;

  timer2.Terminate;
  timer2.WaitFor;
  timer2.Free;
end;

procedure TBrowserListView.SetTextOutStyle(value:TTextOutStyle);
var
  plus:integer;
begin
  FTextOutStyle:=value;
  case FTextOutStyle of
    tosAll:plus:=20;
    tosNoDesc,tosNoName:plus:=10;
    tosNoAll:plus:=0;
  end;
  ImageList1.Width:=Fthumbsize+plus;
  ImageList1.Height:=Fthumbsize+plus;
  ListView1.LargeImages:=ImageList1;
end;

procedure TBrowserListView.Setthumbspace(value:integer);
begin
  ListView_SetIconSpacing(listview1.Handle,ImageList1.Width+value,ImageList1.Height+value);
end;

procedure TBrowserListView.ListView1OnDeletion(Sender: TObject; Item: TListItem);
var
  ThumbImage:PThumbImage;
begin
  if Item.Data=nil then exit;
  if assigned(FOnDelete) then FOnDelete(Sender, Item);
  ThumbImage:=PThumbImage(Item.Data);
  if ThumbImage.bitmap<>nil then
    freeandnil(ThumbImage.bitmap);
  dispose(ThumbImage);
end;

procedure TBrowserListView.ListWndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
       WM_NOTIFY:
        case PNMHdr(Message.LParam)^.code of
          TTN_NEEDTEXTW: begin
            PToolTipTextW(Message.lparam)^.lpszText := '';
            exit;
          end;
        end;

       WM_MOUSEWHEEL:begin
         ListView1.DoubleBuffered:=false;
         myhint.DoDeActive;
       end;

       WM_LBUTTONDOWN,WM_RBUTTONDOWN,WM_KEYDOWN: begin
         ListView1.DoubleBuffered:=true;
         timer2.setenable(false);
         timer2.setenable(true);
         myhint.DoDeActive;
       end;

       CM_MOUSELEAVE,WM_KILLFOCUS,WM_VSCROLL,LVM_SCROLL:
         myhint.DoDeActive;

     end;

  FlistWndProc(Message);
end;

procedure TBrowserListView.timer2OnTimer(sender:tobject);
begin
  timer2.setenable(false);
  ListView1.DoubleBuffered:=false;
end;

procedure TBrowserListView.ListView1OnMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TBrowserListView.listview1OnInfoTip(Sender: TObject; Item: TListItem; var InfoTip: string);
var
  PThumbImage1:PThumbImage;
begin
  infotip:='';
  if config.c_enablefilehint=false then exit;
  if Fshowhint=false then exit;

  PThumbImage1:=PThumbImage(item.Data);
  if myhint.olddata=PThumbImage1 then begin
    exit;
  end;
  myhint.msglist.Clear;
  myhint.msglist.Add(format('파일이름: %s',[ExtractFileName(PThumbImage1.name)]));
  myhint.msglist.Add(compactstring(PThumbImage1.name,60));
  myhint.msglist.Add(format('크기: %s',[PThumbImage1.desc]));
  if PThumbImage1.time>0 then
    myhint.msglist.Add(format('날짜: %s',[filetimetostring(PThumbImage1.time)]));

  if PThumbImage1.changed then
    myhint.msglist.Add('수정되었음.');
  myhint.DoActivateHint(PThumbImage1,nil,0,config.c_filehintdelay);
end;

procedure TBrowserListView.ListView1OnCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
 procedure textdraw(s:string;rect:TRect);
 begin
  DrawTextEx(ListView1.Canvas.Handle,
      pchar(s),Length(s), rect,
      DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,nil);
 end;
var
  rect,rect2:TRect;
  PThumbImage1:PThumbImage;
  x,y,w,h:integer;
  th,p1:integer;
  s:string;
begin
  rect:=Item.DisplayRect(drBounds);
  windows.InflateRect(rect,-4,-4);

  if (cdsSelected in State) then begin
    ListView1.Canvas.Brush.color:=clHighlight;
    ListView1.Canvas.Font.Color:=clHighlightText;
  end else if Item.Selected then begin
    ListView1.Canvas.Brush.Color:=clbtnface;
    ListView1.Canvas.Font.Color:=cldefault;
  end else begin
    ListView1.Canvas.Brush.color:=ListView1.Color;
    ListView1.Canvas.Font.color:=cldefault;
  end;
  ListView1.Canvas.FillRect(rect);

  windows.InflateRect(rect,-2,-2);
  th:=ListView1.Canvas.TextHeight('gh');

  if Item.Data=nil then exit;
  PThumbImage1:=PThumbImage(Item.Data);
  w:= (rect.Right-rect.Left);
  x:= rect.Left + ((w-PThumbImage1.bitmap.Width) div 2);

  case FTextOutStyle of
    tosAll: h:=(rect.Bottom-rect.Top)-(th*2);
    tosNoDesc,tosNoName: h:=(rect.Bottom-rect.Top)-th;
    tosNoAll: h:=(rect.Bottom-rect.Top);
  end;

  y:= rect.Top + ((h-PThumbImage1.bitmap.Height) div 2);
  ListView1.Canvas.Draw(x,y,PThumbImage1.bitmap);

  if (ExImageList<>nil) and PThumbImage1.changed then begin
    ExImageList.Draw(ListView1.Canvas,rect.Left,rect.Top,14,dsTransparent,itImage);
  end;

  if (FTextOutStyle=tosNoAll) then exit;
  if (FTextOutStyle=tosAll) or (FTextOutStyle<>tosNoDesc) then begin
    rect2:=rect;
    rect2.Top:=rect2.Bottom-(th*2);
    textdraw(PThumbImage1.desc,rect2);
  end;

  if (FTextOutStyle=tosAll) or (FTextOutStyle<>tosNoName) then begin
    rect2:=rect;
    rect2.Top:=rect2.Bottom-th;

    if TextNameShort then begin
      s:=ExtractFileName(PThumbImage1.name);
      p1:=LastDelimiter('.',s);
      s:=copy(s,1,p1-1);
    end else
      s:=ExtractFileName(PThumbImage1.name);
    if s='' then s:='이름없음';
    textdraw(s,rect2);
  end;
end;

procedure TBrowserListView.BrowserThread1OnAddList(Sender: TObject; PThumbImage1:PThumbImage; Fbitmap:TFreeWinBitmap);
var
  listitem:TListItem;
begin
  listitem:=ListView1.Items.Add;
  listitem.Caption:='';
  listitem.Data:=PThumbImage1;
  if assigned(FOnInsert) then FOnInsert(Sender, listitem, Fbitmap);
end;

procedure TBrowserListView.ClearThread;
begin
  if BrowserThread1<>nil then begin
    BrowserThread1.Terminate;
    BrowserThread1.WaitFor;
    BrowserThread1.Free;
    BrowserThread1:=nil;
  end;
end;

procedure TBrowserListView.Clear;
begin
  ListView1.Clear;
end;

procedure TBrowserListView.BrowserDirectory(s:string);
begin
  ClearThread;
  BrowserThread1:=TBrowserThread.CreateThread(btDirectory,Fthumbsize);
  BrowserThread1.fTransparentcolor:=Transparentcolor;
  BrowserThread1.fTransparent:=Transparent;
  BrowserThread1.fdirectory:=s;
  BrowserThread1.OnAddList:=BrowserThread1OnAddList;
  BrowserThread1.Resume;
end;

procedure TBrowserListView.BrowserFile(strlist:TStringList;formhandle:thandle);
begin
  ClearThread;
  BrowserThread1:=TBrowserThread.CreateThread(btfile,Fthumbsize);
  BrowserThread1.fTransparentcolor:=Transparentcolor;
  BrowserThread1.fTransparent:=Transparent;
  BrowserThread1.ffileList:=strlist;
  BrowserThread1.OnAddList:=BrowserThread1OnAddList;
  BrowserThread1.formhandle:=formhandle;
  BrowserThread1.Resume;
end;

procedure TBrowserListView.BrowserStream(s:string;stream:TMemoryStream);
var
  BrowserThread1:TBrowserThread;
  strlist:TStringList;
begin
  strlist:=TStringList.Create;
  strlist.Add(s);
  BrowserThread1:=TBrowserThread.CreateThread(btStream,Fthumbsize);
  BrowserThread1.fTransparentcolor:=Transparentcolor;
  BrowserThread1.fTransparent:=Transparent;
  BrowserThread1.fstream:=stream;
  BrowserThread1.ffileList:=strlist;
  BrowserThread1.OnAddList:=BrowserThread1OnAddList;
  BrowserThread1.Resume;
end;

procedure TBrowserListView.BrowserStreamBlock(s:string;stream:TMemoryStream);
var
  PThumbImage1:PThumbImage;
  FBitmap:TFreeWinBitmap;
  FreeMemoryIO1:TFreeMemoryIO;
begin
  New(PThumbImage1);
  inc(increment);
  PThumbImage1.idx:=increment;
  PThumbImage1.bitmap:=Tbitmap.Create;

  FBitmap:=TFreeWinBitmap.Create;
  FreeMemoryIO1:=TFreeMemoryIO.Create(stream.Memory,stream.Size);
  try
    FBitmap.LoadFromMemory(FreeMemoryIO1);
    ImageRescale(Fthumbsize,PThumbImage1,FBitmap);
  finally
    FreeMemoryIO1.Free;
    FBitmap.Free;
  end;

  PThumbImage1.imagetype:=itstream;
  PThumbImage1.name:=s;
  PThumbImage1.time:=DateTimeToFileDate(now);
  BrowserThread1OnAddList(self, PThumbImage1, nil);
end;

procedure TBrowserListView.BrowserBitmapPointer(s:string;bitmap:TBitmap);
var
  PThumbImage1:PThumbImage;
  FBitmap:TFreeWinBitmap;
  FreeMemoryIO1:TFreeMemoryIO;
  stream:tmemorystream;
begin
  bitmap.PixelFormat:=pf24Bit;

  New(PThumbImage1);
  inc(increment);
  PThumbImage1.idx:=increment;
  PThumbImage1.bitmap:=bitmap;
  PThumbImage1.imagetype:=itBitmapPointer;
  PThumbImage1.name:=s;
  PThumbImage1.desc:='';
  PThumbImage1.time:=DateTimeToFileDate(now);
  try
    BrowserThread1OnAddList(self, PThumbImage1, nil);
  finally
    PThumbImage1.bitmap:=Tbitmap.Create;
  end;

  FBitmap:=TFreeWinBitmap.Create;
  stream:=tmemorystream.Create;
  bitmap.SaveToStream(stream);
  FreeMemoryIO1:=TFreeMemoryIO.Create(stream.Memory,stream.Size);
  try
    FBitmap.LoadFromMemory(FreeMemoryIO1);
    ImageRescale(Fthumbsize,PThumbImage1,FBitmap);
  finally
    FreeMemoryIO1.Free;
    FBitmap.Free;
    stream.Free;
  end;
end;

procedure TBrowserListView.UpdateImageStream(idx:integer;stream:TMemoryStream);
var
  PThumbImage1:PThumbImage;
  FBitmap: TFreeWinBitmap;
  FreeMemoryIO1: TFreeMemoryIO;
begin
PThumbImage1:=PThumbImage(ListView1.Items[idx].Data);
if PThumbImage1.imagetype<>itstream then exit;

FBitmap:=TFreeWinBitmap.Create;
FreeMemoryIO1:=TFreeMemoryIO.Create(stream.Memory,stream.Size);
try
  FBitmap.LoadFromMemory(FreeMemoryIO1);
  ImageRescale(Fthumbsize,PThumbImage1,FBitmap);
  ListView1.Invalidate;
finally
  FreeMemoryIO1.Free;
  FBitmap.Free;
end;
end;

{TRescaleThread}
constructor TBrowserThread.CreateThread(bt:TBrowserType;thumbsize:integer);
begin
  BrowserType1:=bt;
  Fthumbsize:=thumbsize;
  FreeOnTerminate:=false;
  inherited Create(true);
end;

destructor TBrowserThread.Destroy;
begin
  inherited Destroy;
end;

function TBrowserThread.isImage(s:string):boolean;
begin
  result:=false;
  if FIU_GetFIFType(s) > FIF_UNKNOWN then result:=true;
end;

procedure TBrowserThread.Execute;
var
  SR: TSearchRec;
  i:integer;
  total,current:integer;
begin
FBitmap := TFreeWinBitmap.Create;
try
  case BrowserType1 of
    btDirectory:begin
      if fdirectory='' then exit;
      if fdirectory[length(fdirectory)]<>'\' then fdirectory:=fdirectory+'\';
      if FindFirst(fdirectory+'*.*',faAnyFile,SR) = 0 then begin
        total:=0;
        repeat
         if self.Terminated then break;
         if SR.Attr <> faDirectory then
           inc(total);
        until FindNext(SR) <> 0;
      end;
      if FindFirst(fdirectory+'*.*',faAnyFile,SR) = 0 then begin
        current:=0;
        repeat
         if self.Terminated then break;
         if SR.Attr <> faDirectory then
           if isImage(fdirectory + SR.Name) then begin
             RescaleToList(fdirectory + SR.Name,-1);
             inc(current);
             sendmessage(formhandle, wm_user+10001, total, current);
             sendmessage(formhandle, wm_user+10002, integer(pchar(SR.Name)), 0);
           end;
        until FindNext(SR) <> 0;
      end;
    end;

    btFile:begin
      total:=ffileList.Count;
      for i:=0 to ffileList.Count-1 do begin
        if self.Terminated then break;
        if isImage(ffileList.Strings[i]) then begin
          RescaleToList(ffileList.Strings[i],i);
          sendmessage(formhandle, wm_user+10001, total, i+1);
          sendmessage(formhandle, wm_user+10002, integer(pchar(ExtractFileName(ffileList.Strings[i]))), 0);
        end;
      end;
    end;

    btStream: begin
      if ffileList.Count<>1 then exit;
      RescaleToList(ffileList.Strings[0],0);
      total:=1;
      current:=1;
      sendmessage(formhandle, wm_user+10001, total, current);
      sendmessage(formhandle, wm_user+10002, integer(pchar(ExtractFileName(ffileList.Strings[0]))), 0);
    end;
  end;
finally
  FBitmap.Free;
  if ffileList<>nil then ffileList.Free;
  if fstream<>nil then fstream.Free;
  sendmessage(formhandle, wm_user+10000, 0,0);
end;
end;

procedure ImageRescale(thumbsize:integer;
   var PThumbImage1:PThumbImage;var FBitmap:TFreeWinBitmap);
var
  NewWidth,NewHeight: Integer;
  w,h:integer;
  FBitmap2:TFreeWinBitmap;
  ratio:single;
begin
  w:=FBitmap.GetWidth;
  h:=FBitmap.GetHeight;
  PThumbImage1.desc:=format('(%d x %d)',[w,h]);

  if w > h then begin
    NewWidth:=thumbsize;
    NewHeight:=Round((thumbsize) * h / w);
    ratio:=NewWidth / w;
  end else begin
    NewWidth:=Round((thumbsize) * w / h);
    NewHeight:=thumbsize;
    ratio:=NewHeight / h;
  end;
  if NewWidth > w then NewWidth:=w;
  if NewHeight > h then NewHeight:=h;
  if NewWidth<=0 then NewWidth:=1;
  if NewHeight<=0 then NewHeight:=1;

  FBitmap2:=TFreeWinBitmap.Create();
  try
    if FBitmap.IsTransparent then
      FBitmap.SetTransparentBg(nil);

    if ratio<0.01 then
      FBitmap.MakeThumbnail2(thumbsize, FBitmap2)
//      FBitmap.Rescale(NewWidth,NewHeight,sfBilinear,FBitmap2)
    else
      FBitmap.MakeThumbnail(NewWidth,NewHeight,FBitmap2,false,thumbsize);
    FBitmap2.ConvertTo24Bits;

    with PThumbImage1.bitmap do begin
      PixelFormat := pf24Bit;
      Width := NewWidth;
      Height := NewHeight;
      Canvas.Lock;
      FBitmap2.Draw(Canvas.Handle, rect(0,0,NewWidth,NewHeight));
      Canvas.Unlock;
    end;
  finally
    FBitmap2.Free;
  end;
end;

procedure TBrowserThread.RescaleToList(filename:string;filelistidx:integer);
var
  FreeMemoryIO1:TFreeMemoryIO;
begin
if self.Terminated then exit;
New(PThumbImage1);
inc(increment);
PThumbImage1.idx:=increment;
PThumbImage1.filelistidx:=filelistidx;
PThumbImage1.bitmap:=TBitmap.Create;
try
  case BrowserType1 of
    btDirectory,btFile:begin
      FBitmap.Load(filename);
      if FBitmap.IsTransparent then
        FBitmap.SetTransparentBg(nil);
      PThumbImage1.imagetype:=itfile;
    end;
    btStream: begin
      FreeMemoryIO1:=TFreeMemoryIO.Create(fstream.Memory,fstream.Size);
      try
        FBitmap.LoadFromMemory(FreeMemoryIO1);
      finally
        FreeMemoryIO1.Free;
      end;
      PThumbImage1.imagetype:=itstream;
    end;
  end;

  ImageRescale(Fthumbsize,PThumbImage1,FBitmap);
  if fTransparent then begin
    PThumbImage1.bitmap.TransparentColor:=FTransparentcolor;
    PThumbImage1.bitmap.Transparent:=fTransparent;
  end;

  PThumbImage1.name:=filename;
  PThumbImage1.time:=FileAge(PThumbImage1.name);

  Synchronize(thd_AddList);
except
  PThumbImage1.bitmap.Free;
  dispose(PThumbImage1);
end;
end;

procedure TBrowserThread.thd_AddList;
begin
  if assigned(FOnAddList) then
    FOnAddList(self, PThumbImage1, Fbitmap);
end;

end.
