一个功能增强的Delphi TListView组件——TSmartListView

unit  SmartListView ;
{* |<PRE>
================================================================================
* 单元名称：TSmartListView v1.01
* 单元作者：HsuChong@hotmail.com
* 备    注：
* 开发平台：PWin2003Standard + Delphi 7.1
* 修改记录：2006.9.12.
*             
================================================================================
|</PRE>}

interface

uses
   Windows ,  Messages ,  SysUtils ,  Classes ,  ComCtrls ,  CommCtrl ,  Graphics ;

type
   TSmartListView  =  class ( TListView )
   private
     FArrowUp :  HBITMAP ;
     FArrowDown :  HBITMAP ;
     FCurColumn :  Integer ;
     FHeaderHandle :  HWND ;
     FMsg1 :  string ;
     FMsg2 :  string ;
     FCop :  string ;
     FBackgroundPicture :  TPicture ;
     FSearchStr :  string ;
     FSearchTickCount :  Double ;
     FColumnSearch :  boolean ;
     function  GetCop :  string ;
     procedure  SetCop ( const  Value :  string );
     procedure  SetHeaderBitmap ( Value :  Integer );
     procedure  SetBackgroundPicture ( Value :  TPicture );
     procedure  BackgroundPictureChanged ( Sender :  TObject );
     procedure  LVCustomDraw ( Sender :  TCustomListView ;  const  ARect :  TRect ;  var  DefaultDraw :  Boolean );
     procedure  DrawBackgroundPicture ;
   protected
     procedure  WndProc ( var  Msg :  TMessage );  override ;
     procedure  KeyUp ( var  Key :  Word ;  Shift :  TShiftState );  override ;
   public
     constructor  Create ( AOwner :  TComponent );  override ;
     procedure  CreateWnd ;  override ;
     destructor  Destroy ;  override ;
     procedure  SaveToFile ( const  FileName :  string );
     procedure  LoadFromFile ( const  FileName :  string );
     function  SaveToHTMLFile ( const  FileName :  string ;  Center :  Boolean ):  Boolean ;
     function  SaveToExcelFile ( const  FileName :  string ):  Boolean ;
     function  GetCheckedItem :  TListItem ;
     function  MultiChecked :  Boolean ;
     function  IsChecked :  Boolean ;
     procedure  CheckAll ( Checked :  Boolean );
     procedure  MoveItem ( OriginalIndex ,  NewIndex :  Integer );
     function  StringSelect ( const  FindStr :  string ;  ColumnIndex :  Integer ):  boolean ;
     function  SubStringSelect ( const  FindStr :  string ;  ColumnIndex :  Integer ):  boolean ;
   published
     property  Msg1 :  string  read  FMsg1  write  FMsg1 ;
     property  Msg2 :  string  read  FMsg2  write  FMsg2 ;
     property  BackgroundPicture :  TPicture  read  FBackgroundPicture  write  SetBackgroundPicture ;
     property  ColumnSearch :  boolean  read  FColumnSearch  write  FColumnSearch  default  False ;
     property  Copyright :  string  read  GetCop  write  SetCop ;
   end ;

procedure  Register ;

implementation

{$R SmartListView.res}

procedure  Register ;
begin
   RegisterComponents ( 'FHTGPS' ,  [ TSmartListView ]);
end ;

//general Sort function

function  CustomSortProc ( Item1 ,  Item2 :  TListItem ;  lParam :  LongInt ):  Integer ;  stdcall ;
begin
   Result  :=  0 ;
   if  ( Item1  =  nil )  or  ( Item2  =  nil )  then
     Exit ;
   if  lParam  =  0  then
     Result  :=  CompareText ( Item1 . Caption ,  Item2 . Caption )
   else  if  lparam  >  0  then
   begin
     if  ( LParam  >  Item1 . SubItems . Count )  or  ( LParam  >  Item2 . SubItems . Count )  then
       Exit ;
     Result  :=  CompareText ( Item1 . SubItems [ Lparam  -  1 ],  Item2 . SubItems [ Lparam  -  1 ]);
   end ;
   Result  :=  Result  *  Item1 . ListView . Column [ lParam ]. Tag ;
end ;

