Further implements TShellListView and other small changes and fixes

git-svn-id: trunk@19771 -

lcl/comctrls.pp

@@ -1008,17 +1008,14 @@ type
     function IntfCustomDraw(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage; AItem, ASubItem: Integer; AState: TCustomDrawState; const ARect: PRect): TCustomDrawResult;
   protected
     property AllocBy: Integer read FAllocBy write SetAllocBy default 0;
-    property Columns: TListColumns read FColumns write SetColumns;
     property ColumnClick: Boolean index Ord(lvpColumnClick) read GetProperty write SetProperty default True;
+    property Columns: TListColumns read FColumns write SetColumns;
     property DefaultItemHeight: integer read FDefaultItemHeight write SetDefaultItemHeight;
     property HideSelection: Boolean index Ord(lvpHideSelection) read GetProperty write SetProperty default True;
     property HoverTime: Integer read GetHoverTime write SetHoverTime default -1;
-    property Items: TListItems read FListItems write SetItems;
     property LargeImages: TCustomImageList index Ord(lvilLarge) read GetImageList write SetImageList;
-    property MultiSelect: Boolean index Ord(lvpMultiselect) read GetProperty write SetProperty default False;
     property OwnerData: Boolean read FOwnerData write SetOwnerData default False;
     property OwnerDraw: Boolean index Ord(lvpOwnerDraw) read GetProperty write SetProperty default False;
-    property ReadOnly: Boolean index Ord(lvpReadOnly) read GetProperty write SetProperty default False;
     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
     property ShowColumnHeaders: Boolean index Ord(lvpShowColumnHeaders) read GetProperty write SetProperty default True;
     property ShowWorkAreas: Boolean index Ord(lvpShowWorkAreas) read GetProperty write SetProperty default False;
@@ -1060,6 +1057,12 @@ type
     property HotTrack: Boolean index Ord(lvpHotTrack) read GetProperty write SetProperty default False;
     property HotTrackStyles: TListHotTrackStyles read FHotTrackStyles write SetHotTrackStyles default [];
     property ItemFocused: TListItem read GetFocused write SetFocused;
+    property Items: TListItems read FListItems write SetItems;
+    // MultiSelect and ReadOnly should be protected, but can't because Carbon Interface
+    // needs to access this property and it cannot cast to TListItem, because we have
+    // other classes descending from TCustomListItem which need to work too
+    property MultiSelect: Boolean index Ord(lvpMultiselect) read GetProperty write SetProperty default False;
+    property ReadOnly: Boolean index Ord(lvpReadOnly) read GetProperty write SetProperty default False;
     property RowSelect: Boolean index Ord(lvpRowSelect) read GetProperty write SetProperty default False;
     property SelCount: Integer read GetSelCount;
     property Selected: TListItem read GetSelection write SetSelection;

lcl/include/listcolumn.inc

@@ -168,7 +168,8 @@ begin
   if not WSUpdateAllowed then Exit;
   
   LV := TListColumns(Collection).FOwner;
-  TWSCustomListViewClass(LV.WidgetSetClass).ColumnSetWidth(LV, Index, Self, FWidth);
+  if (LV <> nil) or (LV.WidgetsetClass <> nil) then // Avoids crash
+    TWSCustomListViewClass(LV.WidgetSetClass).ColumnSetWidth(LV, Index, Self, FWidth);
 end;
 
 procedure TListColumn.SetMaxWidth(const AValue: TWidth);

lcl/interfaces/carbon/carbonlistviews.pp

@@ -1422,15 +1422,15 @@ end;
 
 function TCarbonListView.GetItemCaption(AIndex, ASubIndex: Integer): String;
 begin
-  if (AIndex >= 0) and (AIndex < (LCLObject as TListView).Items.Count) then
+  if (AIndex >= 0) and (AIndex < (LCLObject as TCustomListView).Items.Count) then
   begin
     if ASubIndex = 0 then
-      Result := (LCLObject as TListView).Items[AIndex].Caption
+      Result := (LCLObject as TCustomListView).Items[AIndex].Caption
     else
     begin
       if (ASubIndex > 0) and
-        (ASubIndex <= (LCLObject as TListView).Items[AIndex].SubItems.Count) then
+        (ASubIndex <= (LCLObject as TCustomListView).Items[AIndex].SubItems.Count) then
-        Result := (LCLObject as TListView).Items[AIndex].SubItems[ASubIndex - 1]
+        Result := (LCLObject as TCustomListView).Items[AIndex].SubItems[ASubIndex - 1]
       else
         Result := '';
     end;
@@ -1441,12 +1441,12 @@ end;
 
 function TCarbonListView.GetReadOnly: Boolean;
 begin
-  Result := (LCLObject as TListView).ReadOnly;
+  Result := (LCLObject as TCustomListView).ReadOnly;
 end;
 
 function TCarbonListView.MultiSelect: Boolean;
 begin
-  Result := (LCLObject as TListView).MultiSelect;
+  Result := (LCLObject as TCustomListView).MultiSelect;
 end;
 
 function TCarbonListView.IsOwnerDrawn: Boolean;

