paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 08:29:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

Further implements TShellListView and other small changes and fixes

Browse Source 
git-svn-id: trunk@19771 -
This commit is contained in:
sekelsenmat 2009-05-02 16:29:41 +00:00
parent 7423208655
commit fdf5a12e01
5 changed files with 121 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/comctrls.pp
View File

@ -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;

3
lcl/include/listcolumn.inc
View File

@ -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);

12
lcl/interfaces/carbon/carbonlistviews.pp
View File

@ -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
Result := (LCLObject as TListView).Items[AIndex].SubItems[ASubIndex - 1]
(ASubIndex <= (LCLObject as TCustomListView).Items[AIndex].SubItems.Count) then
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;

5
lcl/interfaces/carbon/carbonwscomctrls.pp
View File

@ -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;

144
lcl/shellctrls.pas
View File

@ -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}
{$ifdef wince}
{$else}
begin
PopulateTreeNodeWithFiles(nil, '\');
end;
{$endif}
{$ifdef unix}
begin
PopulateTreeNodeWithFiles(nil, '/');
PopulateTreeNodeWithFiles(nil, GetBasePath());
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
rootDir := PChar(ANode.Text)+PathDelim+rootDir
if (PChar(ANode.Text) <> PathDelim) then
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
begin
FRoot := Value.GetPathFromNode(Value.Selected);
Clear();
PopulateWithRoot();
end
else
begin
Clear();
Clear;
if Value <> nil then
begin
FRoot := Value.GetPathFromNode(Value.Selected);
PopulateWithRoot();
end;
end;
// Also update the pair, but only if necessary to avoid circular calls of the setters
if Value.ShellListView <> Self then
Value.ShellListView := Self;}
if Value.ShellListView <> Self then 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;