constructor  TSmartListView . Create ( AOwner :  TComponent );
begin
   inherited  Create ( AOwner );
   FBackgroundPicture  :=  TPicture . Create ;
   FBackgroundPicture . OnChange  :=  BackgroundPictureChanged ;
   OnCustomDraw  :=  LVCustomDraw ;
   FArrowUp  :=  LoadImage ( hInstance ,  'ArrowUp' ,  IMAGE_BITMAP ,  0 ,  0 ,  LR_LOADMAP3DCOLORS );
   FArrowDown  :=  LoadImage ( hInstance ,  'ArrowDown' ,  IMAGE_BITMAP ,  0 ,  0 ,  LR_LOADMAP3DCOLORS );
   Msg1  :=  'File "%s" does not exist!' ;
   Msg2  :=  '"%s" is not a ListView file!' ;
   FCop  :=  'Copyright(C) 2006 by HsuChong@hotmail.com ' ;
   FHeaderHandle  :=  0 ;
   FSearchStr  :=  '' ;
   FSearchTickCount  :=  0 ;
   FCurColumn  :=  0 ;
end ;

procedure  TSmartListView . CreateWnd ;
begin
   inherited  CreateWnd ;
   if  HandleAllocated  then
     HandleNeeded ;
   FHeaderHandle  :=  ListView_GetHeader ( Handle );
end ;

destructor  TSmartListView . Destroy ;
begin
   DeleteObject ( FArrowUp );
   DeleteObject ( FArrowDown );
   FBackgroundPicture . Free ;
   inherited  Destroy ;
end ;

procedure  TSmartListView . SetHeaderBitmap ( Value :  Integer );
var
   HdItem :  THdItem ;