lcl/interfaces/carbon/carbonwscomctrls.pp

@@ -342,10 +342,13 @@ end;
 
 class procedure TCarbonWSCustomListView.ColumnSetWidth(const ALV: TCustomListView;
   const AIndex: Integer; const AColumn: TListColumn; const AWidth: Integer);
+var
+  Column: TCarbonListColumn;
 begin
   if not CheckHandle(ALV, Self, 'ColumnSetWidth') then Exit;
 
-  TCarbonListView(ALV.Handle).GetColumn(AIndex).SetWidth(AWidth);
+  Column := TCarbonListView(ALV.Handle).GetColumn(AIndex);
+  if Column <> nil then Column.SetWidth(AWidth); // Avoids crash
 end;
 
 class procedure TCarbonWSCustomListView.ColumnSetVisible(const ALV: TCustomListView;

lcl/shellctrls.pas

@@ -27,7 +27,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Graphics,
-  ComCtrls;
+  ComCtrls, FileUtil;
 
 type
 
@@ -52,19 +52,22 @@ type
     procedure SetShellListView(const Value: TCustomShellListView);
     { Other internal methods }
     procedure HandleOnExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
+    procedure HandleSelectionChanged(Sender: TObject);
   protected
   public
     { Basic methods }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 
-    { Methods specific to Lazarus }
+    { Methods specific to Lazarus - useful for other classes }
+    class function  GetBasePath: string;
     class procedure GetFilesInDir(const ABaseDir: string;
       AObjectTypes: TObjectTypes; AResult: TStrings);
-    function PopulateTreeNodeWithFiles(
+    { Other methods specific to Lazarus }
+    function  GetPathFromNode(ANode: TTreeNode): string;
+    function  PopulateTreeNodeWithFiles(
       ANode: TTreeNode; ANodePath: string): Boolean;
     procedure PopulateWithBaseFiles;
-    function GetPathFromNode(ANode: TTreeNode): string;
 
     { Properties }
     property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes;
@@ -138,20 +141,20 @@ type
     FShellTreeView: TCustomShellTreeView;
     { Setters and getters }
     procedure SetShellTreeView(const Value: TCustomShellTreeView);
+    procedure SetRoot(const Value: string);
     { Other internal methods }
+    procedure HandleResize(Sender: TObject);
   protected
+    { Methods specific to Lazarus }
+    procedure PopulateWithRoot();
+//    function GetPathFromNode(ANode: TTreeNode): string;
   public
     { Basic methods }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-
-    { Methods specific to Lazarus }
-    procedure PopulateWithRoot();
-//    function GetPathFromNode(ANode: TTreeNode): string;
-
     { Properties }
     property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes;
-    property Root: string read FRoot write FRoot;
+    property Root: string read FRoot write SetRoot;
     property ShellTreeView: TCustomShellTreeView read FShellTreeView write SetShellTreeView;
   end;
 
@@ -303,6 +306,15 @@ begin
   AllowExpansion := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
 end;
 
+procedure TCustomShellTreeView.HandleSelectionChanged(Sender: TObject);
+begin
+  if Assigned(FShellListView) then
+  begin
+    FShellListView.Root := GetPathFromNode(Selected);
+    FShellListView.Refresh;
+  end;
+end;
+
 constructor TCustomShellTreeView.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -314,6 +326,7 @@ begin
   // Necessary event handlers
 
   OnExpanding := @HandleOnExpanding;
+  OnSelectionChanged := @HandleSelectionChanged;
 
   // Populates the base dirs
 
@@ -337,9 +350,9 @@ var
   ObjectData: TObject;
   SearchStr: string;
 begin
-  SearchStr := IncludeTrailingPathDelimiter(ABaseDir) + '*.*';
+  SearchStr := IncludeTrailingPathDelimiter(ABaseDir) + AllFilesMask;
 
-  FindResult := FindFirst(SearchStr, FaDirectory, DirInfo);
+  FindResult := FindFirst(SearchStr, faAnyFile, DirInfo);
 
   while FindResult = 0 do
   begin
@@ -374,6 +387,19 @@ begin
   SysUtils.FindClose(DirInfo);
 end;
 
+class function TCustomShellTreeView.GetBasePath: string;
+begin
+  {$if defined(windows) and not defined(wince)}
+  Result := '';
+  {$endif}
+  {$ifdef wince}
+  Result := '\';
+  {$endif}
+  {$ifdef unix}
+  Result := '/';
+  {$endif}
+end;
+
 { Returns true if at least one item was added, false otherwise }
 function TCustomShellTreeView.PopulateTreeNodeWithFiles(
   ANode: TTreeNode; ANodePath: string): Boolean;
@@ -430,15 +456,9 @@ begin
     Inc(pDrive, 4);
   end;
 end;
-  {$endif}
+  {$else}
-  {$ifdef wince}
 begin
-  PopulateTreeNodeWithFiles(nil, '\');
+  PopulateTreeNodeWithFiles(nil, GetBasePath());
-end;
-  {$endif}
-  {$ifdef unix}
-begin
-  PopulateTreeNodeWithFiles(nil, '/');
 end;
   {$endif}
 
@@ -446,17 +466,22 @@ function TCustomShellTreeView.GetPathFromNode(ANode: TTreeNode): string;
 var
   rootDir : String;
 begin
+  // If nothing is selected, then the base is selected
+  if ANode = nil then Exit(GetBasePath());
+
   // In the future use ANode.Data instead of ANode.Text
   rootDir := PChar(ANode.Text);
   while (ANode.Parent <> nil)do
   begin
     ANode := ANode.Parent;
-    if( pChar(ANode.Text) <> PathDelim)then
+    if (PChar(ANode.Text) <> PathDelim) then
-      rootDir := PChar(ANode.Text)+PathDelim+rootDir
+      rootDir := PChar(ANode.Text) + PathDelim + rootDir
     else
-      rootDir := PChar(ANode.Text)+rootDir;
+      rootDir := PChar(ANode.Text) + rootDir;
   end;
-  result:=rootDir;
+  // Check, maybe the base path won't be necessary in the future
+  // if the base directory is added to the items list
+  Result := GetBasePath + rootDir;
 end;
 
 { TCustomShellListView }
@@ -464,22 +489,38 @@ end;
 procedure TCustomShellListView.SetShellTreeView(
   const Value: TCustomShellTreeView);
 begin
-  FShellTreeView := Value;
+  if FShellTreeView <> Value then
+  begin
+    FShellTreeView := Value;
 
-{  if Value.Selected <> nil then
+    Clear;
-  begin
+
-    FRoot := Value.GetPathFromNode(Value.Selected);
+    if Value <> nil then
-    Clear();
+    begin
-    PopulateWithRoot();
+      FRoot := Value.GetPathFromNode(Value.Selected);
-  end
+      PopulateWithRoot();
-  else
+    end;
-  begin
-    Clear();
   end;
 
   // Also update the pair, but only if necessary to avoid circular calls of the setters
-  if Value.ShellListView <> Self then
+  if Value.ShellListView <> Self then Value.ShellListView := Self;
-    Value.ShellListView := Self;}
+end;
+
+procedure TCustomShellListView.SetRoot(const Value: string);
+begin
+  if FRoot <> Value then
+  begin
+    FRoot := Value;
+    Clear;
+    PopulateWithRoot();
+  end;
+end;
+
+procedure TCustomShellListView.HandleResize(Sender: TObject);
+begin
+  if Column[0] <> nil then Column[0].Width := (70 * Width) div 100;
+  if Column[1] <> nil then Column[1].Width := (15 * Width) div 100;
+  if Column[2] <> nil then Column[2].Width := (15 * Width) div 100;
 end;
 
 constructor TCustomShellListView.Create(AOwner: TComponent);
@@ -488,7 +529,7 @@ begin
 
   // Initial property values
 
-  ObjectTypes:= [otNonFolders];
+  ObjectTypes := [otNonFolders];
 
   Self.Columns.Add;
   Self.Column[0].Caption := 'Name';
@@ -496,6 +537,9 @@ begin
   Self.Column[1].Caption := 'Size';
   Self.Columns.Add;
   Self.Column[2].Caption := 'Type';
+
+  // Internal event handlers
+  OnResize := @HandleResize;
 end;
 
 destructor TCustomShellListView.Destroy;
@@ -505,24 +549,40 @@ begin
 end;
 
 procedure TCustomShellListView.PopulateWithRoot();
-{var
+var
   i: Integer;
   Files: TStringList;
   NewItem: TListItem;
-}
+  CurFileName: string;
+  CurFileSize: Int64;
 begin
-{  Files := TStringList.Create;
+  // Check inputs
+  if FRoot = '' then Exit;
+
+  Files := TStringList.Create;
   try
     TCustomShellTreeView.GetFilesInDir(FRoot, FObjectTypes, Files);
 
     for i := 0 to Files.Count - 1 do
     begin
       NewItem := Items.Add;
-      NewItem.Caption := Files.Strings[i];
+      CurFileName := Files.Strings[i];
+      // First column - Name
+      NewItem.Caption := CurFileName;
+      // Second column - Size
+      CurFileSize := FileSize(FRoot + CurFileName); // in Bytes
+      if CurFileSize < 1024 then
+        NewItem.SubItems.Add(IntToStr(CurFileSize) + ' bytes')
+      else if CurFileSize < 1024 * 1024 then
+        NewItem.SubItems.Add(IntToStr(CurFileSize div 1024) + ' kB')
+      else
+        NewItem.SubItems.Add(IntToStr(CurFileSize div 1024) + ' MB');
+      // Third column - Type
+      NewItem.SubItems.Add(ExtractFileExt(CurFileName));
     end;
   finally
     Files.Free;
-  end;}
+  end;
 end;
 
 procedure Register;