New files for treefilteredit

git-svn-id: trunk@31751 -
2025-08-15 23:59:12 +02:00 · 2011-07-19 21:13:54 +00:00 · 2011-07-19 21:13:54 +00:00 · aa83cf8588
commit aa83cf8588
parent 04173e5773
3 changed files with 415 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -1491,6 +1491,8 @@ components/lazcontrols/lazcontrols.lpk svneol=native#text/xml
 components/lazcontrols/lazcontrols.pas svneol=native#text/pascal
 components/lazcontrols/listfilteredit.pas svneol=native#text/plain
 components/lazcontrols/listfilteredit_icon.lrs svneol=native#text/plain
+components/lazcontrols/treefilteredit.pas svneol=native#text/plain
+components/lazcontrols/treefilteredit_icon.lrs svneol=native#text/plain
 components/lazreport/doc/contributors.txt svneol=native#text/plain
 components/lazreport/doc/firststeps.odt -text
 components/lazreport/doc/fr_eng.sxw -text
--- a/components/lazcontrols/treefilteredit.pas
+++ b/components/lazcontrols/treefilteredit.pas
@ -0,0 +1,378 @@
+unit TreeFilterEdit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, LResources, LCLType, Graphics,
+  Controls, StdCtrls, ComCtrls, EditBtn, FileUtil, AvgLvlTree, ImgList;
+
+type
+
+  TImageIndexEvent = function (Str: String; Data: TObject;
+                               var IsEnabled: Boolean): Integer of object;
+
+  { TTreeFilterEdit }
+
+  TTreeFilterEdit = class(TCustomControlFilterEdit)
+  private
+    // A control showing the (filtered) data. These are exclusive, only one is used.
+    fFilteredTreeview: TTreeview;
+    fImageIndexDirectory: integer;     // Needed if directory structure is shown.
+    fSelectionList: TStringList;    // or store/restore the old selections here.
+    fShowDirHierarchy: Boolean;     // Show direcories / files as a tree structure.
+    // Full filename in node data is needed when showing the directory hierarchy.
+    // It is stored automatically if the map is populated by MapShortToFullFilename.
+    fFilenameMap: TStringToStringTree;
+    // Data supplied by caller through Data property.
+    // Objects property is passed to OnGetImageIndex.
+    fOriginalData: TStringList;
+    // Data sorted for viewing.
+    fRootNode: TTreeNode;           // The filtered items are under this node.
+    fOnGetImageIndex: TImageIndexEvent;
+    fImgIndex: Integer;
+    fSortedData: TStringList;
+    fTVNodeStack: TFPList;
+    function CompareFNs(AFilename1,AFilename2: string): integer;
+    procedure SetFilteredTreeview(const AValue: TTreeview);
+    procedure SetShowDirHierarchy(const AValue: Boolean);
+    procedure FreeTVNodeData(Node: TTreeNode);
+    procedure TVDeleteUnneededNodes(p: integer);
+    procedure TVClearUnneededAndCreateHierachy(Filename: string);
+  protected
+    procedure MoveNext; override;
+    procedure MovePrev; override;
+    procedure SortAndFilter; override;
+    procedure ApplyFilterCore; override;
+    function GetDefaultGlyph: TBitmap; override;
+    function GetDefaultGlyphName: String; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure StoreSelection; override;
+    procedure RestoreSelection; override;
+    procedure MapShortToFullFilename(ShortFilename, FullFilename: string);
+  public
+    property ImageIndexDirectory: integer read fImageIndexDirectory write fImageIndexDirectory;
+    property SelectionList: TStringList read fSelectionList;
+    property ShowDirHierarchy: Boolean read fShowDirHierarchy write SetShowDirHierarchy;
+    property Data: TStringList read fOriginalData;
+    property RootNode: TTreeNode read fRootNode write fRootNode;
+  published
+    property FilteredTreeview: TTreeview read fFilteredTreeview write SetFilteredTreeview;
+    property OnGetImageIndex: TImageIndexEvent read fOnGetImageIndex write fOnGetImageIndex; deprecated 'use OnDrawItem handler in FilteredListbox';
+  end;
+
+  { TFileNameItem }
+
+  TFileNameItem = class
+  public
+    Filename: string;
+    constructor Create(AFilename: string);
+  end;
+
+var
+  TreeFilterGlyph: TBitmap;
+
+const
+  ResBtnListFilter = 'btnfiltercancel';
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  {$I treefilteredit_icon.lrs}
+  RegisterComponents('LazControls',[TTreeFilterEdit]);
+end;
+
+{ TFileNameItem }
+
+constructor TFileNameItem.Create(AFilename: string);
+begin
+  Filename:=AFilename;
+end;
+
+{ TTreeFilterEdit }
+
+constructor TTreeFilterEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  fOriginalData:=TStringList.Create;
+  fSelectionList:=TStringList.Create;
+  fFilenameMap:=TStringToStringTree.Create(True);
+  fSortedData:=TStringList.Create;
+  fImageIndexDirectory := -1;
+  fImgIndex:=-1;
+end;
+
+destructor TTreeFilterEdit.Destroy;
+begin
+  fSortedData.Free;
+  fFilenameMap.Free;
+  fSelectionList.Free;
+  fOriginalData.Free;
+  FreeTVNodeData(fRootNode);
+  inherited Destroy;
+end;
+
+function TTreeFilterEdit.GetDefaultGlyph: TBitmap;
+begin
+  Result := TreeFilterGlyph;
+end;
+
+function TTreeFilterEdit.GetDefaultGlyphName: String;
+begin
+  Result := ResBtnListFilter;
+end;
+
+procedure TTreeFilterEdit.SetFilteredTreeview(const AValue: TTreeview);
+begin
+  if fFilteredTreeview = AValue then Exit;
+  fFilteredTreeview:=AValue;
+  if AValue = nil then Exit;
+end;
+
+procedure TTreeFilterEdit.SetShowDirHierarchy(const AValue: Boolean);
+begin
+  if fShowDirHierarchy=AValue then exit;
+  if not Assigned(fFilteredTreeview) then
+    raise Exception.Create('Showing directory hierarchy requires Treeview.');
+  fShowDirHierarchy:=AValue;
+end;
+
+procedure TTreeFilterEdit.MapShortToFullFilename(ShortFilename, FullFilename: string);
+begin
+  fFilenameMap[ShortFilename]:=FullFilename;
+end;
+
+procedure TTreeFilterEdit.ApplyFilterCore;
+var
+  TVNode: TTreeNode;
+  i: Integer;
+  FileN, s: string;
+  ena: Boolean;
+begin
+  if fFilenameMap.Count > 0 then
+    FreeTVNodeData(fRootNode);   // Free node data now, it will be filled later.
+  if Assigned(fRootNode) then    // Delete old tree nodes.
+    fRootNode.DeleteChildren
+  else
+    fFilteredTreeview.Items.Clear;
+  if fShowDirHierarchy then
+    fTVNodeStack:=TFPList.Create;
+  fFilteredTreeview.BeginUpdate;
+  for i:=0 to fSortedData.Count-1 do begin
+    FileN:=fSortedData[i];
+    if fShowDirHierarchy then begin
+      TVClearUnneededAndCreateHierachy(FileN);
+      TVNode:=TTreeNode(fTVNodeStack[fTVNodeStack.Count-1]);
+    end
+    else if Assigned(fRootNode) then
+      TVNode:=fFilteredTreeview.Items.AddChild(fRootNode,FileN)
+    else
+      TVNode:=fFilteredTreeview.Items.Add(Nil,FileN);
+    if fFilenameMap.Count > 0 then begin
+      s:=FileN;
+      if fFilenameMap.Contains(FileN) then
+        s:=fFilenameMap[FileN];           // Full file name.
+      TVNode.Data:=TFileNameItem.Create(s);
+    end;
+    ena := True;
+    if Assigned(OnGetImageIndex) then
+      fImgIndex:=OnGetImageIndex(FileN, fSortedData.Objects[i], ena);
+    TVNode.ImageIndex:=fImgIndex;
+    TVNode.SelectedIndex:=fImgIndex;
+    if Assigned(fSelectedPart) then
+      TVNode.Selected:=fSelectedPart=fSortedData.Objects[i];
+  end;
+  if fShowDirHierarchy then      // TVDeleteUnneededNodes(0); ?
+    fTVNodeStack.Free;
+  if Assigned(fRootNode) then
+    fRootNode.Expanded:=True;
+  fFilteredTreeview.EndUpdate;
+end;
+
+function TTreeFilterEdit.CompareFNs(AFilename1,AFilename2: string): integer;
+begin
+  if SortData then
+    Result:=CompareFilenames(AFilename1, AFilename2)
+  else if fShowDirHierarchy then
+    Result:=CompareFilenames(ExtractFilePath(AFilename1), ExtractFilePath(AFilename2))
+  else
+    Result:=0;
+end;
+
+procedure TTreeFilterEdit.SortAndFilter;
+// Copy data from fOriginalData to fSortedData in sorted order
+var
+  Origi, i: Integer;
+  FileN: string;
+begin
+  fSortedData.Clear;
+  for Origi:=0 to fOriginalData.Count-1 do begin
+    FileN:=fOriginalData[Origi];
+    if (Filter='') or (Pos(Filter,lowercase(FileN))>0) then begin
+      i:=fSortedData.Count-1;
+      while i>=0 do begin
+        if CompareFNs(FileN,fSortedData[i])>=0 then break;
+        dec(i);
+      end;
+      fSortedData.InsertObject(i+1,FileN, fOriginalData.Objects[Origi]);
+    end;
+  end;
+end;
+
+procedure TTreeFilterEdit.StoreSelection;
+var
+  ANode: TTreeNode;
+begin
+  fSelectionList.Clear;
+  ANode:=fFilteredTreeview.Selected;
+  while ANode<>nil do begin
+    fSelectionList.Insert(0,ANode.Text);
+    ANode:=ANode.Parent;
+  end;
+end;
+
+procedure TTreeFilterEdit.RestoreSelection;
+var
+  ANode: TTreeNode;
+  CurText: string;
+begin
+  ANode:=nil;
+  while fSelectionList.Count>0 do begin
+    CurText:=fSelectionList[0];
+    if ANode=nil then
+      ANode:=fFilteredTreeview.Items.GetFirstNode
+    else
+      ANode:=ANode.GetFirstChild;
+    while (ANode<>nil) and (ANode.Text<>CurText) do
+      ANode:=ANode.GetNextSibling;
+    if ANode=nil then break;
+    fSelectionList.Delete(0);
+  end;
+  if ANode<>nil then
+    fFilteredTreeview.Selected:=ANode;
+end;
+
+procedure TTreeFilterEdit.MoveNext;
+var tn: TTreeNode;
+begin
+  tn := fFilteredTreeview.Selected;
+  if not Assigned(tn) then
+  begin
+    tn := fFilteredTreeview.TopItem;
+    if Assigned(tn) then
+      fFilteredTreeview.Selected := tn;
+    Exit;
+  end;
+  tn := tn.GetNext;
+  if Assigned(tn) then
+    fFilteredTreeview.Selected := tn;
+end;
+
+procedure TTreeFilterEdit.MovePrev;
+var tn: TTreeNode;
+begin
+  tn := fFilteredTreeview.Selected;
+  if not Assigned(tn) then Exit;
+  tn := tn.GetPrev;
+  if Assigned(tn) then
+    fFilteredTreeview.Selected := tn;
+end;
+
+procedure TTreeFilterEdit.FreeTVNodeData(Node: TTreeNode);
+var
+  Child: TTreeNode;
+begin
+  if Node=nil then exit;
+  if (Node.Data<>nil) then begin
+    TObject(Node.Data).Free;
+    Node.Data:=nil;
+  end;
+  Child:=Node.GetFirstChild;
+  while Child<>nil do
+  begin
+    FreeTVNodeData(Child);
+    Child:=Child.GetNextSibling;
+  end;
+end;
+
+procedure TTreeFilterEdit.TVDeleteUnneededNodes(p: integer);
+// delete all nodes behind the nodes in the stack, and depth>=p
+var
+  i: Integer;
+  Node: TTreeNode;
+begin
+  for i:=fTVNodeStack.Count-1 downto p do begin
+    Node:=TTreeNode(fTVNodeStack[i]);
+    while Node.GetNextSibling<>nil do
+      Node.GetNextSibling.Free;
+  end;
+  fTVNodeStack.Count:=p;
+end;
+
+procedure TTreeFilterEdit.TVClearUnneededAndCreateHierachy(Filename: string);
+// TVNodeStack contains a path of TTreeNode for the last filename
+var
+  DelimPos: Integer;
+  FilePart: String;
+  Node: TTreeNode;
+  p: Integer;
+begin
+  p:=0;
+  while Filename<>'' do begin
+    // get the next file name part
+    DelimPos:=System.Pos(PathDelim,Filename);
+    if DelimPos>0 then begin
+      FilePart:=copy(Filename,1,DelimPos-1);
+      Filename:=copy(Filename,DelimPos+1,length(Filename));
+    end else begin
+      FilePart:=Filename;
+      Filename:='';
+    end;
+    //debugln(['ClearUnneededAndCreateHierachy FilePart=',FilePart,' Filename=',Filename,' p=',p]);
+    if p < fTVNodeStack.Count then begin
+      Node:=TTreeNode(fTVNodeStack[p]);
+      if (FilePart=Node.Text) and (Node.Data=nil) then begin
+        // same sub directory
+      end
+      else begin
+        // change directory => last directory is complete
+        // => delete unneeded nodes after last path
+        TVDeleteUnneededNodes(p+1);
+        if Node.GetNextSibling<>nil then begin
+          Node:=Node.GetNextSibling;
+          Node.Text:=FilePart;
+        end
+        else
+          Node:=fFilteredTreeview.Items.Add(Node,FilePart);
+        fTVNodeStack[p]:=Node;
+      end;
+    end else begin
+      // new sub node
+      if p>0 then
+        Node:=TTreeNode(fTVNodeStack[p-1])
+      else
+        Node:=fRootNode;
+      if Node.GetFirstChild<>nil then begin
+        Node:=Node.GetFirstChild;
+        Node.Text:=FilePart;
+      end
+      else
+        Node:=fFilteredTreeview.Items.AddChild(Node,FilePart);
+      fTVNodeStack.Add(Node);
+    end;
+    if (Filename<>'') then begin
+      Node.ImageIndex:=fImageIndexDirectory;
+      Node.SelectedIndex:=Node.ImageIndex;
+    end;
+    inc(p);
+  end;
+end;
+
+end.
+
--- a/components/lazcontrols/treefilteredit_icon.lrs
+++ b/components/lazcontrols/treefilteredit_icon.lrs
@ -0,0 +1,35 @@
+LazarusResources.Add('ttreefilteredit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#0#0#0#0#0#249'C'#187#127#0#0#0
+  +#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#6#28#11'8'#0
+  +':h'#8#209#0#0#2#151'IDATH'#199#189#149#205'O'#19'A'#24#198#127#211#150'm'#3
+  +'i'#26#17#141#30'P'#211#131#136#17#13#136'&'#4#2'acj'#224#194#31'`'#140#28
+  +#140#137#7#19#19#15#212#255#160#18#140'&'#156'='#168#193#179'FS'#18#162'X>'
+  +#12#23#229'3R'#163#166#225'C'#129#131#17#203'R'#211#150'v'#199'Cwki'#23'(*>'
+  +#151#217#157#153#247'y'#222'y?f'#132#174#235#8'!'#216'+'#8')%{'#9#7#128#223
+  +#223#251#207'T'#2#129#27#162'@ #r'#233#15#200#250'6'#217'MM'#207#226#247#247
+  +#202'\'#17'G'#174#129#170#250#138'&'#31#28#28#200'~WTT'#144#214'%'#161#208#8
+  +#0'C'#195#163#178#165#185'I'#20#8#228#26#237#6']]'#183#241'x<['#231#224'o05='
+  +#139#239'b'#219#246'I'#190'za'#138'h'#248#219#174#201'/'#159#127#207#227'`'
+  +#17'U'#180#17'['#162#242'H'#29'8VA'#249#2#202'"('#243'`['#1#214'H'#199'!'#165
+  +#185#216#248#225'&'#165#185'I'#199#202'H'''#156#172'/h'#180#181#223#20#128#11
+  +'8'#4#184#250#131#19#165#192#167#130#16'E'#194'/'#240#214'4'#2#224't'#219'A'
+  +#1#236') IZ'#1';6'#236#233#20#235#154#4#1'K'#11#26#0'gN'#159'<'#0'D'#129'y'
+  +#128#254#224#132#4#236'&'#175#13#160#186'#('#0'"3o'#0'Hh)'#176'h'#238#184#150
+  +#241'g'#241'c'#18#128#235#143#20#161#170#190#152#170#250#146'l'#182#208#11'N'
+  +'P'#221#17#20#225'g'#237'2'#242'n'#30'o'#131' '#17#5#231#190#223#22#9'M'#1'`'
+  +'nR'#1#24#175#234#12#157#29#236#196#1#252'4'#29#5'd'#222#152']`'#211'I'#198
+  +'2'#235#137'5'#135'1f'#200'?'#143#148#3'P'#213#25'j4<'#214'sF'#189#168'2}8'
+  +#214'&'#174'4'#244#203#200'p%'#222#214#149',y'#248#249'Q'#0'b'#167#238#213
+  +#143#191#157#136#231'{'#154#7#155')h'#213#7''''#150#203'n'#137#195#177#187'2'
+  +#242#250#28#222#214'W'#204'<'#169#202#198#28#186','#175#222#158#238';'#185
+  +#191'r'#187'F'#251#0#148#154'"'#153#237#146'X'#205'}'#209#211'M'#9#144#178
+  +#176'q'#3#235'9'#196'N '#190'e'''#215#213#215#30#4#230#230#158'F'#205#169#241
+  +#186#250'Z'#167'A'#158#31#22'/'#240#213#156#31'x9'#139'I^'#144#228#28#28#203
+  +#215'4'#200#173#18#25#1#18#219'v'#178#5#153#150'?'#169#170'>'#177#195#237'*'
+  +#172#146'n%0'#9#148#3'$V'#215#152'|p'#220'$P'#140#154'7'#161#0'I'#171#196#238
+  +'$'#160#7#2'}'#223'3'#159#215'\FX<'#4#250#242#247#165#141#30#144#187'~'#147
+  +#135#134'G'#205#170'p'#26#241#221#15#148#0#203#197#190#245'-'#205'M'#242#191
+  +'<'#250'6'#246#24#191#0#136#230#242'w'#134#223#12'V'#0#0#0#0'IEND'#174'B`'
+  +#130
+]);