begin
   FillChar ( HdItem ,  SizeOf ( HdItem ),  #0 );

   HdItem . Mask  :=  HDI_FORMAT ;
   Header_GetItem ( FHeaderHandle ,  Value ,  HdItem );
   HdItem . Mask  :=  HDI_BITMAP  or  HDI_FORMAT ;

   if  Column [ Value ]. Tag  =  - 1  then
   begin                                  //reverse arrow 反向
     HdItem . fmt  :=  HdItem . fmt  or  HDF_BITMAP  or  HDF_BITMAP_ON_RIGHT ;
     HdItem . hbm  :=  FArrowDown ;
   end
   else  if  Column [ Value ]. Tag  =  1  then
   begin                                  //obverse arrow 正向
     HdItem . fmt  :=  HdItem . fmt  or  HDF_BITMAP  or  HDF_BITMAP_ON_RIGHT ;
     HdItem . hbm  :=  FArrowUp ;
   end
   else  if  Column [ Value ]. Tag  =  0  then
   begin                                  // clear arrow 消除箭头
     HdItem . fmt  :=  HdItem . fmt  and  not  ( HDF_BITMAP  or  HDF_BITMAP_ON_RIGHT );
     HdItem . hbm  :=  0 ;
   end ;
   Header_SetItem ( FHeaderHandle ,  Value ,  HdItem );
end ;

procedure  TSmartListView . WndProc ( var  Msg :  TMessage );
var
   pHD :  PHDNotify ;
   I :  Integer ;
begin
   inherited  WndProc ( Msg );
   //如果截获的消息是WM_NOTIFY
   if  Msg . Msg  =  WM_NOTIFY  then
   begin
     pHD  :=  PHDNotify ( Msg . LParam );
     if  ( pHD . Hdr . hwndFrom  =  FHeaderHandle )  and  ( FHeaderHandle  <>  0 )  then
     begin
       case  pHD . HDr . code  of
         // 如果是点击Header
         HDN_ITEMCLICK ,  HDN_ITEMCLICKW :
           begin
             FCurColumn  :=  Columns . Items [ pHD . item ]. Index ;
             // 做标记，正向或反向排序
             for  I  :=  0  to  Columns . Count  -  1  do
             begin
               if  I  =  FCurColumn  then
               begin
                 if  Column [ I ]. Tag  =  0  then
                   Column [ I ]. Tag  :=  1
                 else
                   Column [ I ]. Tag  :=  - 1  *  Column [ I ]. Tag ;
                 SetHeaderBitmap ( I );
               end
               else
               begin
                 if  Column [ I ]. Tag  <>  0  then
                 begin
                   Column [ I ]. Tag  :=  0 ;
                   SetHeaderBitmap ( I );
                 end ;
               end ;
             end ;                         {of for}
             //排序
             CustomSort (@ CustomSortProc ,  FCurColumn );
           end ;
         // 拖动改变宽度时，ColumnItem <> 原来排序的列
         HDN_ENDTRACK ,  HDN_ENDTRACKW :
           begin
             FCurColumn  :=  Columns . Items [ pHD . item ]. Index ;
             if  Columns [ FCurColumn ]. Tag  <>  0  then
               SetHeaderBitmap ( FCurColumn );
           end ;
       end ;
     end ;
   end ;                                   // end if
end ;

procedure  TSmartListView . SaveToFile ( const  FileName :  string );
var
   idxItem ,  idxSub ,  IdxImage :  Integer ;
   Stream :  TFileStream ;
   pText :  pChar ;
   sText :  string ;
   W ,  ItemCount ,  SubCount :  word ;
   MySignature :  array [ 0..2 ]  of  char ;
begin
   //Initialization
   ItemCount  :=  0 ;
   SubCount  :=  0 ;
   //****
   MySignature  :=  'LVF' ;                  //  ListViewFile
   Stream  :=  TFileStream . Create ( FileName ,  fmCreate  or  fmOpenWrite );
   try
     Stream . Write ( MySignature ,  sizeof ( MySignature ));
     if  Items . Count  =  0  then
       ItemCount  :=  0
     else
       ItemCount  :=  Items . Count ;
     Stream . Write ( ItemCount ,  Sizeof ( ItemCount ));

     if  Items . Count  >  0  then
     begin
       for  idxItem  :=  1  to  ItemCount  do
       begin
         with  items [ idxItem  -  1 ]  do
         begin
           //Save subitems count
           if  SubItems . Count  =  0  then
             SubCount  :=  0
           else
             SubCount  :=  Subitems . Count ;
           Stream . Write ( SubCount ,  Sizeof ( SubCount ));
           //Save ImageIndex
           IdxImage  :=  ImageIndex ;
           Stream . Write ( IdxImage ,  Sizeof ( IdxImage ));
           //Save Caption
           sText  :=  Caption ;
           w  :=  length ( sText );
           pText  :=  StrAlloc ( Length ( sText )  +  1 );
           StrPLCopy ( pText ,  sText ,  Length ( sText ));
           Stream . Write ( w ,  sizeof ( w ));
           Stream . Write ( pText ^,  w );
           StrDispose ( pText );
           if  SubCount  >  0  then
           begin
             for  idxSub  :=  0  to  SubItems . Count  -  1  do
             begin                        //Save Item's subitems
               sText  :=  SubItems [ idxSub ];
               w  :=  length ( sText );
               pText  :=  StrAlloc ( Length ( sText )  +  1 );
               StrPLCopy ( pText ,  sText ,  Length ( sText ));
               Stream . Write ( w ,  sizeof ( w ));
               Stream . Write ( pText ^,  w );
               StrDispose ( pText );
             end ;
           end ;
         end ;
       end ;
     end ;
   finally
     FreeAndNil ( Stream );
   end ;
end ;

procedure  TSmartListView . LoadFromFile ( const  FileName :  string );
var
   Stream :  TStream ;
   IdxItem ,  IdxSubItem ,  IdxImage :  Integer ;
   W ,  ItemCount ,  SubCount :  Word ;
   pText :  pchar ;
   PTemp :  pChar ;
   MySignature :  array [ 0..2 ]  of  Char ;
   sExeName :  string ;
begin
   ItemCount  :=  0 ;
   SubCount  :=  0 ;
   sExeName  :=  ExtractFileName ( FileName );
   if  not  FileExists ( FileName )  then
   begin
     MessageBox ( Handle ,  pChar ( format ( Msg1 ,  [ sExeName ])),  'I/O Error' ,  MB_ICONERROR );
     Exit ;
   end ;
   Stream  :=  TFileStream . Create ( FileName ,  fmOpenRead );
   try
     Stream . Read ( MySignature ,  sizeof ( MySignature ));
     if  MySignature  <>  'LVF'  then
     begin
       MessageBox ( Handle ,  pChar ( format ( Msg2 ,  [ sExeName ])),  'I/O Error' ,  MB_ICONERROR );
       Exit ;
     end ;
     Stream . Read ( ItemCount ,  sizeof ( ItemCount ));
     Items . Clear ;
     Items . BeginUpdate ;
     for  idxItem  :=  1  to  ItemCount  do
     begin
       with  Items . Add  do
       begin
         //Read imageindex
         Stream . Read ( SubCount ,  sizeof ( SubCount ));
         //Read imageindex
         Stream . Read ( IdxImage ,  sizeof ( IdxImage ));
         ImageIndex  :=  IdxImage ;
         //Read the Caption
         Stream . Read ( w ,  SizeOf ( w ));
         pText  :=  StrAlloc ( w  +  1 );
         pTemp  :=  StrAlloc ( w  +  1 );
         Stream . Read ( pTemp ^,  W );
         StrLCopy ( pText ,  pTemp ,  W );
         Caption  :=  StrPas ( pText );
         StrDispose ( pTemp );
         StrDispose ( pText );
         if  SubCount  >  0  then
         begin
           for  idxSubItem  :=  1  to  SubCount  do
           begin
             Stream . Read ( w ,  SizeOf ( w ));
             pText  :=  StrAlloc ( w  +  1 );
             pTemp  :=  StrAlloc ( w  +  1 );
             Stream . Read ( pTemp ^,  W );
             StrLCopy ( pText ,  pTemp ,  W );
             Items [ idxItem  -  1 ]. SubItems . Add ( StrPas ( pText ));
             StrDispose ( pTemp );
             StrDispose ( pText );
           end ;
         end ;
       end ;
     end ;
   finally
     Items . EndUpdate ;
     FreeAndNil ( Stream );
   end ;

end ;

{Save a TListView as an HTML page}
{This Code from http://www.swissdelphicenter.ch/ Autor: Robert Muth  }

function  TSmartListView . SaveToHTMLFile ( const  FileName :  string ;  Center :  Boolean ):  Boolean ;
var
   i ,  j :  Integer ;
   tfile :  TextFile ;
begin
   try
     ForceDirectories ( ExtractFilePath ( FileName ));
     AssignFile ( tfile ,  FileName );
     try
       ReWrite ( tfile );
       WriteLn ( tfile ,  '<html>' );
       WriteLn ( tfile ,  '<head>' );
       WriteLn ( tfile ,  '<title>HTML-Ansicht: '  +  FileName  +  '</title>' );
       WriteLn ( tfile ,  '</head>' );
       // WriteLn(tfile, '<table border="1" bordercolor="#000000">');
       // Modified by HsuChong <Hsuchong@hotmail.com> 2006-12-13 10:03:06
       WriteLn ( tfile ,  '<table border=1 cellspacing=0 cellpadding=0 bordercolor="#000000">' );
       WriteLn ( tfile ,  '<tr>' );
       for  i  :=  0  to  Columns . Count  -  1  do
       begin
         if  center  then
           WriteLn ( tfile ,  '<td><b><center>'  +  Columns [ i ]. Caption  +  '</center></b></td>' )
         else
           WriteLn ( tfile ,  '<td><b>'  +  Columns [ i ]. Caption  +  '</b></td>' );
       end ;
       WriteLn ( tfile ,  '</tr>' );
       WriteLn ( tfile ,  '<tr>' );
       for  i  :=  0  to  Items . Count  -  1  do
       begin
         WriteLn ( tfile ,  '<td>'  +  Items . Item [ i ]. Caption  +  '</td>' );
         for  j  :=  0  to  Columns . Count  -  2  do
         begin
           if  Items . Item [ i ]. SubItems [ j ]  =  ''  then
             Write ( tfile ,  '<td>-</td>' )
           else
             Write ( tfile ,  '<td>'  +  Items . Item [ i ]. SubItems [ j ]  +  '</td>' );
         end ;
         Write ( tfile ,  '</tr>' );
       end ;
       WriteLn ( tfile ,  '</table>' );
       WriteLn ( tfile ,  '</html>' );
       Result  :=  True ;
     finally
       CloseFile ( tfile );
     end ;
   except
     Result  :=  False ;
   end ;
end ;

function  TSmartListView . SaveToExcelFile ( const  FileName :  string ):  Boolean ;
const
   ExcelChar  =  #9 ;
var
   ExcelRowText :  string ;
   i ,  j :  Integer ;
   ExcelList :  TStrings ;
begin
   Result  :=  False ;
   try
     ForceDirectories ( ExtractFilePath ( FileName ));
     ExcelList  :=  TStringList . Create ;
     try
       ExcelRowText  :=  Columns [ 0 ]. Caption ;
       for  i  :=  1  to  Columns . Count  -  1  do
         ExcelRowText  :=  ExcelRowText  +  ExcelChar  +  Columns [ i ]. Caption ;
       ExcelList . Append ( ExcelRowText );
       for  i  :=  0  to  Items . Count  -  1  do
       begin
         ExcelRowText  :=  Items [ i ]. Caption ;
         for  j  :=  0  to  Items [ i ]. SubItems . Count  -  1  do
           ExcelRowText  :=  ExcelRowText  +  ExcelChar  +  Items [ i ]. SubItems [ j ];
         ExcelList . Append ( ExcelRowText );
       end ;
       ExcelList . SaveToFile ( FileName );
     finally
       ExcelList . Free ;
     end ;
   except
     Result  :=  True ;
   end ;

end ;

procedure  TSmartListView . DrawBackgroundPicture ;
var
   x ,  y ,  dx :  Integer ;
begin
   x  :=  0 ;
   y  :=  0 ;
   if  Items . Count  >  0  then
   begin
     if  ViewStyle  =  vsReport  then
       x  :=  TopItem . DisplayRect ( drBounds ). Left
     else
       x  :=  Items [ 0 ]. DisplayRect ( drBounds ). Left ;
     y  :=  Items [ 0 ]. DisplayRect ( drBounds ). Top  -  2 ;
   end ;
   dx  :=  x ;
   while  y  <=  ClientHeight  do
   begin
     while  x  <=  ClientWidth  do
     begin
       Canvas . Draw ( x ,  y ,  FBackgroundPicture . Graphic );
       inc ( x ,  FBackgroundPicture . Graphic . Width );
     end ;
     inc ( y ,  FBackgroundPicture . Graphic . Height );
     x  :=  dx ;
   end ;
end ;

procedure  TSmartListView . LVCustomDraw ( Sender :  TCustomListView ;
   const  ARect :  TRect ;  var  DefaultDraw :  Boolean );
begin
   if  ( FBackgroundPicture . Graphic  <>  nil )  then
   begin
     //绘制背景图
     DrawBackgroundPicture ;
     //将画布的背景设为透明模式
     SetBkMode ( Canvas . Handle ,  TRANSPARENT );
     //将Item的文本背景设为透明
     ListView_SetTextBKColor ( Handle ,  CLR_NONE );
   end ;
end ;

procedure  TSmartListView . BackgroundPictureChanged ( Sender :  TObject );
begin
   Invalidate ;
end ;

function  TSmartListView . GetCop :  string ;
begin
   Result  :=  FCop ;
end ;

procedure  TSmartListView . SetCop ( const  Value :  string );
begin
   if  FCop  <>  Value  then
     FCop  :=  Value ;
end ;

procedure  TSmartListView . SetBackgroundPicture ( Value :  TPicture );
begin
   if  FBackgroundPicture  <>  Value  then
     FBackgroundPicture . Assign ( Value );
end ;

function  TSmartListView . GetCheckedItem :  TListItem ;
var
   I :  Integer ;
begin
   Result  :=  nil ;
   if  Checkboxes  then
     for  I  :=  0  to  Items . Count  -  1  do
       if  Items [ I ]. Checked  then
       begin
         Result  :=  Items [ I ];
         Break ;
       end ;
end ;

function  TSmartListView . MultiChecked :  Boolean ;
var
   I ,  CheckedCount :  Integer ;
begin
   Result  :=  False ;
   CheckedCount  :=  0 ;
   if  Checkboxes  then
     for  I  :=  0  to  Items . Count  -  1  do
     begin
       if  Items [ I ]. Checked  then
         Inc ( CheckedCount );
       Result  :=  CheckedCount  >  1 ;
       if  Result  then
         break ;
     end ;

end ;

function  TSmartListView . IsChecked :  Boolean ;
var
   I :  Integer ;
begin
   Result  :=  False ;
   if  Checkboxes  then
     for  I  :=  0  to  Items . Count  -  1  do
       if  Items [ I ]. Checked  then
       begin
         Result  :=  True ;
         Break ;
       end ;
end ;

procedure  TSmartListView . CheckAll ( Checked :  Boolean );
var
   I :  Integer ;
begin
   if  Checkboxes  then
     for  I  :=  0  to  Items . Count  -  1  do
       Items [ i ]. Checked  :=  Checked ;
end ;

procedure  TSmartListView . MoveItem ( OriginalIndex ,  NewIndex :  Integer );
var
   Selected ,  Focused :  boolean ;
   ListItem :  TListItem ;
begin
   if  (( OriginalIndex  <  0 )  or  ( OriginalIndex  >  Items . Count ))  or
     (( NewIndex  <  0 )  or  ( NewIndex  >  Items . Count ))  then
     Exit ;
   Items . BeginUpdate ;
   try
     Selected  :=  Items [ OriginalIndex ]. Selected ;
     Focused  :=  Items [ OriginalIndex ]. Focused ;
     if  NewIndex  <  OriginalIndex  then
       inc ( OriginalIndex );
     if  ( NewIndex  >  OriginalIndex )  then
       ListItem  :=  Items . Insert ( NewIndex  +  1 )
     else
       ListItem  :=  Items . Insert ( NewIndex );
     ListItem . Assign ( Items [ OriginalIndex ]);
     Items . Delete ( OriginalIndex );
     ListItem . Selected  :=  Selected ;
     ListItem . Focused  :=  Focused ;
   finally
     Items . EndUpdate ;
   end ;
end ;

procedure  TSmartListView . KeyUp ( var  Key :  Word ;  Shift :  TShiftState );
var
   PrevSearch :  string ;
   Ascii :  array [ 0..1 ]  of  char ;
   KBState :  TKeyboardState ;
begin
   inherited ;
   if  ColumnSearch  then
   begin
     GetKeyboardState ( KBState );
     if  ( ToAscii ( Key ,  0 ,  KBState ,  Ascii ,  0 )  =  1 )  and  ( Ascii [ 0 ]  in  [ #32 .. #127 ])  then
     begin
       PrevSearch  :=  FSearchStr ;          // remember searchstring
       if  GetTickCount  >  FSearchTickCount  +  1000  then  // last search over one second ago?
         PrevSearch  :=  '' ;                // reset searchstring
       FSearchStr  :=  PrevSearch  +  Ascii [ 0 ];  // Append searchstring
       FSearchTickCount  :=  GetTickCount ;  // remember last search time
       Key  :=  0 ;                          // prevent automatic search on first column
       if  not  StringSelect ( FSearchStr ,  FCurColumn )  then
       begin
         MessageBeep ( MB_ICONSTOP );
         FSearchStr  :=  PrevSearch ;
       end ;
     end ;
   end ;
end ;

function  TSmartListView . StringSelect ( const  FindStr :  string ;  ColumnIndex :  Integer ):  boolean ;
var
   SearchLen ,  SearchIndex ,  SearchStart :  Integer ;
begin
   Result  :=  False ;
   SearchLen  :=  Length ( FindStr );
   if  Assigned ( Selected )  then             // determine starting item
     SearchStart  :=  Selected . Index  +  1
   else
     SearchStart  :=  1 ;

   // Searches from currently selected item to last item
   // and from first item to currently selected item until result(found)

   SearchIndex  :=  0 ;
   while  ( SearchIndex  <  Items . Count )  and  not  Result  do
   begin
     if  ColumnIndex  =  0  then              // find main or subitem?
       Result  :=  AnsiCompareText ( Copy ( Items [( SearchStart  +  SearchIndex )  mod
         Items . Count ]. Caption ,  0 ,  SearchLen ),  FindStr )  =  0
     else
       Result  :=  AnsiCompareText ( Copy ( Items [( SearchStart  +  SearchIndex )  mod
         Items . Count ]. SubItems [ ColumnIndex  -  1 ],  0 ,  SearchLen ),  FindStr )  =  0 ;
     Inc ( SearchIndex );
   end ;
   if  Result  then
   begin
     SetFocus ;
     Selected  :=  Items [( SearchStart  +  SearchIndex  -  1 )  mod  Items . Count ];
     ItemFocused  :=  Selected ;
     Selected . MakeVisible ( False );
   end ;

end ;

function  TSmartListView . SubStringSelect ( const  FindStr :  string ;  ColumnIndex :  Integer ):  boolean ;
var
   SearchIndex ,  SearchStart :  Integer ;
begin
   Result  :=  False ;
   if  Assigned ( Selected )  then             // determine starting item
     SearchStart  :=  Selected . Index  +  1
   else
     SearchStart  :=  1 ;

   // Searches from currently selected item to last item
   // and from first item to currently selected item until result(found)

   SearchIndex  :=  0 ;
   while  ( SearchIndex  <  Items . Count )  and  not  Result  do
   begin
     if  ColumnIndex  =  0  then              // find main or subitem?
       Result  :=  Pos ( FindStr ,  Items [( SearchStart  +  SearchIndex )  mod
         Items . Count ]. Caption )  >  0
     else
       Result  :=  Pos ( FindStr ,  Items [( SearchStart  +  SearchIndex )  mod
         Items . Count ]. SubItems [ ColumnIndex  -  1 ])  >  0 ;
     Inc ( SearchIndex );
   end ;
   if  Result  then
   begin
     SetFocus ;
     Selected  :=  Items [( SearchStart  +  SearchIndex  -  1 )  mod  Items . Count ];
     ItemFocused  :=  Selected ;
     Selected . MakeVisible ( False );
   end ;

end ;

end .